home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d104 / analyticalc.lha / AnalytiCalc / Src / AnalySrc.arc / AnalASM.Ftn next >
Text File  |  1987-10-06  |  7KB  |  206 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. CCC    InTeGer*4 LLCMD,LLDSP
  110. CCC    InTeGer*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
  111. CCC    COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
  112.     iescst=0
  113.     wrkchr=char(0)
  114. c initially, no ESC seen
  115. c Set up to read raw: device OK.
  116. c If we see an ESC character then look for either a return
  117. c (to terminate in any case) or some character whose value is
  118. c greater than 64. However ESC O will be passed and the scan will
  119. c continue.
  120. C implement deletion of last character also with DEL or with
  121. C backspace keys
  122. c
  123. c Initially zero entire buffer so we later can find length via looking
  124. c for anything non-zero. Also serves to put in terminators for things
  125. c like the INDX function to prevent them from running on indefinitely.
  126.     do 1 n=1,132
  127. 1    line(n)=char(0)
  128. c if mode 0, (command mostly) then / is NOT special
  129.     if(fh.eq.0)goto 1000
  130. c Here begin the read loop
  131.     n=1
  132. 4000    continue
  133. c    lstchr=wrkchr
  134. c    wrkchr=char(0)
  135. cC zero wrkchr for safety
  136. c    iact=amiga(Read,fh,wrkchr,1)
  137. c    If(n.gt.1.or.wrkchr.ne.'/')goto 4050
  138. CC
  139. CC Add this to just read the line
  140.     iact=amiga(Read,fh,line,132)
  141. cccc    If(line(1).ne.'/')goto 4050
  142. cccc    If(IIMODE.eq.0)goto 4050
  143. ccccC if we see / in column 1, write a brief prompt message in
  144. ccccC the display area. Do this only if in enter-mostly mode.
  145. cccc    CALL UVT100(1,LLDSP,1)
  146. cccc    CALL SWRT('Add,Cpy,Dsp,Fil,Get,Kalc,Loc,Mov,Put,Recal,Set',46)
  147. cccc    CALL SWRT(',Tst,View,Wrt,Xit,Zap,/,Help',28)
  148. cccc    CALL UVT100(1,LLCMD,11)
  149. 4050    Continue
  150. c    If(ichar(wrkchr).ne.8.and.ichar(wrkchr).ne.127)goto 4100
  151. cC back up a character and try again
  152. c    n=max0(1,(n-1))
  153. c    lstchr=char(8)
  154. cC echo a backspace
  155. cC 8 is ASCII backspace...
  156. c    Call swrt(lstchr,1)
  157. c    Goto 4000
  158. c4100    Continue
  159. cc C.R. is 13, LF is 10, FF is 14, so terminate on any of these
  160. cc traditional line terminators.
  161. c    If(ichar(wrkchr).lt.16)goto 5000
  162. c    line(n)=wrkchr
  163. c    n=min0(n+1,131)
  164. c    if(ichar(wrkchr).eq.27)iescst=1
  165. cc <ESC>O is actually an escape sequence initiator
  166. c    If(iescst.eq.1.and.wrkchr.eq.'O'.and.ichar(lstchr)
  167. c     1  .eq.27) goto 4200
  168. cc Otherwise an escape sequence ends in a letter
  169. c    if(iescst.eq.1.and.ichar(wrkchr).gt.64)goto 5000
  170. c4200    Continue
  171. cc The above condition terminates an ESC sequence after ESC and any other
  172. cc characters followed by (and including) any character greater than 'A'
  173. cc which should take care of just about every ANSI escape sequence.
  174. c    if(n.lt.131)goto 4000
  175. cc Terminate even if we never get C.R. but not 'till we've got
  176. cc all there is to get...
  177. c5000    continue
  178. c done reading now.
  179.     Return
  180. 1000    Continue
  181. C fakeout fallback position, reading workbench window
  182.     Read(*,1500)line
  183. 1500    format(132a1)
  184.     return
  185.     end
  186.     subroutine swset(i)
  187.     integer*4 i
  188. c dummy setup sub
  189.     return
  190.     end
  191.     subroutine exitqq
  192. c exit routine ... just do fortran stop to make it complete
  193.     stop "AnalytiCalc exiting..."
  194.     end
  195.     subroutine system(line)
  196.     include dos.inc
  197. c execute an amigados command
  198.     integer*4 inp,outp
  199.     character*80 line
  200.     logical*4 succ
  201.     Logical*4 Amiga
  202.     External Amiga
  203.     succ=amiga(Execute,line(1:80),inp,outp)
  204.     return
  205.     end
  206.