!
! 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/
! ckaiser@floodgap.com
!
! 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