mim/development/mim/vax/tty/ttyout.mud

   1 "Low-level TTY output routines:  raw output, padding, do terminal ops"
   2
   3 "Perform simple tty ops--interpret specifications in tty-desc."
   4 <DEFINE DO-TTY-OP (OPCODE CHANNEL "OPTIONAL" (NEWX <>) (NEWY <>)
   5                    (SET? T)
   6                    "AUX" (TC <CHANNEL-DATA .CHANNEL>) (TTY <TC-TTY .TC>)
   7                          (TD <TT-DESC .TTY>) OD)
   8   #DECL ((OPCODE) FIX (CHANNEL) CHANNEL (NEWX NEWY) <OR FALSE FIX>
   9          (TC) TTY-CHANNEL (TTY) TTY (TD) TTY-DESC (SET?) <OR ATOM FALSE>)
  10   <COND (.NEWX
  11          <COND (.SET?
  12                 <TT-X .TTY <SET NEWX <MIN .NEWX <- <TD-WIDTH .TD> 1>>>>)>)
  13         (<SET NEWX <TT-X .TTY>>)>
  14   <COND (.NEWY
  15          <COND (.SET?
  16                 <TT-Y .TTY <SET NEWY <MIN .NEWY <- <TD-HEIGHT .TD> 1>>>>)>)
  17         (<SET NEWY <TT-Y .TTY>>)>
  18   <TC-MODE .TC <ANDB <TC-MODE .TC> %<XORB ,TM-BADPOS -1>>>
  19   <COND (.SET? <UPDATE-MC .CHANNEL .NEWX .NEWY>)>
  20   <COND (<SET OD <AND <G=? <LENGTH <TD-PRIMOPS .TD>> .OPCODE>
  21                       <NTH <TD-PRIMOPS .TD> .OPCODE>>>
  22          <OUTPUT-OP .OD .CHANNEL .TD .NEWX .NEWY>)>>
  23
  24 <DEFINE OUTPUT-OP (OD CHANNEL TD X Y "OPTIONAL" (PAD 0))
  25   #DECL ((OD) TTY-OP (CHANNEL) CHANNEL (TD) TTY-DESC (X Y PAD) FIX)
  26   <COND (<TYPE? .OD VECTOR>
  27          <MAPF <>
  28            <FUNCTION (OC)
  29              <OUTPUT-OP .OC .CHANNEL .TD .X .Y>>
  30            .OD>
  31          T)
  32         (T
  33          <COND (<TYPE? .OD TTY-OUT>
  34                 <SET PAD <TO-PAD .OD>>
  35                 <SET OD <TO-STRING .OD>>)>
  36          <COND (<TYPE? .OD STRING>
  37                 <OUTPUT-RAW-STRING .CHANNEL .OD>)
  38                (<TYPE? .OD TTY-ELT>
  39                 <MAPF <>
  40                   <FUNCTION (ELT "AUX" VAL)
  41                     #DECL ((ELT) <OR FIX STRING> (VAL) FIX)
  42                     <COND (<TYPE? .ELT STRING>
  43                            <OUTPUT-RAW-STRING .CHANNEL .ELT>)
  44                           (T
  45                            <COND (<0? <ANDB .ELT ,TTY-X/Y>>
  46                                   <SET VAL .X>)
  47                                  (<SET VAL .Y>)>
  48                            <COND (<NOT <0? <ANDB .ELT ,TTY-INC-ARG>>>
  49                                   <SET VAL <+ .VAL 1>>)>
  50                            <COND (<NOT <0? <ANDB .ELT ,TTY-BCD-ARG>>>
  51                                   <SET VAL <+ <* 16 </ .VAL 10>>
  52                                               <MOD .VAL 10>>>)>
  53                            <SET ELT <ANDB .ELT ,TTY-ARG-DESC>>
  54                            <COND (<==? .ELT ,TTY-LITERAL>
  55                                   <OUTPUT-RAW-STRING .CHANNEL <ASCII .VAL>>)
  56                                  (<==? .ELT ,TTY-LIT+>
  57                                   <OUTPUT-RAW-STRING .CHANNEL
  58                                                      <ASCII <+ .VAL 32>>>)
  59                                  (<==? .ELT ,TTY-DECIMAL>
  60                                   <OUTPUT-NUMBER .CHANNEL .VAL <>>)
  61                                  (<==? .ELT ,TTY-RJD2>
  62                                   <OUTPUT-NUMBER .CHANNEL .VAL <>>)
  63                                  (<==? .ELT ,TTY-RJD3>
  64                                   <OUTPUT-NUMBER .CHANNEL .VAL <>>)>)>>
  65                   .OD>)>
  66          <COND (<NOT <0? .PAD>>
  67                 <OUTPUT-PAD .CHANNEL .TD .PAD>)>
  68          T)>>
  69
  70 <SETG BUF1 <ISTRING 1>>
  71 <GDECL (BUF1) STRING>
  72
  73 "Lowest level output routine--stuff uninterpreted characters out or into
  74  output buffer"
  75 <DEFINE OUTPUT-RAW-STRING (CHANNEL STR "OPTIONAL" (LENGTH <>)
  76                            "AUX" (TC <CHANNEL-DATA .CHANNEL>) OBUF)
  77   #DECL ((CHANNEL) CHANNEL (STR) <OR CHARACTER STRING> (TC) TTY-CHANNEL
  78          (LENGTH) <OR FIX FALSE> (OBUF) STRING)
  79   <COND (<TYPE? .STR CHARACTER>
  80          <SET STR <1 ,BUF1 .STR>>)>
  81   <COND (<NOT .LENGTH>
  82          <SET LENGTH <LENGTH .STR>>)>
  83   <COND (<NOT <TC-OBUF .TC>>
  84          <CALL SYSCALL WRITE <TC-OJFN .TC> .STR .LENGTH>
  85          .LENGTH)
  86         (T
  87          <SET OBUF <TC-OBUF .TC>>
  88          <REPEAT ((WR 0) TRANS)
  89            #DECL ((TRANS) FIX)
  90            <COND (<0? .LENGTH>
  91                   <RETURN .WR>)
  92                  (<EMPTY? .OBUF>
  93                   <DUMP-WRITE-BUFFER .TC>
  94                   <SET OBUF <TC-OBUF .TC>>)>
  95            <SET TRANS <MIN <LENGTH .OBUF> .LENGTH>>
  96            <SUBSTRUC .STR 0 .TRANS .OBUF>
  97            <SET STR <REST .STR .TRANS>>
  98            <TC-OBUF .TC <SET OBUF <REST .OBUF .TRANS>>>
  99            <TC-OBC .TC <+ <TC-OBC .TC> .TRANS>>
 100            <SET WR <+ .WR .TRANS>>
 101            <SET LENGTH <- .LENGTH .TRANS>>>)>>
 102
 103 "Output a specifed amount of padding (time in milliseconds)"
 104 <DEFINE OUTPUT-PAD (CHANNEL TD AMT "AUX" (TC <CHANNEL-DATA .CHANNEL>)
 105                     (OSPEED <TT-OSPEED <TC-TTY .TC>>) PC)
 106   #DECL ((CHANNEL) CHANNEL (TD) TTY-DESC (AMT OSPEED) FIX (TC) TTY-CHANNEL)
 107   <COND (<G? .AMT 0>
 108          <COND (<==? .OSPEED 0> <SET OSPEED 9600>)>
 109          <SET AMT <FIX </ <* <FLOAT .OSPEED> <FLOAT .AMT>>
 110                           7000.0>>>     ; "# chars to send"
 111          <SET PC <TD-PADCHR .TD>>       ; "Which char to send"
 112          <COND (<NOT <TC-OBUF .TC>>
 113                 <REPEAT ((OJFN <TC-OJFN .TC>) (ST <STRING .PC>))
 114                   <COND (<0? .AMT> <RETURN>)>
 115                   <CALL SYSCALL WRITE .OJFN .ST 1>
 116                   <SET AMT <- .AMT 1>>>)
 117                (T
 118                 <REPEAT ((OBUF <TC-OBUF .TC>) (OC <TC-OBC .TC>))
 119                   #DECL ((OBUF) STRING (OC) FIX)
 120                   <COND (<0? .AMT>
 121                          <TC-OBUF .TC .OBUF>
 122                          <TC-OBC .TC .OC>
 123                          <RETURN>)>
 124                   <COND (<EMPTY? .OBUF>
 125                          <TC-OBUF .TC .OBUF>
 126                          <TC-OBC .TC .OC>
 127                          <DUMP-WRITE-BUFFER .TC>
 128                          <SET OBUF <TC-OBUF .TC>>
 129                          <SET OC 0>)>
 130                   <1 .OBUF .PC>
 131                   <SET OC <+ .OC 1>>
 132                   <SET OBUF <REST .OBUF>>
 133                   <SET AMT <- .AMT 1>>>)>)>>
 134
 135 <SETG NUMBUF <ISTRING 10>>
 136 <GDECL (NUMBUF) STRING>
 137
 138 "Output a number in raw mode"
 139 <DEFINE OUTPUT-NUMBER (CHANNEL NUM WIDTH "AUX" (BUF <REST ,NUMBUF 10>)
 140                        CWIDTH (NEG? <>))
 141   #DECL ((CHANNEL) CHANNEL (NUM) FIX (WIDTH) <OR FIX FALSE> (BUF) STRING)
 142   <COND (<0? .NUM>
 143          <1 <SET BUF <BACK .BUF>> !\0>
 144          <SET CWIDTH 1>)
 145         (T
 146          <COND (<L? .NUM 0>
 147                 <SET NUM <- .NUM>>
 148                 <SET NEG? T>)>
 149          <REPEAT (DIG)
 150            <SET DIG <MOD .NUM 10>>
 151            <SET NUM </ .NUM 10>>
 152            <1 <SET BUF <BACK .BUF>> <ASCII <+ .DIG <ASCII !\0>>>>
 153            <COND (<0? .NUM>
 154                   <COND (.NEG?
 155                          <1 <SET BUF <BACK .BUF>> !\->)>
 156                   <RETURN>)>>)>
 157   <SET CWIDTH <LENGTH .BUF>>
 158   <COND (<AND .WIDTH <G? .WIDTH .CWIDTH>>
 159          <REPEAT ()
 160            <1 <SET BUF <BACK .BUF>> !\ >
 161            <COND (<L=? .WIDTH <SET CWIDTH <+ .CWIDTH 1>>>
 162                   <RETURN>)>>)>
 163   <OUTPUT-RAW-STRING .CHANNEL .BUF .CWIDTH>>
 164
 165 "Dump the channel's output buffer"
 166 <DEFINE DUMP-WRITE-BUFFER (TC "AUX" TOPB)
 167   #DECL ((TC) TTY-CHANNEL (TOPB) STRING)
 168   <COND (<G? <TC-OBC .TC> 0>
 169          <CALL SYSCALL WRITE <TC-OJFN .TC>
 170                <SET TOPB <TC-TOBUF .TC>> <TC-OBC .TC>>
 171          <TC-OBC .TC 0>
 172          <TC-OBUF .TC .TOPB>)>>