home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d01xx / d0176.lha / HyperNet / HypNetVx.For < prev    next >
Text File  |  1989-02-04  |  5KB  |  197 lines
  1. C SIMPLE-MINDED HYPERTEXT ON TERMINALS
  2. C DRIVEN OFF A FILE OF FORM
  3. C   +NODENAME
  4. C   $(ANY ACTION COMMAND TO BE SPAWNED) (or start with & for spawn/nowait)
  5. C   >NEXT-NODE-1
  6. C   >NEXT-NODE-2
  7. C   >NEXT-NODE-3
  8. C    ...
  9. C  REPEATED FOR LOTS OF NODES.
  10.     INTEGER*4 ISTAT,IFLG
  11. C USE LIB$SPAWN TO EMIT COMMANDS. SLOW BUT THIS IS A KLUDGE DEMO
  12. C WHICH WILL BE A FIRST STEP ONLY.
  13.     CHARACTER*128 CMDC
  14.     CHARACTER*1 CMD(128)
  15.     EQUIVALENCE (CMDC,CMD(1))
  16. C ALLOWS US TO WORK WITH CHARS OF COMMAND PROGRAMMATICALLY
  17.     CHARACTER*1 FILRD(128)
  18.     CHARACTER*128 FILC
  19.     EQUIVALENCE (FILC,FILRD(1))
  20. C ALLOWS READING LINES OF TEXT.
  21.     Character*128 FilNam
  22.     CHARACTER*128 CURNODE
  23.     CHARACTER*128 SUCCNODE(16)
  24. C ALLOW UP TO 16 SUCCESSOR NODES.
  25. C
  26. C OPEN THE CONSOLE
  27.     OPEN(UNIT=5,FILE='SYS$INPUT',CARRIAGECONTROL='NONE',
  28.      1  status='OLD')
  29.     OPEN(UNIT=6,FILE='SYS$OUTPUT',CARRIAGECONTROL='NONE',
  30.      1  status='new')
  31. C FORGET ABOUT FORTRASH CARRIAGE CONTROLS.
  32. C SET UP CURRENT NODE AS "START"
  33.     IFLG=1
  34.     call cclr
  35.     call cpos(1,1)
  36.     call cput('Enter filename of data file:',28)
  37.     call cget(filnam,IFNSZ)
  38.     call cpos(2,1)
  39.     call cput('Pause before menus [Y/N]:',25)
  40.     ipaus=0
  41.     call cget(filc,iii)
  42.     if(filc(1:1).eq.'y'.or.filc(1:1).eq.'Y')ipaus=1
  43. 998    CONTINUE
  44.     CURNODE='+START' // CHAR(0)
  45. 1000    CONTINUE
  46. C OPEN THE DATA FILE.
  47. C MUST HAVE NODENAME START SOMEPLACE.
  48.     OPEN(UNIT=1,NAME=FilNam(1:IFNSZ),ACCESS='Sequential',
  49.      1   FORM='FORMATTED',STATUS='OLD',readonly)
  50. 1050    CONTINUE
  51. C READ THE DATA FILE UNTIL WE FIND CURRENT NODE DESIRED.
  52.     READ(1,100,END=9000)FILC
  53. 100    FORMAT(A)
  54.     If(Filc(1:1).ne.'+')goto 1050
  55.     IF(ICMPST(CURNODE,FILC).EQ.0)GOTO 1050
  56. C GOT THE NODE.
  57. C NOW READ THE COMMAND TO EXECUTE.
  58.     READ(1,100,END=9990)CMDC
  59.     ISUC=1
  60.     IF(CMDC(1:1).NE.'$'.and.CMDC(1:1).ne.'&'
  61.      1     .AND.CMDC(1:1).EQ.'>')THEN
  62.       ISUC=2
  63.       SUCCNODE(1)=CMDC
  64.     END IF
  65.     MXSUC=ISUC-1
  66.     DO 2000 I=ISUC,16
  67. C AT MOST 16 SUCCESSOR NODES
  68.     READ(1,100,END=2020)FILC
  69.     IF(FILC(1:1).NE.'>')GOTO 2020
  70.     SUCCNODE(I)=FILC
  71.     MXSUC=MXSUC+1
  72. 2000    CONTINUE
  73. 2020    CONTINUE
  74.     CLOSE(UNIT=1)
  75. C ALLOW EDITS OF HYPERTEXT FILE TO TAKE EFFECT NEXT TIME VIA CLOSE/REOPEN.
  76. C NOTE WE CAN SPAWN/NOWAIT TO ALLOW MULTIPLE COMMANDS TO TAKE EFFECT.
  77. C
  78. C NOW ISSUE THE COMMAND. USE LIB$SPAWN HERE. A SLIGHT VARIATION WOULD
  79. C REQUIRE USING BOSS AND HANDLE SWITCHING VIA COMMANDS TO BOSS TO FIRE
  80. C UP THE APPLICATION. FOR NOW, DO IT VANILLA.
  81. C spawn with wait if $ seen, with nowait if & seen in col 1.
  82.     IF(CMDC(1:1).EQ.'$')ISTAT=LIB$SPAWN(CMDC(2:127))
  83.     IF(CMDC(1:1).EQ.'&')ISTAT=LIB$SPAWN(CMDC(2:127),,,iflg)
  84. C STRIPS OFF THE CRUFT AT THE START AND FIRES IT UP.
  85. C
  86. C NOW DISPLAY THE MENU AND GO TRY AGAIN.
  87.     CALL CPOS(24,1)
  88.     If(Ipaus.eq.1)CALL CPUT('Return when ready for menu:',27)
  89.     If(Ipaus.eq.1)Call CGET(filc,iiii)
  90.     Call CCLR
  91. C clear screen
  92.     Call CPOS(1,1)
  93. C go to top left
  94.     If(Mxsuc.lt.1)goto 998
  95.     do 2500 i=1,MXSUC
  96.     write(filc(1:2),2501)i
  97. 2501    format(i2)
  98.     cmdc=filc(1:2)//' '//succnode(i)(2:76)
  99.     Call cpos(i,2)
  100.     Call CPUT(cmdc,78)
  101. 2500    Continue
  102. C Now get his reply for selection. Do by number for the
  103. C time being, since that's the simplest way to do it.
  104. 2504    Continue
  105.     cmdc=' '
  106.     Call CPOS(20,10)
  107. C move to line 20, col 10
  108.     Call CPUT('Enter choice (number):',22)
  109.     Call CGET(cmdc,iii)
  110.     read(cmdc,2503,err=9990,end=9990)i
  111. 2503    Format(bn,I2)
  112. C Edit this format if we allow more choices than 99 in the future
  113. C Loop back if his reply is out of range for this.
  114.     If(i.eq.99)goto 998
  115.     If(i.eq.98)goto 9990
  116. C restart on an input of 99
  117.     If(i.lt.0.or.i.gt.MXSUC) goto 2504
  118. C Got a valid (apparently) choice.
  119. C Make it the new current node and go back.
  120.     CURNODE=SUCCNODE(I)
  121.     Curnode(1:1)='+'
  122. C Fix up with + in col 1 so we need not mask this stuff off.
  123.     GOTO 1000
  124. 9000    CONTINUE
  125.     CALL CCLR
  126.     CALL CPOS(6,4)
  127.     CALL CPUT('UNKNOWN NODE. RESTARTING.',25)
  128.     CLOSE(UNIT=1)
  129.     GOTO 998
  130. 9990    CONTINUE
  131.     Close(unit=1)
  132. c be sure lun 1 is closed...safety.
  133.     STOP 'End HyperNet'
  134.     END
  135.     SUBROUTINE CGET(STRING,LEN)
  136. C GET A CHARACTER STRING IN WITH ITS LENGTH
  137.     CHARACTER*80 STRING
  138.     INTEGER*4 LEN
  139.     READ(5,100)STRING
  140. 100    FORMAT(A)
  141.     DO 1 N=1,80
  142.     NN=81-N
  143.     IF(ICHAR(STRING(NN:NN)).GT.32)GOTO 2
  144. 1    CONTINUE
  145. 2    CONTINUE
  146.     LEN=NN
  147.     RETURN
  148.     END
  149.     SUBROUTINE CPUT(STRING,LEN)
  150. C    WRITE STRING OF LENGTH "LEN"
  151.     CHARACTER*128 STRING
  152.     INTEGER*4 LEN
  153.     WRITE(6,100)STRING(1:LEN)
  154. 100    FORMAT(A)
  155.     RETURN
  156.     END
  157.     SUBROUTINE CPOS(IR,IC)
  158. C MOVE TO ROW IR, COL IC
  159.     INTEGER*4 IR,IC
  160.     CHARACTER*3 CR,CC
  161.     CHARACTER*1 IE
  162.     IE=CHAR(27)
  163.     WRITE(CR,1)IR
  164. 1    FORMAT(I3.3)
  165.     WRITE(CC,1)IC
  166.     WRITE(6,2)IE,CR,CC
  167. 2    FORMAT(A,'[',A,';',A,'H')
  168.     RETURN
  169.     END
  170.     SUBROUTINE CCLR
  171. C CLEAR DISPLAY
  172.     CHARACTER*1 IE
  173.     IE=CHAR(27)
  174.     WRITE(6,1)IE,IE
  175. 1    FORMAT(A,'[H',A,'[J')
  176.     RETURN
  177.     END
  178.     FUNCTION ICMPST(STRING1,STRING2)
  179.     CHARACTER*128 STRING1,STRING2
  180. C COMPARE TWO STRINGS, STOPPING ON NULL TERMINATORS
  181.     INTEGER*4 IRS
  182.     IRS=1
  183.     DO 100 I=1,128
  184.     IF(ICHAR(STRING1(I:I)).LE.32)GOTO 100
  185.     IF(ICHAR(STRING2(I:I)).LE.32)GOTO 100
  186.     IF(ICHAR(STRING1(I:I)).LE.0)GOTO 300
  187.     IF(ICHAR(STRING2(I:I)).LE.0)GOTO 300
  188.     IF(STRING1(I:I).NE.STRING2(I:I))GOTO 200
  189. 100    CONTINUE
  190.     GOTO 300
  191. 200    CONTINUE
  192.     IRS=0
  193. 300    CONTINUE
  194.     ICMPST=IRS
  195.     RETURN
  196.     END
  197.