C SIMPLE-MINDED HYPERTEXT ON TERMINALS
C DRIVEN OFF A FILE OF FORM
C   +NODENAME
C   $(ANY ACTION COMMAND TO BE SPAWNED) (or start with & for spawn/nowait)
C   >NEXT-NODE-1
C   >NEXT-NODE-2
C   >NEXT-NODE-3
C    ...
C  REPEATED FOR LOTS OF NODES.
	INTEGER*4 ISTAT,IFLG
C USE LIB$SPAWN TO EMIT COMMANDS. SLOW BUT THIS IS A KLUDGE DEMO
C WHICH WILL BE A FIRST STEP ONLY.
	CHARACTER*128 CMDC
	CHARACTER*1 CMD(128)
	EQUIVALENCE (CMDC,CMD(1))
C ALLOWS US TO WORK WITH CHARS OF COMMAND PROGRAMMATICALLY
	CHARACTER*1 FILRD(128)
	CHARACTER*128 FILC
	EQUIVALENCE (FILC,FILRD(1))
C ALLOWS READING LINES OF TEXT.
	Character*128 FilNam
	CHARACTER*128 CURNODE
	CHARACTER*128 SUCCNODE(16)
C ALLOW UP TO 16 SUCCESSOR NODES.
C
C OPEN THE CONSOLE
	OPEN(UNIT=5,FILE='SYS$INPUT',CARRIAGECONTROL='NONE',
     1  status='OLD')
	OPEN(UNIT=6,FILE='SYS$OUTPUT',CARRIAGECONTROL='NONE',
     1  status='new')
C FORGET ABOUT FORTRASH CARRIAGE CONTROLS.
C SET UP CURRENT NODE AS "START"
	IFLG=1
	call cclr
	call cpos(1,1)
	call cput('Enter filename of data file:',28)
	call cget(filnam,IFNSZ)
	call cpos(2,1)
	call cput('Pause before menus [Y/N]:',25)
	ipaus=0
	call cget(filc,iii)
	if(filc(1:1).eq.'y'.or.filc(1:1).eq.'Y')ipaus=1
998	CONTINUE
	CURNODE='+START' // CHAR(0)
1000	CONTINUE
C OPEN THE DATA FILE.
C MUST HAVE NODENAME START SOMEPLACE.
	OPEN(UNIT=1,NAME=FilNam(1:IFNSZ),ACCESS='Sequential',
     1   FORM='FORMATTED',STATUS='OLD',readonly)
1050	CONTINUE
C READ THE DATA FILE UNTIL WE FIND CURRENT NODE DESIRED.
	READ(1,100,END=9000)FILC
100	FORMAT(A)
	If(Filc(1:1).ne.'+')goto 1050
	IF(ICMPST(CURNODE,FILC).EQ.0)GOTO 1050
C GOT THE NODE.
C NOW READ THE COMMAND TO EXECUTE.
	READ(1,100,END=9990)CMDC
	ISUC=1
	IF(CMDC(1:1).NE.'$'.and.CMDC(1:1).ne.'&'
     1     .AND.CMDC(1:1).EQ.'>')THEN
	  ISUC=2
	  SUCCNODE(1)=CMDC
	END IF
	MXSUC=ISUC-1
	DO 2000 I=ISUC,16
C AT MOST 16 SUCCESSOR NODES
	READ(1,100,END=2020)FILC
	IF(FILC(1:1).NE.'>')GOTO 2020
	SUCCNODE(I)=FILC
	MXSUC=MXSUC+1
2000	CONTINUE
2020	CONTINUE
	CLOSE(UNIT=1)
C ALLOW EDITS OF HYPERTEXT FILE TO TAKE EFFECT NEXT TIME VIA CLOSE/REOPEN.
C NOTE WE CAN SPAWN/NOWAIT TO ALLOW MULTIPLE COMMANDS TO TAKE EFFECT.
C
C NOW ISSUE THE COMMAND. USE LIB$SPAWN HERE. A SLIGHT VARIATION WOULD
C REQUIRE USING BOSS AND HANDLE SWITCHING VIA COMMANDS TO BOSS TO FIRE
C UP THE APPLICATION. FOR NOW, DO IT VANILLA.
C spawn with wait if $ seen, with nowait if & seen in col 1.
	IF(CMDC(1:1).EQ.'$')ISTAT=LIB$SPAWN(CMDC(2:127))
	IF(CMDC(1:1).EQ.'&')ISTAT=LIB$SPAWN(CMDC(2:127),,,iflg)
C STRIPS OFF THE CRUFT AT THE START AND FIRES IT UP.
C
C NOW DISPLAY THE MENU AND GO TRY AGAIN.
	CALL CPOS(24,1)
	If(Ipaus.eq.1)CALL CPUT('Return when ready for menu:',27)
	If(Ipaus.eq.1)Call CGET(filc,iiii)
	Call CCLR
C clear screen
	Call CPOS(1,1)
C go to top left
	If(Mxsuc.lt.1)goto 998
	do 2500 i=1,MXSUC
	write(filc(1:2),2501)i
2501	format(i2)
	cmdc=filc(1:2)//' '//succnode(i)(2:76)
	Call cpos(i,2)
	Call CPUT(cmdc,78)
2500	Continue
C Now get his reply for selection. Do by number for the
C time being, since that's the simplest way to do it.
2504	Continue
	cmdc=' '
	Call CPOS(20,10)
C move to line 20, col 10
	Call CPUT('Enter choice (number):',22)
	Call CGET(cmdc,iii)
	read(cmdc,2503,err=9990,end=9990)i
2503	Format(bn,I2)
C Edit this format if we allow more choices than 99 in the future
C Loop back if his reply is out of range for this.
	If(i.eq.99)goto 998
	If(i.eq.98)goto 9990
C restart on an input of 99
	If(i.lt.0.or.i.gt.MXSUC) goto 2504
C Got a valid (apparently) choice.
C Make it the new current node and go back.
	CURNODE=SUCCNODE(I)
	Curnode(1:1)='+'
C Fix up with + in col 1 so we need not mask this stuff off.
	GOTO 1000
9000	CONTINUE
	CALL CCLR
	CALL CPOS(6,4)
	CALL CPUT('UNKNOWN NODE. RESTARTING.',25)
	CLOSE(UNIT=1)
	GOTO 998
9990	CONTINUE
	Close(unit=1)
c be sure lun 1 is closed...safety.
	STOP 'End HyperNet'
	END
	SUBROUTINE CGET(STRING,LEN)
C GET A CHARACTER STRING IN WITH ITS LENGTH
	CHARACTER*80 STRING
	INTEGER*4 LEN
	READ(5,100)STRING
100	FORMAT(A)
	DO 1 N=1,80
	NN=81-N
	IF(ICHAR(STRING(NN:NN)).GT.32)GOTO 2
1	CONTINUE
2	CONTINUE
	LEN=NN
	RETURN
	END
	SUBROUTINE CPUT(STRING,LEN)
C	WRITE STRING OF LENGTH "LEN"
	CHARACTER*128 STRING
	INTEGER*4 LEN
	WRITE(6,100)STRING(1:LEN)
100	FORMAT(A)
	RETURN
	END
	SUBROUTINE CPOS(IR,IC)
C MOVE TO ROW IR, COL IC
	INTEGER*4 IR,IC
	CHARACTER*3 CR,CC
	CHARACTER*1 IE
	IE=CHAR(27)
	WRITE(CR,1)IR
1	FORMAT(I3.3)
	WRITE(CC,1)IC
	WRITE(6,2)IE,CR,CC
2	FORMAT(A,'[',A,';',A,'H')
	RETURN
	END
	SUBROUTINE CCLR
C CLEAR DISPLAY
	CHARACTER*1 IE
	IE=CHAR(27)
	WRITE(6,1)IE,IE
1	FORMAT(A,'[H',A,'[J')
	RETURN
	END
	FUNCTION ICMPST(STRING1,STRING2)
	CHARACTER*128 STRING1,STRING2
C COMPARE TWO STRINGS, STOPPING ON NULL TERMINATORS
	INTEGER*4 IRS
	IRS=1
	DO 100 I=1,128
	IF(ICHAR(STRING1(I:I)).LE.32)GOTO 100
	IF(ICHAR(STRING2(I:I)).LE.32)GOTO 100
	IF(ICHAR(STRING1(I:I)).LE.0)GOTO 300
	IF(ICHAR(STRING2(I:I)).LE.0)GOTO 300
	IF(STRING1(I:I).NE.STRING2(I:I))GOTO 200
100	CONTINUE
	GOTO 300
200	CONTINUE
	IRS=0
300	CONTINUE
	ICMPST=IRS
	RETURN
	END