mim/development/mim/20/tty.mud

   1 <PACKAGE "TTY">
   2
   3 <ENTRY TERM-MOVE? NORMAL-OUT IMAGE-OUT SET-IMAGE-MODE SET-ECHO-MODE
   4        CLEAR-SCREEN CLEAR-EOL CLEAR-EOS KILL-CHAR ERASE-CHAR
   5        HOME-CURSOR BOTTOM-CURSOR HOR-POS-CURSOR VER-POS-CURSOR MOVE-CURSOR
   6        BACK-CURSOR DOWN-CURSOR UP-CURSOR FORWARD-CURSOR SAVE-CURSOR
   7        RESTORE-CURSOR INSERT-LINE INSERT-CHAR GET-TYPE PAD TYPE-AHEAD?
   8        TYPE-CHAR SET-CURSOR-POSITION>
   9
  10 <USE "TWAY">
  11
  12 %<FLOAD "PS:<TAA.IO-DEFS>TTYDEFS.MUD">
  13
  14 <NEW-CHANNEL-TYPE TTY (TWAY DEFAULT)
  15                  GET-TYPE TTY-GET-TYPE
  16                  QUERY TTY-QUERY
  17                  OPEN TTY-OPEN
  18                  TYPE-AHEAD? TTY-TYPE-AHEAD?
  19                  READ-BYTE-IMMEDIATE TTY-READ-IMMEDIATE
  20                  READ-BYTE TTY-READ-BYTE
  21                  READ-BUFFER TTY-READ-BUFFER
  22                  FILL-READ-BUFFER TTY-FILL-READ
  23                  BUFLEN TTY-BUFLEN
  24                  GET-READ-BUFFER TTY-GET-READ
  25                  PRINT-DATA TTY-PRINT-DATA
  26                  TERM-MOVE? TTY-TERM-MOVE?
  27                  NORMAL-OUT TTY-NORMAL-OUT
  28                  IMAGE-OUT TTY-IMAGE-OUT
  29                  SET-IMAGE-MODE TTY-SET-IMAGE
  30                  SET-ECHO-MODE TTY-SET-ECHO
  31                  RESET TTY-RESET
  32                  PAGE-WIDTH TTY-PARM
  33                  PAGE-HEIGHT TTY-PARM
  34                  PAGE-X TTY-PARM
  35                  PAGE-Y TTY-PARM
  36                  SET-CURSOR-POSITION TTY-SET-CURS
  37                  CLEAR-SCREEN CLEAR-SCREEN
  38                  CLEAR-EOL CLEAR-EOL
  39                  CLEAR-EOS CLEAR-EOS
  40                  FRESH-LINE FRESH-LINE
  41                  KILL-CHAR KILL-CHAR
  42                  ERASE-CHAR ERASE-CHAR
  43                  HOME-CURSOR HOME-CURSOR
  44                  BOTTOM-CURSOR BOTTOM-CURSOR
  45                  HOR-POS-CURSOR HOR-POS-CURSOR
  46                  VER-POS-CURSOR VER-POS-CURSOR
  47                  MOVE-CURSOR MOVE-CURSOR
  48                  BACK-CURSOR BACK-CURSOR
  49                  DOWN-CURSOR DOWN-CURSOR
  50                  UP-CURSOR UP-CURSOR
  51                  FORWARD-CURSOR FORWARD-CURSOR
  52                  SAVE-CURSOR SAVE-CURSOR
  53                  RESTORE-CURSOR RESTORE-CURSOR
  54                  INSERT-LINE INSERT-LINE
  55                  INSERT-CHAR INSERT-CHAR
  56                  PAD TTY-PAD
  57                  TYPE-CHAR TTY-TYPE-CHAR>
  58
  59 "This must be patterned according to the definition of TWAY-CHANNEL, so the
  60 TWAY code will work when it's wanted."
  61
  62 <NEWSTRUC TTY-CHANNEL VECTOR
  63           TT-RJFN FIX
  64           TT-MODE FIX
  65           TT-BSZ FIX
  66           TT-RBUF <OR FALSE STRING>
  67           TT-RBC FIX
  68           TT-WJFN FIX
  69           TT-WBUF <OR FALSE STRING>
  70           TT-WBC FIX
  71           TT-RFSAV FIX                                           ;"Saved RFMOD"
  72           TT-RFCUR FIX           ;"Current setting of RFMOD"
  73           TT-QUEUE <OR STRING CHARACTER FALSE>
  74           TT-QCT FIX>
  75
  76 <DEFMAC UPDATE-MC ('CH 'X "OPTIONAL" 'Y "AUX" (L ()))
  77   <COND (<AND <ASSIGNED? X> .X <OR <NOT <STRUCTURED? .X>>
  78                                    <NOT <EMPTY? .X>>>>
  79          <SET L (<COND (<TYPE? .X LIST>
  80                         <FORM MC-HPOS '.SU <FORM + <FORM MC-HPOS '.SU>
  81                                                    <1 .X>>>)
  82                        (<FORM MC-HPOS '.SU .X>)>)>)>
  83   <COND (<AND <ASSIGNED? Y> .Y <OR <NOT <STRUCTURED? .Y>>
  84                                    <NOT <EMPTY? .Y>>>>
  85          <SET L (<COND (<TYPE? .Y LIST>
  86                         <FORM MC-VPOS '.SU <FORM + <FORM MC-VPOS '.SU>
  87                                                    <1 .Y>>>)
  88                        (<FORM MC-VPOS '.SU .Y>)> !.L)>)>
  89   <COND (<NOT <EMPTY? .L>>
  90          <FORM BIND ((SU <FORM CHANNEL-USER .CH>))
  91                <FORM COND (<FORM TYPE? '.SU MUD-CHAN> !.L)>>)>>
  92
  93 <DEFMAC DPYOP ('TTY 'OPR
  94                "OPTIONAL" 'ARG1 'ARG2)
  95         <FORM BIND ()
  96           <FORM COND (<FORM AND <FORM TT-WBUF .TTY>
  97                             <FORM NOT <FORM 0? <FORM TT-WBC .TTY>>>>
  98                       <FORM DUMP-WRITE-BUFFER .TTY>)>
  99           <COND (<NOT <ASSIGNED? ARG1>>
 100                  <FORM CALL SYSOP VTSOP <FORM TT-WJFN .TTY> .OPR>)
 101                 (<NOT <ASSIGNED? ARG2>>
 102                  <FORM CALL SYSOP VTSOP <FORM TT-WJFN .TTY>
 103                        <FORM ORB .OPR ,DP-AG1> .ARG1>)
 104                 (T
 105                  <FORM CALL SYSOP VTSOP <FORM TT-WJFN .TTY>
 106                        <FORM ORB .OPR <ORB ,DP-AG1 ,DP-AG2>> .ARG1 .ARG2>)>>>
 107
 108 <DEFMAC GET-TTY-PARM ('DATA OPER "OPT" 'NEW
 109                       "AUX" (JFN <FORM TT-RJFN .DATA>))
 110   <COND (<==? .OPER PAGE-WIDTH>
 111          <COND (<ASSIGNED? NEW>
 112                 <FORM CALL SYSOP MTOPR .JFN ,/MOSLW .NEW ''(RETURN 3)>)
 113                (T
 114                 <FORM CALL SYSOP MTOPR .JFN ,/MORLW ''(RETURN 3)>)>)
 115         (<==? .OPER PAGE-HEIGHT>
 116          <COND (<ASSIGNED? NEW>
 117                 <FORM CALL SYSOP MTOPR .JFN ,/MOSLL .NEW ''(RETURN 3)>)
 118                (T
 119                 <FORM CALL SYSOP MTOPR .JFN ,/MORLL ''(RETURN 3)>)>)
 120         (<OR <==? .OPER PAGE-X> <==? .OPER PAGE-Y>>
 121          <COND (<NOT <ASSIGNED? NEW>>
 122                 <COND (<==? .OPER PAGE-X>
 123                        <FORM RHW <FORM CALL SYSOP RFPOS .JFN ''(RETURN 2)>>)
 124                       (<==? .OPER PAGE-Y>
 125                        <FORM LHW <FORM CALL SYSOP RFPOS .JFN ''(RETURN 2)>>)>)
 126                (T
 127                 <FORM BIND ((NJ .JFN)
 128                             (CPTR <FORM CALL SYSOP RFPOS '.NJ ''(RETURN 2)>)
 129                             (RN .NEW))
 130                   <COND (<==? .OPER PAGE-X>
 131                          <FORM UPDATE-MC .DATA '.RN>
 132                          <FORM CALL SYSOP SFPOS '.NJ
 133                                <FORM PUTRHW '.CPTR '.RN>
 134                                ''(RETURN 2)>)
 135                         (T
 136                          <FORM UPDATE-MC .DATA <> '.RN>
 137                          <FORM CALL SYSOP SFPOS '.NJ
 138                                <FORM PUTLHW '.CPTR '.RN>
 139                                ''(RETURN 2)>)>>)>)>>
 140
 141
 142 <SETG TYPE-NAMES
 143       ["35" "37" "TI" "IMLAC" "DM2500" "HP2645"
 144        "NVT" "SYSTEM" "TVT" "VT05" "VT50" "LA30"
 145        "LINEPROCESSOR?" "LA36" "VT52" "GLASS" "FOX" "VT100V"
 146        "T1061" "H19" "C100" "VT100" "LA38" "LA120"
 147        "PTV" "SUPDUP" "HP2640" "AAA" "BBN"]>
 148
 149 <DEFINE TTY-GET-TYPE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 150                       (VEC ,TYPE-NAMES) NUM)
 151   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (VEC) <VECTOR [REST STRING]>
 152          (NUM) FIX)
 153   <COND (<SET NUM <CALL SYSOP GTTYP <TT-RJFN .DATA> '(RETURN 2)>>
 154          <COND (<G? .NUM <LENGTH .VEC>>
 155                 "UNKNOWN")
 156                (<NTH .VEC .NUM>)>)>>
 157
 158 <DEFINE TTY-TYPE-AHEAD? (CHANNEL OPER
 159                          "AUX" (DATA <CHANNEL-DATA .CHANNEL>) VAL
 160                          (QC <TT-QCT .DATA>))
 161   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL (VAL) <OR FIX FALSE>)
 162   <COND (<AND <SET VAL <CALL SYSOP SIBE <TT-RJFN .DATA> '(RETURN 2)>>
 163               <NOT <0? .VAL>>>
 164          <+ .VAL .QC>)
 165         (<G? .QC 0> .QC)>>
 166
 167 <DEFINE TTY-READ-IMMEDIATE (CHANNEL:CHANNEL OPER
 168                             "OPTIONAL" (NOWAIT?:<OR ATOM FALSE> <>)
 169                             "AUX" (DATA:TTY-CHANNEL <CHANNEL-DATA .CHANNEL>)
 170                                   VAL:<OR FALSE FIX>
 171                                   (ECHO?:<OR ATOM !<FALSE>>
 172                                    <NOT <0? <ANDB <TT-RFCUR .DATA>
 173                                                   ,TT-ECO>>>)
 174                                   (IMAGE?:<OR ATOM !<FALSE>>
 175                                    <0? <ANDB <TT-RFCUR .DATA>
 176                                              ,TT-DAM>>)
 177                                   (CHR 0)
 178                             "VALUE" <OR CHARACTER FALSE>)
 179   <UNWIND
 180    <PROG (TC)
 181     <DUMP-WRITE-BUFFER .DATA>
 182     <COND (<SET CHR <GET-QUEUE-CHAR .DATA>>
 183            <COND (<AND <NOT .IMAGE?> .ECHO?>
 184                   <CALL SYSOP BOUT <TT-WJFN .DATA> <CHTYPE .CHR FIX>>)>
 185            .CHR)
 186           (<OR <NOT .NOWAIT?>
 187                <AND <SET VAL <CALL SYSOP SIBE <TT-RJFN .DATA> '(RETURN 2)>>
 188                     <NOT <0? .VAL>>>>
 189            <COND (<NOT .IMAGE?>
 190                   <TTY-SET-IMAGE .CHANNEL .OPER T <>>)>
 191            <COND (<SET TC <ISYSOP BIN <TT-RJFN .DATA> '(RETURN 2)>>
 192                   <SET CHR <CHTYPE .TC CHARACTER>>)
 193                  (<==? <1 .TC> *600220*>        ; "IOX4"
 194                   ; "Come here when interrupted during the BIN.  We'll
 195                      just try again, but maybe the interrupt handler
 196                      did something odd."
 197                   <SET CHR T>)
 198                  (T
 199                   <SET CHR <>>)>
 200            <COND (<NOT .IMAGE?>
 201                   <TTY-SET-IMAGE .CHANNEL .OPER <>>
 202                   <COND (<AND .ECHO? <TYPE? .CHR CHARACTER>>
 203                          <CALL SYSOP BOUT <TT-WJFN .DATA>
 204                                <CHTYPE .CHR FIX>>)>)>
 205            <COND (<TYPE? .CHR ATOM>
 206                   <AGAIN>)
 207                  (<TYPE? .CHR FIX>
 208                   <>)
 209                  (T
 210                   .CHR)>)>>
 211    <COND (<NOT .IMAGE?>
 212           <TTY-SET-IMAGE .CHANNEL .OPER <>>)>>>
 213
 214 <DEFINE TTY-READ-BYTE (CHANNEL OPER "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 215   #DECL ((CHANNEL) CHANNEL (DATA) TTY-CHANNEL)
 216   <COND (<AND <TT-RBUF .DATA>
 217               <0? <TT-RBC .DATA>>>
 218          <>)
 219         (<TWAY-READ-BYTE .CHANNEL .OPER>)>>
 220
 221 <DEFINE TTY-READ-BUFFER (TTY OPER BUF "OPTIONAL" (LEN <LENGTH .BUF>)
 222                          (CONT 0) "AUX" (DATA <CHANNEL-DATA .TTY>))
 223   #DECL ((TTY) CHANNEL (BUF) STRING (LEN CONT) FIX (DATA) TTY-CHANNEL)
 224   <COND (<TT-RBUF .DATA>
 225          <TWAY-READ-BUFFER .TTY .OPER .BUF .LEN .CONT>)
 226         (T
 227          <CALL READ <TT-RJFN .DATA> .BUF <MIN .LEN <LENGTH .BUF>> .CONT>)>>
 228
 229 <DEFINE TTY-GET-READ (TTY OPER "OPTIONAL" NEW
 230                         "AUX" (DATA <CHANNEL-DATA .TTY>))
 231   #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (NEW) STRING)
 232   <COND (<ASSIGNED? NEW>
 233          <TT-RBUF .DATA .NEW>
 234          .NEW)
 235         (T
 236          <TT-RBUF .DATA>)>>
 237
 238 <DEFINE TTY-BUFLEN (TTY OPER "OPTIONAL" NEW "AUX" (DATA <CHANNEL-DATA .TTY>))
 239   #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (NEW) FIX)
 240   <COND (<ASSIGNED? NEW>
 241          <TT-RBC .DATA .NEW>
 242          .NEW)
 243         (T
 244          <TT-RBC .DATA>)>>
 245
 246 <DEFINE TTY-FILL-READ (TTY OPER "OPTIONAL" (CONT 0) (RBUF <>) (END <>)
 247                        (NOMORE <>)
 248                        "AUX" (DATA <CHANNEL-DATA .TTY>)
 249                              (OB <TT-RBUF .DATA>) (BUF <CALL TOPU .OB>) CT
 250                              TS
 251                              (SPROMPT <COND (<AND <ASSIGNED? READ-PROMPT>
 252                                                  <TYPE? <SET TS .READ-PROMPT>
 253                                                         STRING>>
 254                                             .TS)>)
 255                              (PROMPT
 256                               <STACK <STRING <OR .SPROMPT ""> <ASCII 0>>>)
 257                              TTAB:BYTES)
 258   #DECL ((DATA) TTY-CHANNEL (TTY) CHANNEL (BUF OB) STRING (CONT) FIX
 259          (RBUF END) <OR STRING FALSE> (NOMORE) <OR ATOM FALSE>
 260          (SPROMPT PROMPT) <OR STRING FALSE>)
 261   <COND (<NOT .SPROMPT> <SET PROMPT <>>)>
 262   <COND (<NOT .END>
 263          <SET END <COND (<AND <ASSIGNED? READ-BREAKS>
 264                               <TYPE? <SET TS .READ-BREAKS> STRING>>
 265                          .TS)>>)>
 266   <COND (.RBUF <SET BUF <SET OB .RBUF>>)
 267         (<0? <TT-RBC .DATA>>
 268          <COND (<NOT <0? .CONT>>
 269                 <SET OB <CALL BACKU .OB .CONT>>
 270                 <COND (<N==? .OB .BUF>
 271                        <MAPR <>
 272                          <FUNCTION (OLD NEW)
 273                            #DECL ((OLD NEW) STRING)
 274                            <1 .NEW <1 .OLD>>>
 275                          .OB .BUF>)>)>)
 276         (<SET CONT 0>)>
 277   <COND (<AND <0? .CONT>
 278               .PROMPT>
 279          <TWAY-WRITE-BUFFER .TTY .OPER .PROMPT
 280                             <- <LENGTH .PROMPT> 1>>)>
 281   ; "Eat and echo queued chars"
 282   <REPEAT (CHR (TB <REST .BUF .CONT>))
 283     <COND (<SET CHR <GET-QUEUE-CHAR .DATA>>
 284            <1 .TB .CHR>
 285            <SET TB <REST .TB>>
 286            <SET CONT <+ .CONT 1>>
 287            <TWAY-WRITE-BYTE .TTY .OPER .CHR>)
 288           (T
 289            <RETURN>)>>
 290   <DUMP-WRITE-BUFFER .DATA>
 291   <PROG ()
 292     <SET CT <CALL READ <TT-RJFN .DATA> .BUF <LENGTH .BUF> .CONT
 293                   <OR .END 0> <OR .PROMPT 0>>>
 294     <COND (<AND <NOT .NOMORE> <==? .CT <LENGTH .BUF>>>
 295            <TT-RBUF .DATA <ISTRING <+ <LENGTH .BUF> 320>>>
 296            <MAPR <>
 297              <FUNCTION (OLD NEW)
 298                <1 .NEW <1 .OLD>>>
 299              .BUF <TT-RBUF .DATA>>
 300            <SET BUF <TT-RBUF .DATA>>
 301            <SET CONT .CT>
 302            <AGAIN>)>
 303     .CT>
 304   <COND (<NOT .RBUF>
 305          <TT-RBUF .DATA .BUF>
 306          <TT-RBC .DATA .CT>)>
 307   .CT>
 308
 309 <DEFINE TTY-TERM-MOVE? (TTY OPER "AUX" (DATA <CHANNEL-DATA .TTY>))
 310         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL)
 311         <NOT <0? <ANDB <CALL SYSOP RTCHR <TT-WJFN .DATA> '(RETURN 2)>
 312                        ,TC-MOV>>>>
 313
 314 <DEFINE TTY-NORMAL-OUT (TTY OPER CHRS
 315                         "OPTIONAL" (LENGTH <>)
 316                         "AUX" (DATA <CHANNEL-DATA .TTY>))
 317         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL
 318                (CHRS) <OR BYTES STRING CHARACTER>)
 319         <TTY-SET-IMAGE .TTY SET-IMAGE-MODE <>>
 320         <COND (<TYPE? .CHRS STRING>
 321                <TWAY-WRITE-BUFFER .TTY
 322                                   .OPER
 323                                   .CHRS
 324                                   <COND (.LENGTH .LENGTH) (<LENGTH .CHRS>)>>)
 325               (T <TWAY-WRITE-BYTE .TTY .OPER .CHRS>)>>
 326
 327 <DEFINE TTY-IMAGE-OUT (TTY OPER CHRS
 328                        "OPTIONAL" (LENGTH <>) "TUPLE" MORE
 329                        "AUX" (DATA <CHANNEL-DATA .TTY>))
 330         #DECL ((LENGTH) <OR FIX FALSE> (TTY) CHANNEL (DATA) TTY-CHANNEL
 331                (CHRS) <OR FIX CHARACTER STRING BYTES>
 332                (MORE) <TUPLE [REST <OR FIX BYTES STRING CHARACTER>]>)
 333         <TTY-SET-IMAGE .TTY SET-IMAGE-MODE T>
 334         <+ <WRITE-STUFF .TTY .OPER .CHRS .LENGTH>
 335            <MAPF ,+
 336              <FUNCTION (X)
 337                <WRITE-STUFF .TTY .OPER .X <>>>
 338              .MORE>>>
 339
 340 <SETG BUFSTR <ISTRING 12>>
 341
 342 <DEFINE WRITE-STUFF (TTY OPER CHRS LENGTH "AUX" (BS ,BUFSTR) (NEG? <>))
 343   #DECL ((TTY) CHANNEL (CHRS) <OR STRING FIX CHARACTER>
 344          (LENGTH) <OR FIX FALSE> (BS) STRING (VALUE) <OR FIX FALSE>)
 345   <COND (<TYPE? .CHRS STRING BYTES>
 346          <TWAY-WRITE-BUFFER .TTY .OPER .CHRS
 347                             <COND (.LENGTH .LENGTH)
 348                                   (<LENGTH .CHRS>)>>)
 349         (<TYPE? .CHRS CHARACTER>
 350          <TWAY-WRITE-BYTE .TTY .OPER .CHRS>
 351          1)
 352         (T
 353          <SET BS <REST .BS <LENGTH .BS>>>
 354          <COND (<L? .CHRS 0>
 355                 <SET NEG? T>
 356                 <SET CHRS <- .CHRS>>)>
 357          <REPEAT (REM (ANY? <>))
 358            #DECL ((REM) FIX (ANY?) <OR ATOM FALSE>)
 359            <COND (<0? .CHRS>
 360                   <COND (<NOT .ANY?>
 361                          <SET BS <CALL BACKU .BS 1>>
 362                          <1 .BS !\0>)
 363                         (.NEG?
 364                          <SET BS <CALL BACKU .BS 1>>
 365                          <1 .BS !\->)>
 366                   <TWAY-WRITE-BUFFER .TTY .OPER .BS <LENGTH .BS>>
 367                   <RETURN <LENGTH .BS>>)>
 368            <SET REM <MOD .CHRS 10>>
 369            <SET CHRS </ .CHRS 10>>
 370            <1 <SET BS <CALL BACKU .BS 1>> <ASCII <+ .REM <ASCII !\0>>>>
 371            <SET ANY? T>>)>>
 372
 373 <DEFINE TTY-OPEN TO (STYPE OPR
 374                      "OPTIONAL" (NAME <>) (MODE "") (BSZ "")
 375                      OBUF? IBUF?
 376                      "AUX" OJFN IJFN ERR VAL)
 377         #DECL ((OJFN IJFN ERR) <OR FALSE FIX>)
 378         <COND (<NOT <ASSIGNED? IBUF?>>
 379                <COND (<TYPE? .BSZ STRING>
 380                       <SET IBUF? T>)
 381                      (<SET IBUF? .BSZ>)>)>
 382         <COND (<NOT <ASSIGNED? OBUF?>>
 383                <COND (<TYPE? .MODE STRING>
 384                       <SET OBUF? <>>)
 385                      (<SET OBUF? .MODE>)>)>
 386         <COND (<NOT .NAME>
 387                <SET OJFN ,/PRIOU>
 388                <SET IJFN ,/PRIIN>)
 389               (<SET OJFN <GET-JFN .NAME
 390                                   %<CHTYPE <ORB ,OF-RD ,OF-WR ,OF-APP> FIX>
 391                                   7 <>>>
 392                <SET IJFN .OJFN>)
 393               (T <RETURN .OJFN .TO>)>
 394         <SET VAL <CALL SYSOP RFMOD .OJFN '(RETURN 2)>>
 395         <CHTYPE [.IJFN
 396                  -1
 397                  7
 398                  <COND (.IBUF? <ISTRING 320>)>
 399                  0
 400                  .OJFN
 401                  <COND (.OBUF? <ISTRING 320>)>
 402                  0
 403                  .VAL
 404                  .VAL
 405                  <>
 406                  0
 407                  <>
 408                  <>]
 409                 TTY-CHANNEL>>
 410
 411 <DEFINE TTY-SET-ECHO (TTY OPER ON?
 412                       "AUX" (DATA <CHANNEL-DATA .TTY>)
 413                             (CURMOD
 414                              <NOT <0? <ANDB <TT-RFCUR .DATA> ,TT-ECO>>>))
 415         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (ON? CURMOD) <OR ATOM FALSE>)
 416         <COND (<N==? .CURMOD .ON?>
 417                <TT-RFCUR .DATA <XORB <TT-RFCUR .DATA> ,TT-ECO>>
 418                <CALL SYSOP SFMOD <TT-RJFN .DATA> <TT-RFCUR .DATA>>)>
 419         .TTY>
 420
 421 <DEFINE TTY-SET-IMAGE (TTY OPER ON? "OPTIONAL" (SCREW? T)
 422                        "AUX" (DATA <CHANNEL-DATA .TTY>)
 423                              (CURMOD
 424                               <0? <ANDB <TT-RFCUR .DATA> ,TT-DAM>>))
 425    #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (ON? CURMOD) <OR ATOM FALSE>)
 426    <COND (<N==? .CURMOD .ON?>
 427           <TWAY-BUFOUT .TTY BUFOUT <>>
 428           <COND (<AND .ON? .SCREW?>
 429                  <CALL SYSOP SFPOS <TT-RJFN .DATA> -1>)>
 430           <TT-RFCUR .DATA
 431                     <COND (.ON?
 432                            <ANDB <TT-RFCUR .DATA> %<CHTYPE <XORB ,TT-DAM -1>
 433                                                            FIX>>)
 434                           (T
 435                            <ORB <TT-RFCUR .DATA>
 436                                 <ANDB ,TT-DAM <TT-RFSAV .DATA>>>)>>
 437           <CALL SYSOP SFMOD <TT-RJFN .DATA> <TT-RFCUR .DATA>>)>
 438    .TTY>
 439
 440 \\f
 441
 442 <DEFINE TTY-RESET (TTY OPER "OPTIONAL" (NEW? <>) (FLUSH? T)
 443                    "AUX" (DATA <CHANNEL-DATA .TTY>))
 444         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (FLUSH?) <OR ATOM FALSE>)
 445         <COND (.NEW?
 446                ; "Get the current setting"
 447                <TT-RFCUR .DATA <CALL SYSOP RFMOD <TT-RJFN .DATA>
 448                                      '(RETURN 2)>>
 449                ; "Make sure not in image mode"
 450                <TTY-SET-IMAGE .TTY .OPER <>>
 451                ; "Make sure echoing on"
 452                <TTY-SET-ECHO .TTY .OPER T>
 453                ; "Save this for future resets"
 454                <TT-RFSAV .DATA <TT-RFCUR .DATA>>)
 455               (T
 456                <COND (<N==? <TT-RFCUR .DATA> <TT-RFSAV .DATA>>
 457                       <CALL SYSOP SFMOD <TT-RJFN .DATA> <TT-RFSAV .DATA>>
 458                       <TT-RFCUR .DATA <TT-RFSAV .DATA>>)>
 459                ; "Throw away typeahead"
 460                <COND (.FLUSH? <CALL SYSOP CFIBF <TT-RJFN .DATA>>)>)>
 461         <COND (<TT-RBUF .DATA>
 462                <TT-RBC .DATA 0>
 463                <TT-RBUF .DATA <CALL TOPU <TT-RBUF .DATA>>>)>
 464         <COND (<TT-WBUF .DATA>
 465                <TT-WBC .DATA 0>
 466                <TT-WBUF .DATA <CALL TOPU <TT-WBUF .DATA>>>)>
 467         <TT-QCT .DATA 0>
 468         .TTY>
 469
 470 <DEFINE TTY-QUERY (CHANNEL OPER BIT "AUX" (DATA <CHANNEL-DATA .CHANNEL>))
 471   #DECL ((CHANNEL) CHANNEL (BIT) FIX (DATA) TTY-CHANNEL)
 472   <COND (<==? .BIT ,BIT-INTELLIGENT>
 473          <COND (<TT-RBUF .DATA> T)>)>>
 474
 475 \\f
 476
 477 <DEFINE TTY-SET-CURS (TTY OPER X Y "AUX" (DATA <CHANNEL-DATA .TTY>))
 478   #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (X Y) FIX)
 479   <UPDATE-MC .TTY .X .Y>
 480   <CALL SYSOP SFPOS <TT-RJFN .DATA> <PUTLHW .X .Y>>
 481   T>
 482
 483 <DEFINE TTY-PARM (TTY OPER
 484                   "OPTIONAL" NEW
 485                   "AUX" (DATA <CHANNEL-DATA .TTY>))
 486         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (OPER) ATOM (NEW) FIX)
 487         <COND
 488          (<==? .OPER PAGE-WIDTH>
 489           <COND (<ASSIGNED? NEW>
 490                  <GET-TTY-PARM .DATA PAGE-WIDTH .NEW>)
 491                 (T
 492                  <GET-TTY-PARM .DATA PAGE-WIDTH>)>)
 493          (<==? .OPER PAGE-HEIGHT>
 494           <COND (<ASSIGNED? NEW>
 495                  <GET-TTY-PARM .DATA PAGE-HEIGHT .NEW>)
 496                 (T
 497                  <GET-TTY-PARM .DATA PAGE-HEIGHT>)>)
 498          (<==? .OPER PAGE-X>
 499           <COND (<ASSIGNED? NEW>
 500                  <GET-TTY-PARM .DATA PAGE-X .NEW>)
 501                 (T
 502                  <GET-TTY-PARM .DATA PAGE-X>)>)
 503          (<==? .OPER PAGE-Y>
 504           <COND (<ASSIGNED? NEW>
 505                  <GET-TTY-PARM .DATA PAGE-Y .NEW>)
 506                 (T
 507                  <GET-TTY-PARM .DATA PAGE-Y>)>)>>
 508
 509 \\f
 510
 511 <DEFINE INSERT-LINE (TTY OPER
 512                      "OPTIONAL" (N 1) (TOP <>) (BOT <>)
 513                      "AUX" (DATA <CHANNEL-DATA .TTY>))
 514         #DECL ((TTY) CHANNEL (N) FIX (TOP BOT) <OR FIX FALSE>
 515                (DATA) TTY-CHANNEL)
 516         <COND (<0? .N> T)
 517               (<NOT <OR .TOP .BOT>> <DPYOP .DATA ,/VTLID .N>)
 518               (T
 519                <COND (<NOT .TOP> <SET TOP <GET-TTY-PARM .DATA PAGE-Y>>)>
 520                <COND (<NOT .BOT> <SET BOT <- <GET-TTY-PARM .DATA PAGE-HEIGHT>
 521                                              1>>)>
 522                <DPYOP .DATA
 523                       ,/VTLID
 524                       .N
 525                       <ORB <LSH .TOP 18> <ANDB .BOT *777777*>>>)>>
 526
 527 <DEFINE INSERT-CHAR (TTY OPER
 528                      "OPTIONAL" (N 1) (LEFT <>) (RIGHT <>)
 529                      "AUX" (DATA <CHANNEL-DATA .TTY>))
 530         #DECL ((TTY) CHANNEL (N) FIX (LEFT RIGHT) <OR FIX FALSE>)
 531         <COND (<NOT <OR .LEFT .RIGHT>> <DPYOP .DATA ,/VTCID .N>)
 532               (T
 533                <COND (<NOT .LEFT> <SET LEFT <GET-TTY-PARM .DATA PAGE-X>>)>
 534                <COND (<NOT .RIGHT>
 535                       <SET RIGHT <- <GET-TTY-PARM .DATA PAGE-WIDTH> 1>>)>
 536                <DPYOP .DATA
 537                       ,/VTCID
 538                       .N
 539                       <ORB <ANDB .RIGHT *777777000000*> .LEFT>>)>>
 540
 541 \\f
 542
 543 <DEFINE CLEAR-SCREEN (TTY OPER "AUX" SU)
 544         #DECL ((TTY) CHANNEL)
 545         <UPDATE-MC .TTY 0 0>
 546         <DPYOP <CHANNEL-DATA .TTY> ,/VTCLR>>
 547
 548 <DEFINE CLEAR-EOL (TTY OPER)
 549         #DECL ((TTY) CHANNEL)
 550         <DPYOP <CHANNEL-DATA .TTY> ,/VTCEL>>
 551
 552 <DEFINE CLEAR-EOS (TTY OPER)
 553   #DECL ((TTY) CHANNEL)
 554   <DPYOP <CHANNEL-DATA .TTY> ,/VTCEW>>
 555
 556 <DEFINE FRESH-LINE (TTY OPER "OPTIONAL" (N 1))
 557         #DECL ((TTY) CHANNEL (N) FIX)
 558         <UPDATE-MC .TTY 0>
 559         <DPYOP <CHANNEL-DATA .TTY> ,/VTADV .N>>
 560
 561 <DEFINE KILL-CHAR (TTY OPER)
 562   #DECL ((TTY) CHANNEL)
 563   <DPYOP <CHANNEL-DATA .TTY> ,/VTERA>>
 564
 565 <DEFINE ERASE-CHAR (TTY OPER "OPTIONAL" (N 1) "AUX" (SU <CHANNEL-USER .TTY>))
 566         #DECL ((TTY) CHANNEL (N) FIX)
 567         <UPDATE-MC .TTY (<- .N>)>
 568         <DPYOP <CHANNEL-DATA .TTY> ,/VTBEC .N>>
 569
 570 \\f
 571
 572 "SUBTITLE Cursor movement of various sorts"
 573
 574 <DEFINE HOME-CURSOR (TTY OPER)
 575         #DECL ((TTY) CHANNEL)
 576         <UPDATE-MC .TTY 0 0>
 577         <DPYOP <CHANNEL-DATA .TTY> ,/VTHOM>>
 578
 579 <DEFINE BOTTOM-CURSOR (TTY OPER)
 580         #DECL ((TTY) CHANNEL)
 581         <UPDATE-MC .TTY 0>
 582         <DPYOP <CHANNEL-DATA .TTY> ,/VTHMD>>
 583
 584 <DEFINE HOR-POS-CURSOR (TTY OPER X)
 585         #DECL ((TTY) CHANNEL)
 586         <UPDATE-MC .TTY .X>
 587         <DPYOP <CHANNEL-DATA .TTY> ,/VTHRZ .X>>
 588
 589 <DEFINE VER-POS-CURSOR (TTY OPER Y)
 590         #DECL ((TTY) CHANNEL)
 591         <UPDATE-MC .TTY <> .Y>
 592         <DPYOP <CHANNEL-DATA .TTY> ,/VTVRT .Y>>
 593
 594 <DEFINE MOVE-CURSOR (TTY OPER X Y "AUX" (CD <CHANNEL-DATA .TTY>))
 595         #DECL ((TTY) CHANNEL (CD) TTY-CHANNEL)
 596         <UPDATE-MC .TTY .X .Y>
 597         ; "Caused by tops-20 bug with binary output"
 598         <CALL SYSOP SFPOS <TT-WJFN .CD> -1>
 599         <DPYOP .CD
 600                ,/VTMOV
 601                <ORB <LSH .Y 18> <ANDB .X *777777*>>>>
 602
 603 <DEFINE BACK-CURSOR (TTY OPER "OPTIONAL" (N 1))
 604         #DECL ((TTY) CHANNEL (N) FIX)
 605         <UPDATE-MC .TTY (<- .N>)>
 606         <DPYOP <CHANNEL-DATA .TTY> ,/VTBCK .N>>
 607
 608 <DEFINE DOWN-CURSOR (TTY OPER "OPTIONAL" (N 1))
 609         #DECL ((TTY) CHANNEL (N) FIX)
 610         <UPDATE-MC .TTY <> (.N)>
 611         <DPYOP <CHANNEL-DATA .TTY> ,/VTDWN .N>>
 612
 613 <DEFINE UP-CURSOR (TTY OPER "OPTIONAL" (N 1))
 614         #DECL ((TTY) CHANNEL (N) FIX)
 615         <UPDATE-MC .TTY <> (<- .N>)>
 616         <DPYOP <CHANNEL-DATA .TTY> ,/VTUP .N>>
 617
 618 <DEFINE FORWARD-CURSOR (TTY OPER "OPTIONAL" (N 1))
 619         #DECL ((TTY) CHANNEL (N) FIX)
 620         <UPDATE-MC .TTY (.N)>
 621         <DPYOP <CHANNEL-DATA .TTY> ,/VTFWD .N>>
 622
 623 \\f
 624
 625 <DEFINE SAVE-CURSOR (TTY OPER)
 626         #DECL ((TTY) CHANNEL)
 627         <DPYOP <CHANNEL-DATA .TTY> ,/VTSAV>>
 628
 629 <DEFINE RESTORE-CURSOR (TTY OPER)
 630         #DECL ((TTY) CHANNEL)
 631         <DPYOP <CHANNEL-DATA .TTY> ,/VTRES>>
 632
 633 <DEFINE TTY-PAD (TTY OPER AMT "AUX" (DATA <CHANNEL-DATA .TTY>)
 634                  SPD)
 635   #DECL ((TTY) CHANNEL (AMT) FIX (DATA) TTY-CHANNEL (SPD) <OR FALSE FIX>)
 636   <COND (<OR <NOT <SET SPD
 637                        <CALL SYSOP MTOPR <TT-WJFN .DATA> *27* '(RETURN 3)>>>
 638              <==? .SPD -1>>
 639          <SET SPD 9600>)>
 640   <SET SPD <ANDB .SPD *777777*>>
 641   <SET AMT <FIX </ <FLOAT <* .SPD .AMT>> 7000.0>>>
 642   <TTY-SET-IMAGE .TTY PAD T>
 643   <REPEAT ((BS ,BUFSTR) (TB .BS))
 644     #DECL ((TB BS) STRING)
 645     <COND (<0? .AMT>
 646            <COND (<N==? .TB .BS>
 647                   <TWAY-WRITE-BUFFER .TTY .OPER .TB
 648                                      <- <LENGTH .TB> <LENGTH .BS>>>)>
 649            <RETURN>)>
 650     <COND (<EMPTY? .BS>
 651            <TWAY-WRITE-BUFFER .TTY .OPER .TB>
 652            <SET BS .TB>)>
 653     <1 .BS <ASCII 0>>
 654     <SET BS <REST .BS>>
 655     <SET AMT <- .AMT 1>>>>
 656
 657 <DEFINE TTY-TYPE-CHAR (CHANNEL OPER CHAR "AUX" (DATA <CHANNEL-DATA .CHANNEL>)
 658                        (Q <TT-QUEUE .DATA>) (QC <TT-QCT .DATA>))
 659   #DECL ((CHANNEL) CHANNEL (CHAR) CHARACTER (DATA) TTY-CHANNEL)
 660   <COND (<NOT .Q>
 661          <TT-QUEUE .DATA .CHAR>
 662          <TT-QCT .DATA 1>)
 663         (<TYPE? .Q CHARACTER>
 664          <TT-QUEUE .DATA <SET Q <STRING .Q .CHAR "        ">>>
 665          <TT-QCT .DATA 2>)
 666         (<==? .QC <LENGTH .Q>>
 667          <TT-QUEUE .DATA <STRING .Q .CHAR "         ">>
 668          <TT-QCT .DATA <+ .QC 1>>)
 669         (T
 670          <PUT .Q <SET QC <+ .QC 1>> .CHAR>
 671          <TT-QCT .DATA .QC>)>
 672   .CHAR>
 673
 674 <DEFINE GET-QUEUE-CHAR (DATA "AUX" CHR CT)
 675   #DECL ((DATA) TTY-CHANNEL)
 676   <COND (<G? <SET CT <TT-QCT .DATA>> 0>
 677          <TT-QCT .DATA <SET CT <- .CT 1>>>
 678          <COND (<TYPE? <SET CHR <TT-QUEUE .DATA>> CHARACTER>
 679                 <TT-QUEUE .DATA <>>)
 680                (T
 681                 <SET CHR <1 .CHR>>
 682                 <COND (<0? .CT> <TT-QUEUE .DATA <CALL TOPU <TT-QUEUE .DATA>>>)
 683                       (<TT-QUEUE .DATA <REST <TT-QUEUE .DATA>>>)>)>
 684          .CHR)>>
 685
 686 \\f
 687
 688 <DEFINE TTY-PRINT-DATA (TTY OPER OUTCHAN "AUX" (DATA <CHANNEL-DATA .TTY>)
 689                         TS)
 690         #DECL ((TTY) CHANNEL (DATA) TTY-CHANNEL (TS) <OR FALSE STRING>)
 691         <PRINC "#TTY-CHANNEL [">
 692         <PRINC "JFN:">
 693         <COND (<==? <TT-RJFN .DATA> ,/PRIIN> <PRINC "PRIMARY">)
 694               (T <PRIN1 <TT-RJFN .DATA>>)>
 695         <COND (<SET TS <TT-RBUF .DATA>>
 696                <PRINC " RBUF:">
 697                <PRIN1 <LENGTH <CALL TOPU .TS>>>
 698                <PRINC !\/>
 699                <PRIN1 <LENGTH .TS>>
 700                <PRINC !\/>
 701                <PRIN1 <TT-RBC .DATA>>)>
 702         <COND (<SET TS <TT-WBUF .DATA>>
 703                <PRINC " WBUF:">
 704                <PRIN1 <LENGTH <CALL TOPU .TS>>>
 705                <PRINC !\/>
 706                <PRIN1 <LENGTH .TS>>
 707                <PRINC !\/>
 708                <PRIN1 <TT-WBC .DATA>>)>
 709         <PRINC " RFCUR:">
 710         <PRIN1 <TT-RFCUR .DATA>>
 711         <PRINC !\]>>
 712
 713 <ENDPACKAGE>