mim/development/mim/20c/ttyoc.mud

   1 <USE "TTY">
   2
   3 <NEWTYPE ARGNO FIX>
   4
   5 <DEFINE OC-TTY-OP (OP:ATOM ARGS:LIST
   6                    "AUX" (STUFF:<OR FALSE LIST> <GETPROP .OP TTY-OC>))
   7         <COND (.STUFF
   8                <MAPF <>
   9                      <FUNCTION (INS)
  10                           <COND (<TYPE? .INS LIST>
  11                                  <MAPF ,OCEMIT
  12                                        <FUNCTION (X)
  13                                             <COND (<TYPE? .X ARG-NO>
  14                                                    <MAPRET
  15                                                     !<OBJ-VAL
  16                                                       <NTH .ARGS
  17                                                            <CHTYPE .X FIX>>>>)
  18                                                   (<TYPE? .X GVAL>
  19                                                    ,<CHTYPE .X ATOM>)
  20                                                   (ELSE .X)>>
  21                                             .INS>)
  22                                 (<TYPE? .INS FORM>
  23                                  <APPLY <1 .INS> .ARGS !<REST .INS>>)>>
  24                      .STUFF>
  25                T)>>
  26
  27 <COND (<GASSIGNED? OC-TTY-OP> <PUTPROP TTY OC-INDICATOR ,OC-TTY-OP>)>
  28
  29
  30 <PUTPROP SET-ECHO-MODE TTY-OC
  31          '((MOVE O1* #ARG-NO 1)
  32            (MOVE O1* ,OC-CHANNEL-DATA (O1*))
  33            (MOVE B* ,OC-TT-RFCUR (O1*))
  34            <DO-ECHO-SET #ARG-NO 2>)>
  35
  36 <DEFINE DO-ECHO-SET (ARGS:LIST ARGNO
  37                      "AUX" (ARG <NTH .ARGS <CHTYPE .ARGNO FIX>>) LBL (CHOMP <>))
  38         <COND (<NOT .ARG>
  39                <OCEMIT TRZN B* ,TT-ECO>)
  40               (<NOT <TYPE? .ARG ATOM>>
  41                <OCEMIT TROE B* ,TT-ECO>)
  42               (ELSE
  43                <SET CHOMP T>
  44                <LOAD-TYPE O* <OBJ-TYP .ARG>>
  45                <OCEMIT CAIE O* !<TYPE-CODE FALSE T>>
  46                 <OCEMIT TRON B* ,TT-ECO>
  47                  <OCEMIT TRZN B* ,TT-ECO>)>
  48         <OCEMIT JRST <SET LBL <GENLBL "NOSFMOD">>>
  49         <COND (.CHOMP
  50                <OCEMIT CAIE O* !<TYPE-CODE FALSE T>>
  51                <OCEMIT TRO B* ,TT-ECO>)>
  52         <OCEMIT MOVEM B* ,OC-TT-RFCUR '(O1*)>
  53         <OCEMIT MOVE A* ,OC-TT-RJFN '(O1*)>
  54         <OCEMIT SFMOD!-JSYS>
  55         <OCEMIT JUMP P* <XJUMP IOERR>>
  56         <LABEL .LBL>>
  57
  58 <PUTPROP CLEAR-EOL TTY-OC
  59          '((MOVE O2* #ARG-NO 1)
  60            (MOVE O1* ,OC-CHANNEL-DATA (O2*))
  61            (SKIPE O* ,OC-TT-WBUF (O1*))
  62            (SKIPN O* ,OC-TT-WBC (O1*))
  63            (JRST #TTY-TAG 1)
  64            <CALL-DUMP-WRITE-BUFFER>
  65            #TTY-TAG 1
  66            (MOVE A* ,OC-TT-WJFN (O1*))
  67            (MOVEI B* ,/VTCEL)
  68            (OCEMIT SFMOD!-JSYS)
  69            (OCEMIT JUMP P* <XJUMP IOERR>))>
  70
  71 <DEFINE CALL-DUMP-WRITE-BUFFER (ARGS:LIST "AUX" GC)
  72         <COND (<AND ,GLUE-MODE <MEMQ DUMP-WRITE-BUFFER ,PRE-NAMES>>
  73                <FRAME!-MIMOC (<SET GC <GENLBL "?FRM">> DUMP-WRITE-BUFFER)>)
  74               (ELSE
  75                <FRAME!-MIMOC '('DUMP-WRITE-BUFFER)>)>
  76         <OCEMIT PUSH ,OC-CHANNEL-DATA-1 '(O2*)>
  77         <OCEMIT PUSH ,OC-CHANNEL-DATA '(O2*)>
  78         <CALL!-MIMOC (''DUMP-WRITE-BUFFER 1 !<COND (.GC (.GC)) (ELSE ())>)>>
  79
  80
  81 <CHANNEL-OP 'TTY 'WRITE-BYTE INCHAN9 CHR24>
  82
  83 <CHANNEL-OP 'TTY 'GET-READ-BUFFER INCHAN9 = TEMP43>
  84
  85 <DEFINE TTY-GET-READ (TTY OPER "OPTIONAL" NEW
  86                         "AUX" (DATA <CHANNEL-DATA .TTY>))
  87   #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (NEW) STRING)
  88   <COND (<ASSIGNED? NEW>
  89          <TT-RBUF .DATA .NEW>
  90          .NEW)
  91         (T
  92          <TT-RBUF .DATA>)>>
  93
  94 <CHANNEL-OP 'TTY 'BUFLEN INCHAN9 TEMP43>
  95
  96 <DEFINE TTY-BUFLEN (TTY OPER "OPTIONAL" NEW "AUX" (DATA <CHANNEL-DATA .TTY>))
  97   #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (NEW) FIX)
  98   <COND (<ASSIGNED? NEW>
  99          <TT-RBC .DATA .NEW>
 100          .NEW)
 101         (T
 102          <TT-RBC .DATA>)>>
 103
 104 <CHANNEL-OP 'TTY 'DOWN-CURSOR INCHAN9>
 105
 106
 107 <DEFINE HOME-CURSOR (TTY OPER)
 108         #DECL ((TTY) CHANNEL)
 109         <UPDATE-MC .TTY 0 0>
 110         <DPYOP <CHANNEL-DATA .TTY> ,/VTHOM>>
 111
 112 <DEFINE BOTTOM-CURSOR (TTY OPER)
 113         #DECL ((TTY) CHANNEL)
 114         <UPDATE-MC .TTY 0>
 115         <DPYOP <CHANNEL-DATA .TTY> ,/VTHMD>>
 116
 117 <DEFINE HOR-POS-CURSOR (TTY OPER X)
 118         #DECL ((TTY) CHANNEL)
 119         <UPDATE-MC .TTY .X>
 120         <DPYOP <CHANNEL-DATA .TTY> ,/VTHRZ .X>>
 121
 122 <DEFINE VER-POS-CURSOR (TTY OPER Y)
 123         #DECL ((TTY) CHANNEL)
 124         <UPDATE-MC .TTY <> .Y>
 125         <DPYOP <CHANNEL-DATA .TTY> ,/VTVRT .Y>>
 126
 127 <DEFINE MOVE-CURSOR (TTY OPER X Y "AUX" (CD <CHANNEL-DATA .TTY>))
 128         #DECL ((TTY) CHANNEL (CD) TTY-CHANNEL)
 129         <UPDATE-MC .TTY .X .Y>
 130         ; "Caused by tops-20 bug with binary output"
 131         <CALL SYSOP SFPOS <TT-WJFN .CD> -1>
 132         <DPYOP .CD
 133                ,/VTMOV
 134                <ORB <LSH .Y 18> <ANDB .X *777777*>>>>
 135
 136 <DEFINE BACK-CURSOR (TTY OPER "OPTIONAL" (N 1))
 137         #DECL ((TTY) CHANNEL (N) FIX)
 138         <UPDATE-MC .TTY (<- .N>)>
 139         <DPYOP <CHANNEL-DATA .TTY> ,/VTBCK .N>>
 140
 141 <DEFINE DOWN-CURSOR (TTY OPER "OPTIONAL" (N 1))
 142         #DECL ((TTY) CHANNEL (N) FIX)
 143         <UPDATE-MC .TTY <> (.N)>
 144         <DPYOP <CHANNEL-DATA .TTY> ,/VTDWN .N>>
 145
 146 <DEFINE UP-CURSOR (TTY OPER "OPTIONAL" (N 1))
 147         #DECL ((TTY) CHANNEL (N) FIX)
 148         <UPDATE-MC .TTY <> (<- .N>)>
 149         <DPYOP <CHANNEL-DATA .TTY> ,/VTUP .N>>
 150
 151 <DEFINE FORWARD-CURSOR (TTY OPER "OPTIONAL" (N 1))
 152         #DECL ((TTY) CHANNEL (N) FIX)
 153         <UPDATE-MC .TTY (.N)>
 154         <DPYOP <CHANNEL-DATA .TTY> ,/VTFWD .N>>
 155
 156 \\f
 157
 158 <DEFINE SAVE-CURSOR (TTY OPER)
 159         #DECL ((TTY) CHANNEL)
 160         <DPYOP <CHANNEL-DATA .TTY> ,/VTSAV>>
 161
 162 <DEFINE RESTORE-CURSOR (TTY OPER)
 163         #DECL ((TTY) CHANNEL)
 164         <DPYOP <CHANNEL-DATA .TTY> ,/VTRES>>
 165
 166 <CHANNEL-OP 'TTY 'INSERT-LINE INCHAN9 1>
 167
 168 <DEFINE INSERT-LINE (TTY OPER
 169                      "OPTIONAL" (N 1) (TOP <>) (BOT <>)
 170                      "AUX" (DATA <CHANNEL-DATA .TTY>))
 171         #DECL ((TTY) CHANNEL (N) FIX (TOP BOT) <OR FIX FALSE>
 172                (DATA) TTY-CHANNEL)
 173         <COND (<0? .N> T)
 174               (<NOT <OR .TOP .BOT>> <DPYOP .DATA ,/VTLID .N>)
 175               (T
 176                <COND (<NOT .TOP> <SET TOP <GET-TTY-PARM .DATA PAGE-Y>>)>
 177                <COND (<NOT .BOT> <SET BOT <- <GET-TTY-PARM .DATA PAGE-HEIGHT>
 178                                              1>>)>
 179                <DPYOP .DATA
 180                       ,/VTLID
 181                       .N
 182                       <ORB <LSH .TOP 18> <ANDB .BOT *777777*>>>)>>
 183
 184
 185
 186 <DEFINE INSERT-CHAR (TTY OPER
 187                      "OPTIONAL" (N 1) (LEFT <>) (RIGHT <>)
 188                      "AUX" (DATA <CHANNEL-DATA .TTY>))
 189         #DECL ((TTY) CHANNEL (N) FIX (LEFT RIGHT) <OR FIX FALSE>)
 190         <COND (<NOT <OR .LEFT .RIGHT>> <DPYOP .DATA ,/VTCID .N>)
 191               (T
 192                <COND (<NOT .LEFT> <SET LEFT <GET-TTY-PARM .DATA PAGE-X>>)>
 193                <COND (<NOT .RIGHT>
 194                       <SET RIGHT <- <GET-TTY-PARM .DATA PAGE-WIDTH> 1>>)>
 195                <DPYOP .DATA
 196                       ,/VTCID
 197                       .N
 198                       <ORB <ANDB .RIGHT *777777000000*> .LEFT>>)>>
 199
 200
 201 <CHANNEL-OP 'TTY 'ERASE-CHAR INCHAN9>
 202
 203
 204 <DEFINE KILL-CHAR (TTY OPER)
 205   #DECL ((TTY) CHANNEL)
 206   <DPYOP <CHANNEL-DATA .TTY> ,/VTERA>>
 207
 208
 209 <DEFINE ERASE-CHAR (TTY OPER "OPTIONAL" (N 1) "AUX" (SU <CHANNEL-USER .TTY>))
 210         #DECL ((TTY) CHANNEL (N) FIX)
 211         <UPDATE-MC .TTY (<- .N>)>
 212         <DPYOP <CHANNEL-DATA .TTY> ,/VTBEC .N>>
 213
 214
 215 <CHANNEL-OP 'TTY 'WRITE-BUFFER INCHAN9 BUF4 END7>