!
! GAMBLE
! Gopher Alpha Micro Browsing/Linking Environment
! Released under the Floodgap Free Software License
!
! Requires XCALLs RENAME, ECHO, NOECHO and ACCEPT.
!
! (C)2020 Cameron Kaiser. All rights reserved.
! http://ampm.floodgap.com/www/gamble.htm * gopher://gopher.floodgap.com/
! [email protected]
!
! GOPHER.LIT is a hacked version of Alpha Micro FINGER.LIT and is released
! under the same terms and conditions as the corresponding version of AlphaTCP,
! including any required and/or applicable SSD restrictions.
!
! Version history
! 1.0     Initial release
!
program gamble,1.0(1)
map1 ctrl'c,f,,1
on error goto g'quit

!!!!
! variable storage
!!!!

! tested on telnet, am-65 and am-75
maxrows=21

! intermediate storage filenames
! these are used for GAMBLE's state
strsiz 10
ibase$="GAMTMP"
iscr$=ibase$ + ".CMD"
istat$=ibase$ + ".TMP"
! this is used for files loaded by GOPHER.LIT. should be ONE CHARACTER ONLY!
! (.lst is appended)
istor$="G"
! this is used for the two intermediates. .LST is appended
istora$="GG"
istorb$="GGG"

! no history ... and doomed to repeat it
history=0

! itypes are single character
strsiz 1
q$=chr(34)
t$=chr(9)
i$="1":dim ih$(10)

! hosts, selectors, arguments top out at 255 characters
strsiz 255
h$="gopher.floodgap.com":dim hh$(10)
s$="/archive/alpha-micro/gopher":dim sh$(10)
ar$="":dim arh$(10)
! we don't need to remember itypes because only menus link to things

! we don't store the port anywhere because GOPHER.LIT, since it uses
! TCP:SERVIC., is limited to the port in that file (i.e., port 70).

! menu items
dim mh$(26)
dim ms$(26)
dim mi$(26)

e$="                                                                             "
a$=""

! used for calculating how long a selector+host is too long
chaff$="gophersqqasg"+istor$
maxlen=92

!!!!
! main program
!!!!

! see if a file to process is available
lookup istorb$ + ".LST",pf:if pf<>0 then goto g'process
! no file available, fall through

! create intermediate script and fetch a selector to a file
g'fetch:
       if instr(1,s$,"@") > 0 or instr(1,h$,"@") > 0 then &
               print "?Cannot use @ in selector or host": &
               end ! XXX
       if instr(1,s$,q$) > 0 or instr(1,h$,q$) > 0 then &
               print "?Cannot use quotes in selector or host": &
               end ! XXX

       ! don't proceed if there is a file clash
       lookup iscr$,x
       if x<>0 then print "?";iscr$;" already exists, aborting":end
       lookup istat$,x
       if x<>0 then print "?";istat$;" already exists, aborting":end

       print tab(-1,32);"Connecting to ";h$;tab(-1,33);
       ! create intermediate script to call SYS:GOPHER.LIT
       open #1,iscr$,output
       print #1 ":R" ! using :S doesn't seem to work right for this
       print #1 "SET REDIR"
       com$ = "GOPHER " + q$ + s$
       if len(ar$) > 0 then com$ = com$ + t$ + ar$
       com$ = com$ + "@" + h$ + q$ + " >" + istor$
       if len(com$) > maxlen then &
               print "?Cannot access a selector this long": &
               end
       print #1 com$
       print #1 "STRCR ";istora$;".LST=";istor$;".LST"
       print #1 "TRIMC ";istorb$;".LST=";istora$;".LST"
       print #1 "RUN TCP:GAMBLE.RUN"
       close #1

       ! store state
       ! we cannot use common to recover state, because common.sbr whacks tcp,
       ! and we probably require too much shared memory; we cannot use cmdlin
       ! because we want to be compatible with regular AlphaBASIC and there's
       ! insufficient space. so, we save our state in a save file.
       open #1,istat$,output
       print #1 history
       print #1 h$
       print #1 s$
       print #1 i$
       print #1 ar$
       for i=1 to 10
               print #1 hh$(i)
               print #1 sh$(i)
               print #1 ih$(i)
               print #1 arh$(i)
       next
       close #1

       ! execute
       chain iscr$
       end

! load and display the menu, as appropriate
! this may be reentrant, so check the status of any intermediate files
g'process:
       ! clean up intermediate script
       lookup iscr$,x: if x<>0 then kill iscr$

       ! retrieve state from save file
       lookup istat$,x
       if x<>0 then &
               open #1,istat$,input: &
               input line #1,a$:history=val(a$): &
               input line #1,h$: &
               input line #1,s$: &
               input line #1,i$: &
               input line #1,ar$: &
               for i=1 to 10: &
                       input line #1,hh$(i): &
                       input line #1,sh$(i): &
                       input line #1,ih$(i): &
                       input line #1,arh$(i): &
               next: &
               close #1: &
               kill istat$

       ! clean up other intermediate files
       ! do this here instead of the script to suppress messages
       lookup istor$+".LST",x:if x<>0 then kill istor$+".LST"
       lookup istora$+".LST",x:if x<>0 then kill istora$+".LST"

       if pf<1 then goto g'itype'empty

       ! deal with dorky terminal drivers
       print tab(-1,9)
       print tab(-1,3);e$
       print tab(-1,3);

       ! treat html like plain text
       if i$="0" or i$="h" then goto g'itype'0
       if i$="1" or i$="7" then goto g'itype'1

       ! fall through to:
g'itype'huh:

       ! save file to disk
       print "Enter filename to save (blank aborts)> ";
       input line a$
       if a$="" then goto g'back

       xcall rename,istorb$+".LST",a$,status
       if status=0 then print "Successfully saved as ";a$:goto g'back

       print "Failed to save to provided filename"
       goto g'itype'huh

g'itype'empty:

       ! file was empty, must have been a problem
       print
       prompt$="Error receiving answer, </> goto, <TAB> back, <ESC> quit"
       gosub g'interface
       if ck = -1 then goto g'back
       if ck = -2 then goto g'navigate
       goto g'itype'empty

g'itype'1:

       ! display and parse menu
       open #1, istorb$ + ".LST", input:rows=0:mitems=0:ditems=0:openf=1
       prompt$="Gopher menu, press letter, </> goto, <TAB> back, <ESC> quit, <SPACE> more"
       key$=""
       print ""
       print ""

       g'itype'10:
               if eof(1) then &
                       prompt$="End of menu, press letter, </> goto, <TAB> back, <ESC> quit, <SPACE> again": &
                       close #1: openf = 0: &
                       for i = rows to maxrows: &
                               print: &
                       next i: &
                       orows = rows:rows = maxrows + 1: &
                       if orows=0 then prompt$="NO DATA, </> goto, <TAB> back, <ESC> quit"
               if rows > maxrows then goto g'itype'12

               ! attempt to parse the line
               input line #1, a$:l=len(a$)
               if l<4 then goto g'itype'10 ! can't possibly be valid

               ! display string/selector. display string can be blank.
               t1=instr(1,a$,t$)
               if t1=0 or t1=l then goto g'itype'10 ! bogus, not RFC1436
               if t1=1 then goto g'itype'10 ! bogus, no item type

               ! selector/host. selector can be blank, host can't.
               t2=instr(t1+1,a$,t$)
               if t2=0 or t2=l then goto g'itype'10 ! still bogus

               ! host/port. neither can be blank.
               t3=instr(t2+1,a$,t$)
               if t3=0 or t3=l then goto g'itype'10 ! still bogus
               if t3=(t2+1) then goto g'itype'10 ! must not be blank

               ! possible to have trailing fields after the port.
               ! these are acceptable, but we ignore them.
               t4=instr(t3+1,a$,t$)

               ! extract item type and display string
               bi$=a$[1;1]:ds$=a$[2,t1-1]:ds$=left(ds$,75)
               rows=rows+1
               ibyte$=">"

               ! display i item type in low intensity
               if bi$="i" then &
                       print " > ";tab(-1,11);ds$;tab(-1,12): &
                       goto g'itype'10
               ! display 3 item type in high intensity
               if bi$="3" then print " ! ";ds$:goto g'itype'10

               ! display other item types in regular intensity underlined
               ! and assign valid menu options a letter key EXCEPT THESE:

               ! * if port != 70, then we can't access it with GOPHER.LIT
               p$=a$[t3+1,-1]:if t4>0 then p$=a$[t3;t4-1]
               if p$<>"70" then print"-";:goto g'itype'11

               ! * if there is a @ or " in the selector or host, we can't
               !   access it with GOPHER.LIT either
               bs$="":if (t2-t1 > 1) then bs$=a$[t1+1,t2-1]
               bh$=a$[t2+1,t3-1]
               if instr(1,bs$,"@") > 0 or instr(1,bh$,"@") > 0 or &
                       instr(1,bs$,q$) > 0 or instr(1,bh$,q$) > 0 then &
                               print"-";:goto g'itype'11

               ! * if the resulting host and selector pair would be too long,
               !   it won't fit in the driver script (wait for the TAMED
               !   version, kids)
               if len(bs$+bh$+chaff$)>maxlen then print "-";:goto g'itype'11

               ! * if this is a hURL, we don't support that
               if left(bs$,4)="URL:" or left(bs$,5)="/URL:" then &
                       print "-";:goto g'itype'11

               ! * if this is itype 2 CSO, we don't support that either
               !   (or Telnet, or TN3270). we could support telnet with a
               !   callout, but that can be done later.
               if bi$="2" or bi$="8" or bi$="T" then print"-";:goto g'itype'11

               ! looks good, let's give it a key
               if bi$<>"0" and bi$<>"1" and bi$<>"h" then ibyte$="$"
               if bi$="7" then ibyte$="?"
               ditems=ditems+1
               mi$(ditems)=bi$
               ms$(ditems)=bs$
               mh$(ditems)=bh$
               print chr(96+ditems);
               if ditems=26 then ditems=0
               mitems=mitems+1:if mitems=27 then mitems=26

       g'itype'11:
               print ibyte$;tab(-1,30);ds$;tab(-1,31)
               goto g'itype'10

       g'itype'12:
               gosub g'interface
               rows = 0
               if ck<>0 and openf<>0 then close #1:openf=0
               if ck = -1 then goto g'back
               if ck = -2 then goto g'navigate
               ! shift-letter: always download (but not itype 7)
               if ck > 64 then &
                       if mi$(ck-64)="7" then &
                               print "Can't download that type of menu item": &
                               goto g'itype'12
               if ck > 64 then &
                       ck = ck - 64: &
                       ni$="9": &
                       nh$=mh$(ck): &
                       ns$=ms$(ck): &
                       goto g'navigate
               ! regular letter: link or download as appropriate
               if ck > 0 then &
                       ni$=mi$(ck): &
                       nh$=mh$(ck): &
                       ns$=ms$(ck): &
                       goto g'navigate
               if eof(1) then goto g'itype'1
               goto g'itype'10

g'itype'0:

       ! display and page the file
       open #1, istorb$ + ".LST", input:rows=0:mitems=0:openf=1
       prompt$="Text file, </> goto, <TAB> back, <ESC> quit, <SPACE> more"

       g'itype'00:
               if eof(1) then &
                       prompt$="End of file, </> goto, <TAB> back, <ESC> quit, <SPACE> again": &
                       close #1: openf=0: &
                       for i = rows to maxrows: &
                               print: &
                       next i: &
                       orows = rows:rows = maxrows + 1: &
                       if orows=0 then prompt$="NO DATA, </> goto, <TAB> back, <ESC> quit"
               if rows > maxrows then goto g'itype'01
               input line #1, a$
               print a$
               rows = rows + 1 + int(len(a$)/79)
               goto g'itype'00

       g'itype'01:
               gosub g'interface
               rows = 0

               if ck<>0 and openf<>0 then close #1:openf=0
               if ck = -1 then goto g'back
               if ck = -2 then goto g'navigate
               if eof(1) then goto g'itype'0
               goto g'itype'00

g'navigate:
       nar$="":if ni$="7" then goto g'itype'7'search
g'navigate'1:
       print "": print ""

       ! assign to history (only if current itype is a menu)
       if i$<>"7" and i$<>"1" then goto g'navigate'2
       history=history+1
       if history=11 then for i=1 to 9: &
               hh$(i)=hh$(i+1):sh$(i)=sh$(i+1):arh$(i)=arh$(i+1): &
               next:history=10
       hh$(history)=h$
       sh$(history)=s$
       arh$(history)=ar$

g'navigate'2:
       i$=ni$
       s$=ns$
       h$=nh$
       ar$=nar$
       gosub g'kill'istorb
       goto g'fetch

g'itype'7'search:
       nar$=""
       print "":print "Enter parameters (blank aborts)> ";
       input line a$
       ! this can only be triggered off a menu option, not the / key
       if a$="" then goto g'itype'1
       if instr(1,a$,q$)<>0 or instr(1,a$,"@")<>0 then &
               print "?Can't use quotes or @": &
               goto g'itype'7'search
       if len(nh$+ns$+t$+a$+chaff$)>maxlen then &
               print "?Too long to query with GAMBLE": &
               goto g'itype'7'search
       nar$=a$:goto g'navigate'1

g'back:
       i$="1"
       h$=hh$(history)
       s$=sh$(history)
       ar$=arh$(history)

       history=history-1
       gosub g'kill'istorb
       goto g'fetch

g'interface:
       print tab(-1,32);prompt$;tab(-1,33);
       xcall noecho:xcall accept,ck:xcall echo
       ! deal with dorky terminal drivers
       print tab(-1,9)
       print tab(-1,3);e$
       print tab(-1,3);
       if ck=32 or ck=10 or ck=13 then ck=0:return
       if ck=9 then &
               if history>0 then &
                       ck=-1:return: &
               else &
                       print "": print "Can't go back any further": &
                       goto g'interface
       if ck=61 then &
               print "": &
               print "Selector: ";s$: &
               print "Host:     ";h$: &
               print "Port:     70":  &
               print "":goto g'interface
       if ck=47 then &
               print "": &
               print "New host> ";:input line nh$: &
               if nh$<>"" then print "New menu selector> ";:input line ns$: &
               ck=-2:ni$="1":return
       if ck=27 then goto g'quit
       if ck>96 then ck=ck-96:if ck<=mitems then return
       if ck>64 then if (ck-64)<=mitems then return
       goto g'interface

g'kill'istorb:
       lookup istorb$+".LST",x:if x<>0 then kill istorb$ + ".LST"
       return

g'quit:
       gosub g'kill'istorb
       print
       print
       print "Goodbye from GAMBLE 1.0 (C)2020 Cameron Kaiser"

       end

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.