mim/development/mim/vax/tty/ttyvts.mud

   1 "Display operations"
   2
   3 "Get/set x/y position, width, height"
   4 <DEFINE TTY-PARM (CHANNEL OPER "OPTIONAL" NEW
   5                   "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
   6   #DECL ((CHANNEL) CHANNEL (NEW) FIX (DATA) TTY-CHANNEL)
   7   <COND (<TC-TTY .DATA>
   8          <COND (<==? .OPER PAGE-WIDTH>
   9                 <COND (<NOT <ASSIGNED? NEW>>
  10                        <DO-TTY-PARM .DATA PAGE-WIDTH>)
  11                       (T
  12                        <DO-TTY-PARM .DATA PAGE-WIDTH .NEW>)>)
  13                (<==? .OPER PAGE-HEIGHT>
  14                 <COND (<NOT <ASSIGNED? NEW>>
  15                        <DO-TTY-PARM .DATA PAGE-HEIGHT>)
  16                       (T
  17                        <DO-TTY-PARM .DATA PAGE-HEIGHT .NEW>)>)
  18                (<==? .OPER PAGE-X>
  19                 <COND (<NOT <ASSIGNED? NEW>>
  20                        <DO-TTY-PARM .DATA PAGE-X>)
  21                       (T
  22                        <DO-TTY-PARM .DATA PAGE-X .NEW>
  23                        <UPDATE-MC .CHANNEL <DO-TTY-PARM .DATA PAGE-X>>)>)
  24                (<==? .OPER PAGE-Y>
  25                 <COND (<NOT <ASSIGNED? NEW>>
  26                        <DO-TTY-PARM .DATA PAGE-Y>)
  27                       (T
  28                        <DO-TTY-PARM .DATA PAGE-Y .NEW>
  29                        <UPDATE-MC .CHANNEL <> <DO-TTY-PARM .DATA PAGE-Y>>)>)>)
  30         (0)>>
  31
  32 ; "Anything that is simple (perhaps change cursor position, and output
  33    some string) is handled by DO-TTY-OP."
  34 <DEFINE CLEAR-SCREEN (CHANNEL OPER)
  35   #DECL ((CHANNEL) CHANNEL)
  36   <DO-TTY-OP ,TTY-CLR .CHANNEL 0 0>>
  37
  38 <DEFINE CLEAR-EOL (CHANNEL OPER)
  39   #DECL ((CHANNEL) CHANNEL)
  40   <DO-TTY-OP ,TTY-CEL .CHANNEL>>
  41
  42 <DEFINE CLEAR-EOS (CHANNEL OPER)
  43   #DECL ((CHANNEL) CHANNEL)
  44   <DO-TTY-OP ,TTY-CEW .CHANNEL>>
  45
  46 <DEFINE FRESH-LINE (CHANNEL OPER "OPTIONAL" (N 1)
  47                     "AUX" (DATA <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .DATA>))
  48   #DECL ((N) FIX (CHANNEL) CHANNEL (DATA) TTY-CHANNEL (TTY) TTY)
  49   <COND (<0? <TT-X .TTY>>
  50          <SET N <- .N 1>>)>
  51   <COND (<G? .N 0>
  52          <REPEAT ()
  53            <TTY-NORMAL-OUT .CHANNEL .OPER ,CRLF-STRING>
  54            <COND (<L=? <SET N <- .N 1>> 0> <RETURN>)>>)>>
  55
  56 <DEFINE HOME-CURSOR (CHANNEL OPER)
  57   #DECL ((CHANNEL) CHANNEL)
  58   <DO-TTY-OP ,TTY-HOM .CHANNEL 0 0>>
  59
  60 <DEFINE BOTTOM-CURSOR (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
  61                        H)
  62   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL)
  63   <COND (<DO-TTY-OP ,TTY-HMD .CHANNEL 0
  64                     <SET H <- <TD-HEIGHT <TT-DESC <TC-TTY .DATA>>> 1>>>)
  65         (T
  66          <DO-TTY-OP ,TTY-MOV .CHANNEL 0 .H>)>>
  67
  68 <DEFINE HOR-POS-CURSOR (CHANNEL OPER NEW)
  69   #DECL ((CHANNEL) CHANNEL (NEW) FIX)
  70   <DO-TTY-OP ,TTY-HRZ .CHANNEL .NEW>>
  71
  72 <DEFINE VER-POS-CURSOR (CHANNEL OPER NEW)
  73   #DECL ((CHANNEL) CHANNEL (NEW) FIX)
  74   <DO-TTY-OP ,TTY-VRT .CHANNEL <> .NEW>>
  75
  76 <DEFINE MOVE-CURSOR (CHANNEL OPER X Y)
  77   #DECL ((CHANNEL) CHANNEL (X Y) FIX)
  78   <DO-TTY-OP ,TTY-MOV .CHANNEL .X .Y>>
  79
  80 <DEFINE SAVE-CURSOR (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
  81                      (TTY <TC-TTY .DATA>))
  82   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (TTY) TTY)
  83   <TT-SAV-X .TTY <TT-X .TTY>>
  84   <TT-SAV-Y .TTY <TT-Y .TTY>>>
  85
  86 <DEFINE RESTORE-CURSOR (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
  87                         (TTY <TC-TTY .DATA>))
  88   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (TTY) TTY)
  89   <COND (<TT-SAV-X .TTY>
  90          <DO-TTY-OP ,TTY-MOV .CHANNEL <TT-SAV-X .TTY> <TT-SAV-Y .TTY>>)>>
  91
  92 <DEFINE BACK-CURSOR (CHANNEL OPER "OPTIONAL" (N 1)
  93                      "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
  94                      (CURX <TT-X .TTY>) TD WIDTH HEIGHT CURY NEWX NEWY)
  95   #DECL ((CHANNEL) CHANNEL (N CURX WIDTH HEIGHT CURY NEWX NEWY) FIX
  96          (TC) TTY-CHANNEL (TTY) TTY)
  97   <COND (<L? .N 0>
  98          <FORWARD-CURSOR .CHANNEL .OPER <- .N>>)
  99         (<L=? .N .CURX>
 100          <COND (<NOT <AND <1? .N>
 101                           <DO-TTY-OP ,TTY-BCK .CHANNEL <- .CURX 1>>>>
 102                 <DO-TTY-OP ,TTY-HRZ .CHANNEL <- .CURX .N>>)>)
 103         (T
 104          <SET CURY <TT-Y .TTY>>
 105          <SET TD <TT-DESC .TTY>>
 106          <SET WIDTH <TD-WIDTH .TD>>
 107          <SET HEIGHT <TD-HEIGHT .TD>>
 108          <SET NEWX <- .CURX .N>>
 109          <SET NEWY .CURY>
 110          <REPEAT ()
 111            <SET NEWX <+ .NEWX .WIDTH>>
 112            <SET NEWY <- .NEWY 1>>
 113            <COND (<G=? .NEWX 0> <RETURN>)>>
 114          <COND (<L? .NEWY 0>
 115                 <SET NEWY <+ .HEIGHT .NEWY>>)>
 116          <COND (<==? .NEWY .CURY>
 117                 <DO-TTY-OP ,TTY-HRZ .CHANNEL .NEWX>)
 118                (T
 119                 <DO-TTY-OP ,TTY-MOV .CHANNEL .NEWX .NEWY>)>)>>
 120
 121 <DEFINE FORWARD-CURSOR (CHANNEL OPER "OPTIONAL" (N 1)
 122                         "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 123                         (CURX <TT-X .TTY>) (TD <TT-DESC .TTY>)
 124                         (WIDTH <TD-WIDTH .TD>) HEIGHT CURY NEWX NEWY)
 125   #DECL ((CHANNEL) CHANNEL (N CURX WIDTH HEIGHT CURY NEWX NEWY) FIX
 126          (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC)
 127   <COND (<L? .N 0>
 128          <BACK-CURSOR .CHANNEL .OPER <- .N>>)
 129         (<L? <SET NEWX <+ .CURX .N>> .WIDTH>
 130          <COND (<NOT <AND <1? .N>
 131                           <DO-TTY-OP ,TTY-FWD .CHANNEL <+ .CURX 1>>>>
 132                 <DO-TTY-OP ,TTY-HRZ .CHANNEL .NEWX>)>)
 133         (T
 134          <SET CURY <TT-Y .TTY>>
 135          <SET CURX <MOD .NEWX .WIDTH>>
 136          <SET NEWY <+ .CURY </ .NEWX .WIDTH>>>
 137          <COND (<G=? .NEWY <SET HEIGHT <TD-HEIGHT .TD>>>
 138                 <SET NEWY <MOD .NEWY .HEIGHT>>)>
 139          <DO-TTY-OP ,TTY-MOV .CHANNEL .CURX .NEWY>)>>
 140
 141 <DEFINE UP-CURSOR (CHANNEL OPER "OPTIONAL" (N 1)
 142                    "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 143                    (TD <TT-DESC .TTY>) (CURY <TT-Y .TTY>)
 144                    (HEIGHT <TD-HEIGHT .TD>))
 145   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC
 146          (CURY HEIGHT N) FIX)
 147   <COND (<L? .N 0> <DOWN-CURSOR .CHANNEL .OPER <- .N>>)
 148         (<G=? <SET CURY <- .CURY .N>> 0>
 149          <COND (<NOT <AND <1? .N>
 150                           <DO-TTY-OP ,TTY-UP .CHANNEL <> .CURY>>>
 151                 <DO-TTY-OP ,TTY-VRT .CHANNEL <> .CURY>)>)
 152         (T
 153          <SET CURY <MOD .CURY .HEIGHT>>
 154          <DO-TTY-OP ,TTY-VRT .CHANNEL <> .CURY>)>>
 155
 156 <DEFINE DOWN-CURSOR (CHANNEL OPER "OPTIONAL" (N 1)
 157                      "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 158                      (TD <TT-DESC .TTY>) (CURY <TT-Y .TTY>)
 159                      (HEIGHT <TD-HEIGHT .TD>))
 160   #DECL ((CHANNEL) CHANNEL (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC
 161          (CURY HEIGHT N) FIX)
 162   <COND (<L? .N 0> <UP-CURSOR .CHANNEL .OPER <- .N>>)
 163         (<L? <SET CURY <+ .CURY .N>> .HEIGHT>
 164          <COND (<AND <1? .N>
 165                      <0? <TT-X .TTY>>>
 166                 ; "Output a linefeed where possible."
 167                 <TT-Y .TTY .CURY>
 168                 <OUTPUT-RAW-STRING .CHANNEL <ASCII 10>>)
 169                (<NOT <AND <1? .N>
 170                           <DO-TTY-OP ,TTY-DWN .CHANNEL <> .CURY>>>
 171                 <DO-TTY-OP ,TTY-VRT .CHANNEL <> .CURY>)>)
 172         (T
 173          <SET CURY <MOD .CURY .HEIGHT>>
 174          <DO-TTY-OP ,TTY-VRT .CHANNEL <> .CURY>)>>
 175
 176 <DEFINE KILL-CHAR (CHANNEL OPER)
 177   #DECL ((CHANNEL) CHANNEL)
 178   <BACK-CURSOR .CHANNEL .OPER>
 179   <OUTPUT-RAW-STRING .CHANNEL " ">>
 180
 181 <DEFINE ERASE-CHAR (CHANNEL OPER "OPTIONAL" (N 1)
 182                     "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 183                           (X <TT-X .TTY>))
 184   #DECL ((CHANNEL) CHANNEL (N X) FIX (TC) TTY-CHANNEL (TTY) TTY)
 185   <COND
 186    (<G? .N 0>
 187     <REPEAT (NX (NY <TT-Y .TTY>))
 188       #DECL ((NX) FIX)
 189       <COND
 190        (<G? .X 0>
 191         <COND (<G? .N .X>
 192                <SET NX 0>
 193                <SET N <- .N .X>>)
 194               (T
 195                <SET NX <- .X .N>>
 196                <SET N 0>)>
 197         ; "Avoid absolute cursor position where possible on rubouts"
 198         <COND (<N==? .NY <TT-Y .TTY>>
 199                <MOVE-CURSOR .CHANNEL .OPER .NX .NY>)
 200               (<1? <- .X .NX>>
 201                <BACK-CURSOR .CHANNEL .OPER>)
 202               (T
 203                <HOR-POS-CURSOR .CHANNEL .OPER .NX>)>
 204         <CLEAR-EOL .CHANNEL .OPER>)>
 205       <COND (<G? .N 0>
 206              <COND (<L? <SET NY <- .NY 1>> 0>
 207                     <SET NY <- <TD-HEIGHT <TT-DESC .TTY>> 1>>)>
 208              <SET X <- <TD-WIDTH <TT-DESC .TTY>> 1>>)
 209             (<RETURN>)>>)>>
 210
 211 \f
 212 "More operations--line and char i&d"
 213 <DEFINE INSERT-LINE (CHANNEL OPER "OPTIONAL" (N 1) (TOP <>) (BOT <>)
 214                      "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 215                            (TD <TT-DESC .TTY>) (RBOT <- <TD-HEIGHT .TD> 1>)
 216                            TEMP (SAVX <TT-X .TTY>) (SAVY <TT-Y .TTY>))
 217   #DECL ((CHANNEL) CHANNEL (N) FIX (TOP BOT) <OR FALSE FIX>
 218          (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC (TEMP RBOT) FIX)
 219   <COND (<NOT .TOP>
 220          <SET TOP .SAVY>)>
 221   <COND (<NOT .BOT>
 222          <SET BOT .RBOT>)>
 223   <COND (<G? .TOP .BOT>
 224          <SET TEMP .BOT>
 225          <SET BOT .TOP>
 226          <SET TOP .TEMP>)>
 227   <COND (<AND <L=? .TOP .RBOT>
 228               <NOT <0? .N>>>
 229          <SET BOT <MIN .BOT .RBOT>>
 230          <COND (<DO-TTY-OP ,TTY-DS .CHANNEL .BOT .TOP <>>
 231                 ; "Try defining a scrolling region, making things much simpler"
 232                 <COND (<L? .N 0>        ; "Deleting lines"
 233                        <MOVE-CURSOR .CHANNEL .OPER 0 .BOT>
 234                        <REPEAT ()
 235                          <DO-TTY-OP ,TTY-SU .CHANNEL>
 236                          <COND (<0? <SET N <+ .N 1>>> <RETURN>)>>)
 237                       (T
 238                        <MOVE-CURSOR .CHANNEL .OPER 0 .TOP>
 239                        <REPEAT ()
 240                          <DO-TTY-OP ,TTY-SD .CHANNEL>
 241                          <COND (<0? <SET N <- .N 1>>> <RETURN>)>>)>
 242                 <DO-TTY-OP ,TTY-DS .CHANNEL .RBOT 0 <>>)
 243                (<==? .BOT .RBOT>
 244                 ; "Straight line insert/delete"
 245                 <MOVE-CURSOR .CHANNEL .OPER 0 .TOP>
 246                 <PROG (OP)
 247                   <COND (<L? .N 0> <SET OP ,TTY-DL>)
 248                         (<SET OP ,TTY-IL>)>
 249                   <SET N <ABS .N>>
 250                   <REPEAT ()
 251                     <DO-TTY-OP .OP .CHANNEL>
 252                     <COND (<0? <SET N <- .N 1>>> <RETURN>)>>>)
 253                (T
 254                 ; "Simulated scrolling region"
 255                 <COND (<G? .N 0>
 256                        <SET N <MIN .N <- .BOT .TOP>>>
 257                        <MOVE-CURSOR .CHANNEL .OPER 0 <- .BOT <- .N 1>>>
 258                        <INSERT-LINE .CHANNEL .OPER <- .N>>
 259                        <MOVE-CURSOR .CHANNEL .OPER 0 .TOP>
 260                        <INSERT-LINE .CHANNEL .OPER .N>)
 261                       (T
 262                        <SET N <MAX .N <- .TOP .BOT>>>
 263                        <MOVE-CURSOR .CHANNEL .OPER 0 .TOP>
 264                        <INSERT-LINE .CHANNEL .OPER .N>
 265                        <MOVE-CURSOR .CHANNEL .OPER 0 <+ .BOT .N 1>>
 266                        <INSERT-LINE .CHANNEL .OPER <- .N>>)>)>
 267          <MOVE-CURSOR .CHANNEL .OPER .SAVX .SAVY>)>>
 268
 269 <DEFINE INSERT-CHAR (CHANNEL OPER "OPTIONAL" (N 1) (LEFT <>) (RIGHT <>)
 270                      "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
 271                      (TD <TT-DESC .TTY>) (RRIGHT <- <TD-WIDTH .TD> 1>)
 272                      (SAVX <TT-X .TTY>) TEMP)
 273   #DECL ((CHANNEL) CHANNEL (N RRIGHT SAVX) FIX (LEFT RIGHT) <OR FALSE FIX>
 274          (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC)
 275   <COND (<NOT .LEFT>
 276          <SET LEFT .SAVX>)>
 277   <COND (<NOT .RIGHT>
 278          <SET RIGHT .RRIGHT>)>
 279   <COND (<G? .LEFT .RIGHT>
 280          <SET TEMP .LEFT>
 281          <SET LEFT .RIGHT>
 282          <SET RIGHT .TEMP>)>
 283   <COND (<AND <L=? .LEFT .RRIGHT>
 284               <NOT <0? .N>>>
 285          <SET LEFT <MIN .LEFT .RRIGHT>>)>>