! A makeshift gopher client for TOPS-20

! A makeshift gopher client for TOPS-20
! in Programmable Control Language
! [email protected], 2019
! Requires TCPGET.EXE, to fetch the content.

COMMAND gopher;
BEGIN
INTEGER fl;
STRING cmd;
EXTERNAL PROCEDURE showfile;
EXTERNAL PROCEDURE follow;
EXTERNAL PROCEDURE dotcpget;
EXTERNAL PROCEDURE showhist;
EXTERNAL PROCEDURE gohist;

DO BEGIN
PROMPT "GOPHER>";
PARSE text (Help "g)oto host port path, f)ollow linknum, h)istory, b)ack hist
orynum");
cmd = $ATOM;
IF cmd[1:1] = "g" THEN BEGIN
CALL dotcpget(cmd[2:*]);
CALL showfile;
END;
IF cmd[1:1] = "f" THEN BEGIN
fl = $INTEGER(cmd[2:*]);
CALL follow(fl);
END;
IF cmd[1:1] = "h" THEN BEGIN
CALL showhist;
END;
IF cmd[1:1] = "b" THEN BEGIN
CALL gohist($INTEGER(cmd[2:*]));
END;
END
WHILE
cmd[1:1] <> "q";

! exit cleanup
DOCOMMAND "DEL GOPHER.TMP";
DOCOMMAND "EXP";
DISPLAY "Cleanup complete. Bye!";

END

PROCEDURE showfile;
BEGIN
INTEGER RD, L;
STRING In_record,pad;
L=0;
pad="00";
RD = $OPEN ("GOPHER.TMP", $INPUT);
IF RD <> 0 THEN BEGIN
DO BEGIN
! add line numbers and padding
L=L+1;
IF L>9 THEN pad="0";
IF L>99 THEN pad="";
In_record = $READ(RD);
! display up to first tab
DISPLAY pad+$string(L)+": "+In_record[1:$SEARCH(In_record,$CvItC(9))-1];
END
WHILE
$EOF(RD) = 0;
CALL $CLOSE (RD);
END
END

PROCEDURE follow (INTEGER lnum);
BEGIN
INTEGER RD, L, taba, tabb, tabc;
STRING In_record, To_follow, path, host, port;
EXTERNAL PROCEDURE showfile;
EXTERNAL PROCEDURE dotcpget;

L=0;
RD = $OPEN ("GOPHER.TMP", $INPUT);
IF RD <> 0 THEN BEGIN
DO BEGIN
L=L+1;
In_record = $READ(RD);
IF L = lnum THEN To_follow = In_record;
END
WHILE
$EOF(RD) = 0;
CALL $CLOSE (RD);

IF To_follow <> "" THEN BEGIN
taba = $SEARCH(To_follow,$CvItC(9));
tabb = $SEARCH(To_follow[taba+1:*],$CvItC(9))+taba;
tabc = $SEARCH(To_follow[tabb+1:*],$CvItC(9))+tabb;
path = To_follow[taba+1:tabb-taba-1];
host = To_follow[tabb+1:tabc-tabb-1];
port = To_follow[tabc+1:*];
! DISPLAY "Fetching PATH="+path+" HOST="+host+" PORT="+port+" ...";
CALL dotcpget(host+" "+port+" '"+path+"'");
CALL showfile;
END;
END
END

PROCEDURE dotcpget (STRING fetch);
BEGIN
INTEGER SHC;
DOCOMMAND "EXP";
DISPLAY "Fetching "+fetch+" ...";
DOCOMMAND "TCPGET.EXE "+fetch+" GOPHER.TMP";
! session history
SHC = $OPEN ("GOPHER.HISTORY", $APPEND);
IF SHC <> 0 THEN BEGIN
CALL $WRITE(SHC,fetch);
CALL $CLOSE(SHC);
END;
END

PROCEDURE showhist;
BEGIN
INTEGER RD, L;
STRING In_record;

RD = $OPEN ("GOPHER.HISTORY", $INPUT);
IF RD <> 0 THEN BEGIN
DO BEGIN
L=L+1;
In_record = $READ(RD);
DISPLAY $STRING(L)+": "+In_record;
END
WHILE
$EOF(RD) = 0;

CALL $CLOSE (RD);
END;
END

PROCEDURE gohist (INTEGER lnum);
BEGIN
INTEGER RD, L;
STRING In_record, To_follow;
EXTERNAL PROCEDURE dotcpget;
EXTERNAL PROCEDURE showfile;

RD = $OPEN ("GOPHER.HISTORY", $INPUT);
IF RD <> 0 THEN BEGIN
DO BEGIN
L=L+1;
In_record = $READ(RD);
IF L = lnum THEN To_follow = In_record;
END
WHILE
$EOF(RD) = 0;
CALL $CLOSE (RD);
END;

IF To_follow <> "" THEN BEGIN
CALL dotcpget(To_follow);
CALL showfile;
END;
END