! A makeshift gopher client for TOPS-20
! in Programmable Control Language
! tfurrows@sdf.org, 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