home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d01xx / d0144.lha / AnalytiCalc / AnalySources.Arc / AnalASM.Ftn < prev    next >
Text File  |  1987-11-08  |  7KB  |  219 lines
  1. c AnalytiCalc Amiga specific terminal I/O routines.
  2. c note ttyini is also special and opens console window...
  3.     Subroutine SWRT(ibuf,isz)
  4. c write isz bytes from ibuf onto console window
  5.     Include dos.inc
  6.     Integer*4 Isz,i
  7.     Integer*4 Amiga
  8.     External Amiga
  9. C    common/consfh/fh
  10.     CHARACTER*1 OARRY(100)
  11.     InTeGer*4 OSWIT,OCNTR
  12. C    COMMON/OAR/OSWIT,OCNTR,OARRY
  13. C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
  14.     InTeGer*4 IPS1,IPS2,MODFLG
  15. C    COMMON/ICPOS/IPS1,IPS2,MODFLG
  16.        InTeGer*4 XTCFG,IPSET,XTNCNT
  17.        CHARACTER*1 XTNCMD(80)
  18. C       COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
  19. C VARY FLAG ITERATION COUNT
  20.     INTEGER KALKIT
  21. C    COMMON/VARYIT/KALKIT
  22.     InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
  23.     InTeGer*4 RCMODE,IRCE1,IRCE2
  24. C    COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  25. C     1  IRCE2
  26. C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
  27. C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
  28. C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
  29. C RCFGX ON.
  30. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
  31. C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
  32. C  AND VM INHIBITS. (SETS TO 1).
  33.     INTEGER*4 FH
  34. C FILE HANDLE FOR CONSOLE I/O (RAW)
  35. C    COMMON/CONSFH/FH
  36.     CHARACTER*1 ARGSTR(52,4)
  37. C    COMMON/ARGSTR/ARGSTR
  38.     COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
  39.      1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
  40.      2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  41.      3  IRCE2,FH,ARGSTR
  42.     If(fh.ne.0)I=amiga(Write,fh,ibuf,isz)
  43.     return
  44.     end
  45.     Subroutine ttyin(IIMODE,line)
  46. c read 132 char line off console
  47. C iimode=0 in Command-Mostly mode, 1 in Enter mostly mode.
  48.     Integer*4 iact,n,IIMODE
  49.     include dos.inc
  50.     Integer*4 Amiga
  51.     External Amiga
  52. C    common/consfh/fh
  53.     CHARACTER*1 OARRY(100)
  54.     InTeGer*4 OSWIT,OCNTR
  55. C    COMMON/OAR/OSWIT,OCNTR,OARRY
  56. C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
  57.     InTeGer*4 IPS1,IPS2,MODFLG
  58. C    COMMON/ICPOS/IPS1,IPS2,MODFLG
  59.        InTeGer*4 XTCFG,IPSET,XTNCNT
  60.        CHARACTER*1 XTNCMD(80)
  61. C       COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
  62. C VARY FLAG ITERATION COUNT
  63.     INTEGER KALKIT
  64. C    COMMON/VARYIT/KALKIT
  65.     InTeGer*4 FORMFG,RCFGX,PZAP,RCONE
  66.     InTeGer*4 RCMODE,IRCE1,IRCE2
  67. C    COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  68. C     1  IRCE2
  69. C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY
  70. C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS
  71. C AUTO RECALC (USE R COMMAND TO DO A CALC.). 17 COMMAND TURNS
  72. C RCFGX ON.
  73. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1
  74. C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0
  75. C  AND VM INHIBITS. (SETS TO 1).
  76.     INTEGER*4 FH
  77.     Character*1 wrkchr,lstchr
  78.     Integer*4 iescst
  79. C FILE HANDLE FOR CONSOLE I/O (RAW)
  80. C    COMMON/CONSFH/FH
  81.     CHARACTER*1 ARGSTR(52,4)
  82. C    COMMON/ARGSTR/ARGSTR
  83.     COMMON/XVXTCD/OSWIT,OCNTR,OARRY,IPS1,IPS2,MODFLG,
  84.      1  XTNCNT,XTNCMD,XTCFG,IPSET,KALKIT,
  85.      2  FORMFG,RCFGX,PZAP,RCONE,RCMODE,IRCE1,
  86.      3  IRCE2,FH,ARGSTR
  87.     character*1 line(132)
  88.     InTeGer*4 RRWACT,RCLACT
  89. C    COMMON/RCLACT/RRWACT,RCLACT
  90.     InTeGer*4 idol1,idol2,idol3,idol4,idol5,idol6,
  91.      1  IDOL7,IDOL8
  92. C    common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
  93. C     1  IDOL7,IDOL8
  94.     InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  95. C    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
  96.     InTeGer*4 IPGMAX,LPGMXF,IPGMOD,LPGMOD
  97. C    COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
  98. C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
  99. C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES
  100.     InTeGer*4 KLVL
  101. C    COMMON/KLVL/KLVL
  102.     InTeGer*4 IOLVL,IGOLD
  103. C    COMMON/IOLVL/IOLVL
  104. C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5
  105. C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY.
  106.     COMMON/RDD/RRWACT,RCLACT,idol1,idol2,idol3,idol4,idol5,idol6,
  107.      1  IDOL7,IDOL8,PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP,
  108.      2  IPGMAX,LPGMXF,IPGMOD,LPGMOD,KLVL,IOLVL,IGOLD
  109.     Integer*4 Kone
  110.     Character*1 xlf
  111. CCC    InTeGer*4 LLCMD,LLDSP
  112. CCC    InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
  113. CCC    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  114.     xlf=char(10)
  115.     iescst=0
  116.     Kone=1
  117.     wrkchr=char(0)
  118. c initially, no ESC seen
  119. c Set up to read raw: device OK.
  120. c If we see an ESC character then look for either a return
  121. c (to terminate in any case) or some character whose value is
  122. c greater than 64. However ESC O will be passed and the scan will
  123. c continue.
  124. C implement deletion of last character also with DEL or with
  125. C backspace keys
  126. c
  127. c Initially zero entire buffer so we later can find length via looking
  128. c for anything non-zero. Also serves to put in terminators for things
  129. c like the INDX function to prevent them from running on indefinitely.
  130.     do 1 n=1,132
  131. 1    line(n)=char(0)
  132. c if mode 0, (command mostly) then / is NOT special
  133.     if(fh.eq.0)goto 1000
  134. c Here begin the read loop
  135.     n=1
  136. 4000    continue
  137.     lstchr=wrkchr
  138.     wrkchr=char(0)
  139. C zero wrkchr for safety
  140.     iact=amiga(Read,fh,wrkchr,Kone)
  141.     If(Iact.le.0)goto 4000
  142.     If(ichar(wrkchr).eq.0)goto 4000
  143. CCC Add this to just read the line
  144. CC    iact=amiga(Read,fh,line,132)
  145. 4050    Continue
  146.     If(ichar(wrkchr).ne.8.and.ichar(wrkchr).ne.127)goto 4100
  147. C back up a character and try again
  148. c Last char was backspace or DEL, so back up by one, echo backspace.
  149.     n=max0(1,(n-1))
  150.     lstchr=char(8)
  151. C echo a backspace
  152. C 8 is ASCII backspace...
  153.     ii=Amiga(Write,fh,Lstchr,Kone)
  154.     Goto 4000
  155. 4100    Continue
  156. c C.R. is 13, LF is 10, FF is 14, so terminate on any of these
  157. c traditional line terminators.
  158.     If(ichar(wrkchr).lt.16)goto 5000
  159. c Normal character, just echo it.
  160.     ii=Amiga(Write,fh,wrkchr,kone)
  161. c echo the character back
  162. c Then store it.
  163.     line(n)=wrkchr
  164.     n=min0(n+1,131)
  165.     if(ichar(wrkchr).eq.27.or.ichar(Wrkchr).eq.155)iescst=1
  166. c <ESC>O is actually an escape sequence initiator
  167.     If(iescst.eq.1.and.wrkchr.eq.'O'.and.ichar(lstchr)
  168.      1  .eq.27) goto 4200
  169. c Otherwise an escape sequence ends in a letter
  170.     If(Iescst.eq.0)goto 4200
  171.     ii=ichar(wrkchr)
  172.     If(ii.eq.91)goto 4200
  173. c 91 is ascii for [
  174.     If(ii.gt.64.and.ii.lt.127)Return
  175. C terminate read at end of any escape sequence
  176. c from A to z except [ are possible esc seq delimiters.
  177. 4200    Continue
  178. c The above condition terminates an ESC sequence after ESC and any other
  179. c characters followed by (and including) any character greater than 'A'
  180. c which should take care of just about every ANSI escape sequence.
  181.     if(n.lt.131)goto 4000
  182. c Terminate even if we never get C.R. but not 'till we've got
  183. c all there is to get...
  184.     Return
  185. 5000    continue
  186. c Echo line terminator
  187.     line(n)=wrkchr
  188.     ii=Amiga(Write,fh,wrkchr,kone)
  189.     If(ichar(wrkchr).eq.13)ii=Amiga(Write,fh,xlf,Kone)
  190. c echo lf after cr
  191. c done reading now.
  192.     Return
  193. 1000    Continue
  194. C fakeout fallback position, reading workbench window
  195.     Read(*,1500)line
  196. 1500    format(132a1)
  197.     return
  198.     end
  199.     subroutine swset(i)
  200.     integer*4 i
  201. c dummy setup sub
  202.     return
  203.     end
  204.     subroutine exitqq
  205. c exit routine ... just do fortran stop to make it complete
  206.     stop "AnalytiCalc exiting..."
  207.     end
  208.     subroutine system(line)
  209.     include dos.inc
  210. c execute an amigados command
  211.     integer*4 inp,outp
  212.     character*80 line
  213.     logical*4 succ
  214.     Logical*4 Amiga
  215.     External Amiga
  216.     succ=amiga(Execute,line(1:80),inp,outp)
  217.     return
  218.     end
  219.