home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d176 / hypernet.lha / HyperNet / HypNet2.For < prev    next >
Text File  |  1989-02-04  |  9KB  |  330 lines
  1. C compilation:
  2. C f77 -k -h -u -* HyperNet.for
  3. C link:
  4. C f77l -y hypernet amiga.sub
  5. C
  6. C SIMPLE-MINDED HYPERTEXT ON TERMINALS
  7. C DRIVEN OFF A FILE OF FORM
  8. C   +NODENAME
  9. C   $(ANY ACTION COMMAND TO BE SPAWNED) (or start with & for spawn/nowait)
  10. C   >NEXT-NODE-1
  11. C   >NEXT-NODE-2
  12. C   >NEXT-NODE-3
  13. C    ...
  14. C  REPEATED FOR LOTS OF NODES.
  15. C By Glenn Everhart
  16. C 25 Sleigh Ride Rd
  17. C Glen Mills PA 19342
  18. C
  19. C Public domain...use & enjoy.
  20. C  gce 9/3/1988
  21.     INTEGER*4 ISTAT,IFLG
  22.         Integer*4 ScrCnt
  23. C USE LIB$SPAWN TO EMIT COMMANDS. SLOW BUT THIS IS A KLUDGE DEMO
  24. C WHICH WILL BE A FIRST STEP ONLY.
  25.     INCLUDE DOS.INC
  26.     INTEGER*4 AMIGA
  27.     CHARACTER*128 CMDC
  28.     CHARACTER*1 CMD(128)
  29.     EQUIVALENCE (CMDC,CMD(1))
  30. C ALLOWS US TO WORK WITH CHARS OF COMMAND PROGRAMMATICALLY
  31.     CHARACTER*1 FILRD(128)
  32.     CHARACTER*128 FILC
  33.     EQUIVALENCE (FILC,FILRD(1))
  34. C ALLOWS READING LINES OF TEXT.
  35. C Keep track of recent statuses so we can go back a few. Trust that
  36. C just allowing the menu to do this may suffice for the present to
  37. C handle the need.
  38.         Character*128 OldCur(10),WrkCur
  39.         Integer*4 IIII,NSav
  40.     Character*128 FilNam
  41.     CHARACTER*128 CURNODE
  42.     CHARACTER*128 SUCCNODE(16)
  43. C ALLOW UP TO 16 SUCCESSOR NODES.
  44. C
  45. C OPEN THE CONSOLE
  46. C    OPEN(UNIT=5,FILE='SYS$INPUT',CARRIAGECONTROL='NONE',
  47. C     1  status='OLD')
  48. C    OPEN(UNIT=6,FILE='SYS$OUTPUT',CARRIAGECONTROL='NONE',
  49. C     1  status='new')
  50. C FORGET ABOUT FORTRASH CARRIAGE CONTROLS.
  51. C SET UP CURRENT NODE AS "START"
  52.     IFLG=1
  53.         Call CCLR
  54.         Call CPos(10,1)
  55.         Call CPut('HyperNet V01-02A  by Glenn C. Everhart',38)
  56.         Call Cpos(20,1)
  57.         Call CPut('Compiled by Absoft Fortran 2.3',30)
  58.         NSav=1
  59.     call cclr
  60.         Call CPos(10,1)
  61.         Call CPut('HyperNet V01-02A  by Glenn C. Everhart',38)
  62.     call cpos(11,1)
  63.     call cput('Enter filename of data file:',28)
  64.     call cget(filnam,IFNSZ)
  65.     call cpos(12,1)
  66.     call cput('Pause before menus [Y/N]:',25)
  67.     ipaus=0
  68.     call cget(filc,iii)
  69.         ScrCnt=0
  70.     if(filc(1:1).eq.'y'.or.filc(1:1).eq.'Y')ipaus=1
  71. 998    CONTINUE
  72.     CURNODE='+START' // CHAR(0)
  73.         Do (iii=1,10)
  74.         OldCur(iii)=CurNode
  75.         End do
  76. 1000    CONTINUE
  77. C OPEN THE DATA FILE.
  78. C MUST HAVE NODENAME START SOMEPLACE.
  79.     OPEN(1,FILE=FilNam(1:IFNSZ),ACCESS='Sequential',
  80.      1   FORM='FORMATTED',STATUS='OLD')
  81. 1050    CONTINUE
  82. C READ THE DATA FILE UNTIL WE FIND CURRENT NODE DESIRED.
  83.     READ(1,100,END=9000)FILC
  84. 100    FORMAT(A)
  85.     If(Filc(1:1).ne.'+')goto 1050
  86.     IF(ICMPST(CURNODE,FILC).EQ.0)GOTO 1050
  87. C GOT THE NODE.
  88. C NOW READ THE COMMAND TO EXECUTE.
  89.     READ(1,100,END=9990)CMDC
  90.     ISUC=1
  91.     IF(CMDC(1:1).NE.'$'.and.CMDC(1:1).ne.'&'
  92.      1     .AND.CMDC(1:1).EQ.'>')THEN
  93.       ISUC=2
  94.       SUCCNODE(1)=CMDC
  95.     END IF
  96.     MXSUC=ISUC-1
  97.     DO 2000 I=ISUC,16
  98. C AT MOST 16 SUCCESSOR NODES
  99.     READ(1,100,END=2020)FILC
  100.     IF(FILC(1:1).NE.'>')GOTO 2020
  101.     SUCCNODE(I)=FILC
  102.     MXSUC=MXSUC+1
  103. 2000    CONTINUE
  104. 2020    CONTINUE
  105.     CLOSE(UNIT=1)
  106. C ALLOW EDITS OF HYPERTEXT FILE TO TAKE EFFECT NEXT TIME VIA CLOSE/REOPEN.
  107. C NOTE WE CAN SPAWN/NOWAIT TO ALLOW MULTIPLE COMMANDS TO TAKE EFFECT.
  108. C
  109. C NOW ISSUE THE COMMAND. USE LIB$SPAWN HERE. A SLIGHT VARIATION WOULD
  110. C REQUIRE USING BOSS AND HANDLE SWITCHING VIA COMMANDS TO BOSS TO FIRE
  111. C UP THE APPLICATION. FOR NOW, DO IT VANILLA.
  112. C spawn with wait if $ seen, with nowait if & seen in col 1.
  113.     IIV=0
  114. C Absoft Fortran seems to have trouble firing off some commands
  115. C directly, so fire off from a newcli, and use a short file in
  116. C ram: to hold the actual command, whatever it may be.
  117. C
  118. C Also arrange for scratch file name to have 0-9 added so that
  119. C the system will not have to re-use names before they have become
  120. C freed. Kludge, but easier than a complete solution, which might
  121. C involve something like ending via a transfer to a command file that
  122. C will delete all tmp.jnk#? files in ram: that it can.
  123.         ScrCnt=Mod(ScrCnt+1,10)
  124.         filc='Ram:Tmp.Jnk'//char(ScrCnt+48) // char(0)
  125.     OPEN(2,FILE=filc)
  126.     REWIND 2
  127.     If(Cmdc(2:2).ne.'&')GoTo 228
  128. C last-minute add-on
  129. C if SECOND character of command line is &, then have an automatic
  130. C  ENDCLI generated after the user's command.
  131.         Write(2,222)Cmdc(3:127)
  132.         Write(2,227)
  133. 227     Format('Endcli')
  134. 228     Continue
  135.         WRITE(2,222)CMDC(2:127)
  136. 229     Continue
  137. 222    Format(A)
  138.     CLOSE (UNIT=2)
  139.         If(cmdc(1:1).ne.'$'.and.Cmdc(1:1).ne.'&')goto 224
  140.         filc='NEWCLI CON:0/0/600/190/Hypnet FROM ram:Tmp.Jnk'
  141.      1   // char(ScrCnt+48) //  Char(0)
  142.         If(cmdc(1:1).eq.'&')filc='Newshell FROM ram:Tmp.Jnk' //
  143.      1  Char(ScrCnt+48) // Char(0)
  144.         ISTAT=AMIGA(EXECUTE,filc,IIV,IIV)
  145. 224     Continue
  146. C STRIPS OFF THE CRUFT AT THE START AND FIRES IT UP.
  147. C
  148. C NOW DISPLAY THE MENU AND GO TRY AGAIN.
  149. 3500    Continue
  150.     CALL CPOS(24,1)
  151.     If(Ipaus.eq.1)CALL CPUT('Return when ready for menu:',27)
  152.     If(Ipaus.eq.1)Call CGET(filc,iiii)
  153.     Call CCLR
  154. C clear screen
  155.     Call CPOS(1,1)
  156. C go to top left
  157.     If(Mxsuc.lt.1)goto 998
  158.     do 2500 i=1,MXSUC
  159.     write(filc(1:2),2501)i
  160. 2501    format(i2)
  161.     cmdc=filc(1:2)//' '//succnode(i)(2:76)
  162.     Call cpos(i,2)
  163.     Call CPUT(cmdc,78)
  164. 2500    Continue
  165. C Now get his reply for selection. Do by number for the
  166. C time being, since that's the simplest way to do it.
  167. 2504    Continue
  168.     cmdc=' '
  169.     Call CPOS(20,10)
  170. C move to line 20, col 10
  171.     Call CPUT('Enter choice (number):',22)
  172.     Call CGET(cmdc,iii)
  173.         If(Cmdc(1:1).eq.'V'.or.cmdc(1:1).eq.'v')Goto 3500
  174. C V command redraws menu.
  175.         If(Cmdc(1:1).eq.'?')Goto 4500
  176. C 4500 shows all saved states currently and allows us to pick one
  177.         If(Ichar(cmdc(1:1)).lt.32)goto 9990
  178. C exit on control char.
  179.     read(cmdc,2503,err=9990,end=9990)i
  180. 2503    Format(bn,I2)
  181. C Edit this format if we allow more choices than 99 in the future
  182. C Loop back if his reply is out of range for this.
  183.     If(i.eq.99)goto 998
  184.     If(i.eq.98)goto 9990
  185. C restart on an input of 99
  186.     If(i.le.0.or.i.gt.MXSUC) goto 2504
  187. C Got a valid (apparently) choice.
  188. C Make it the new current node and go back.
  189.     CURNODE=SUCCNODE(I)
  190.     Curnode(1:1)='+'
  191. C Fix up with + in col 1 so we need not mask this stuff off.
  192.         NSav=NSav+1
  193.         If(NSav.gt.10)NSav=1
  194.         OldCur(NSav)=CurNode
  195.     GOTO 1000
  196. 9000    CONTINUE
  197.     CALL CCLR
  198.     CALL CPOS(6,4)
  199.     CALL CPUT('UNKNOWN NODE. RESTARTING.',25)
  200.     CLOSE(UNIT=1)
  201.     GOTO 998
  202. 9990    CONTINUE
  203.     Close(unit=1)
  204. c be sure lun 1 is closed...safety.
  205.     STOP 'End HyperNet'
  206. 4500     Continue
  207. C Show all saved states and pick one, reset IT as current state, and
  208. C go back & get menus.
  209.         Call CCLR
  210.         Call CPos(1,1)
  211.         Call CPut('Prior Nodes: Choose one for current node',40)
  212. C title...
  213.         Do 3870 iii=1,10
  214.      write(filc(1:2),2501)iii
  215. C go to row i+3, col 1
  216.          WrkCur=filc(1:2) // ' ' // OldCur(iii)(1:75)
  217.          Call CPos(iii+3,1)
  218.          Call Cput(WrkCur,78)
  219. C Write numbered list of prior processes
  220. 3870     Continue
  221.     cmdc=' '
  222.     Call CPOS(20,10)
  223. C move to line 20, col 10
  224.     Call CPUT('Enter choice (number):',22)
  225.     Call CGET(cmdc,iii)
  226.         If(Ichar(cmdc(1:1)).lt.32)goto 9990
  227. C exit on control char.
  228.     read(cmdc,2503,err=3500,end=9990)i
  229. C Edit this format if we allow more choices than 99 in the future
  230. C Loop back if his reply is out of range for this.
  231.     If(i.eq.99)goto 998
  232.     If(i.eq.98)goto 9990
  233. C restart on an input of 99
  234.     If(i.le.0.or.i.gt.10) goto 3500
  235. C Reset current cell to the selected one and retrieve ITS' history
  236. C for the menu business. Then go back and do our "menu-thing" again.
  237.         CurNode=OldCur(i)
  238.         NSav=i
  239. C Now get the file open again and grab the context we just chose
  240.     OPEN(1,FILE=FilNam(1:IFNSZ),ACCESS='Sequential',
  241.      1   FORM='FORMATTED',STATUS='OLD')
  242. 3450    CONTINUE
  243. C READ THE DATA FILE UNTIL WE FIND CURRENT NODE DESIRED.
  244.     READ(1,100,END=9000)FILC
  245.     If(Filc(1:1).ne.'+')goto 3450
  246.     IF(ICMPST(CURNODE,FILC).EQ.0)GOTO 3450
  247. C GOT THE NODE.
  248. C NOW READ THE COMMAND TO EXECUTE.
  249.     READ(1,100,END=9990)CMDC
  250.     ISUC=1
  251.     IF(CMDC(1:1).NE.'$'.and.CMDC(1:1).ne.'&'
  252.      1     .AND.CMDC(1:1).EQ.'>')THEN
  253.       ISUC=2
  254.       SUCCNODE(1)=CMDC
  255.     END IF
  256.     MXSUC=ISUC-1
  257.     DO 3460 I=ISUC,16
  258. C AT MOST 16 SUCCESSOR NODES
  259.     READ(1,100,END=3480)FILC
  260.     IF(FILC(1:1).NE.'>')GOTO 2020
  261.     SUCCNODE(I)=FILC
  262.     MXSUC=MXSUC+1
  263. 3460    CONTINUE
  264. 3480    CONTINUE
  265.     CLOSE(UNIT=1)
  266.         Goto 3500
  267.     END
  268.     SUBROUTINE CGET(STRING,LEN)
  269. C GET A CHARACTER STRING IN WITH ITS LENGTH
  270.     CHARACTER*80 STRING
  271.     INTEGER*4 LEN
  272.     READ(*,100)STRING
  273. 100    FORMAT(A)
  274.     DO 1 N=1,80
  275.     NN=81-N
  276.     IF(ICHAR(STRING(NN:NN)).GT.32)GOTO 2
  277. 1    CONTINUE
  278. 2    CONTINUE
  279.     LEN=NN
  280.     RETURN
  281.     END
  282.     SUBROUTINE CPUT(STRING,LEN)
  283. C    WRITE STRING OF LENGTH "LEN"
  284.     CHARACTER*128 STRING
  285.     INTEGER*4 LEN
  286.     WRITE(*,100)STRING(1:LEN)
  287. 100    FORMAT(A)
  288.     RETURN
  289.     END
  290.     SUBROUTINE CPOS(IR,IC)
  291. C MOVE TO ROW IR, COL IC
  292.     INTEGER*4 IR,IC
  293.     CHARACTER*3 CR,CC
  294.     CHARACTER*1 IE
  295.     IE=CHAR(27)
  296.     WRITE(CR,1)IR
  297. 1    FORMAT(I3.3)
  298.     WRITE(CC,1)IC
  299.     WRITE(*,2)IE,CR,CC
  300. 2    FORMAT(A,'[',A,';',A,'H')
  301.     RETURN
  302.     END
  303.     SUBROUTINE CCLR
  304. C CLEAR DISPLAY
  305.     CHARACTER*1 IE
  306.     IE=CHAR(27)
  307.         WRITE(*,1)IE,IE
  308. 1    FORMAT(A,'[H',A,'[J')
  309.     RETURN
  310.     END
  311.     FUNCTION ICMPST(STRING1,STRING2)
  312.     CHARACTER*128 STRING1,STRING2
  313. C COMPARE TWO STRINGS, STOPPING ON NULL TERMINATORS
  314.     INTEGER*4 IRS
  315.     IRS=1
  316.     DO 100 I=1,128
  317.     IF(ICHAR(STRING1(I:I)).LE.32)GOTO 100
  318.     IF(ICHAR(STRING2(I:I)).LE.32)GOTO 100
  319.     IF(ICHAR(STRING1(I:I)).LE.0)GOTO 300
  320.     IF(ICHAR(STRING2(I:I)).LE.0)GOTO 300
  321.     IF(STRING1(I:I).NE.STRING2(I:I))GOTO 200
  322. 100    CONTINUE
  323.     GOTO 300
  324. 200    CONTINUE
  325.     IRS=0
  326. 300    CONTINUE
  327.     ICMPST=IRS
  328.     RETURN
  329.     END
  330.