mim/development/mim/vax/tty/ttytypes.mud

   1 %<USE "NEWSTRUC">
   2
   3 <NEWSTRUC TTY-DESC VECTOR
   4           TD-NAME STRING
   5           TD-HEIGHT FIX
   6           TD-WIDTH FIX
   7           TD-PADCHR CHARACTER
   8           TD-CRPAD FIX
   9           TD-LFPAD FIX
  10           TD-PRIMOPS <VECTOR [REST <OR FALSE TTY-OP>]>>
  11
  12 <NEWSTRUC TTY-OUT VECTOR
  13          TO-STRING <OR STRING TTY-ELT>
  14          TO-PAD FIX>
  15
  16 <NEWTYPE TTY-ELT VECTOR '<<PRIMTYPE VECTOR> [REST <OR FIX STRING>]>>
  17
  18 <COND (<==? <TYPEPRIM FIX> FIX>
  19        <PUT-DECL TTY-OP
  20                  '<OR STRING TTY-ELT TTY-OUT
  21                       <VECTOR [REST <OR TTY-ELT STRING TTY-OUT>]>>>)
  22       (T
  23        <PUT TTY-OP DECL
  24             '<OR STRING TTY-ELT TTY-OUT
  25                  <VECTOR [REST <OR STRING TTY-ELT TTY-OUT>]>>>)>
  26
  27 "TTY-CHANNELs contain buffers and channel/specific modes.  They point to
  28  TTYs, which contain the rest of the dynamic tty information (cursor pos,
  29  special characters, speed, etc.  A TTY points to a TTY-DESC, which contains
  30  static tty information (type, height, width, padding, escape sequences)."
  31 <NEWSTRUC TTY-CHANNEL VECTOR
  32           TC-IJFN FIX           ; "Input descriptor (STDIN)"
  33           TC-DEV <OR ATOM STRING FALSE> ; "Device name (/dev/tty)"
  34           TC-SNM <OR ATOM STRING FALSE> ; "directory"
  35           TC-NM1 <OR STRING FALSE>
  36           TC-NM2 <OR STRING FALSE>
  37           TC-DSN <OR STRING FALSE>
  38           TC-STATUS FIX
  39           TC-OJFN FIX
  40           TC-IBUF <OR STRING FALSE>     ; "input buffer"
  41           TC-TIBUF <OR STRING FALSE>    ; "top of input buffer"
  42           TC-IBC FIX            ; "# chars in input buffer"
  43           TC-OBUF <OR STRING FALSE>     ; "output buffer"
  44           TC-TOBUF <OR STRING FALSE>    ; "top of output buffer"
  45           TC-OBC FIX            ; "# chars in output buffer"
  46           TC-QUEUE <OR STRING CHARACTER FALSE>
  47           TC-QCT FIX
  48           TC-MODE FIX
  49           TC-SMODE FIX          ; "Mode information for TTY"
  50           TC-TTY <OR TTY FALSE> ; "TTY information">
  51
  52 ; "Bits in TC-MODE and TC-SMODE"
  53 <MSETG TM-ECHO 1>       ; "Defaultly on"
  54 <MSETG TM-IMAGE 2>      ; "Defaultly off"
  55 <MSETG TM-PAGE 4>       ; "Defaultly on--do something at end of page"
  56 <MSETG TM-WRAP 8>       ; "Defaultly on--wrap at end of page"
  57 <MSETG TM-ITS 16>       ; "Defaultly on--do --more-- instead of ^S/^Q"
  58 <MSETG TM-BADPOS 32>    ; "On until we know what the cursor position is"
  59
  60 <SETG TM-DEFAULT <CHTYPE <ORB ,TM-ECHO ,TM-PAGE ,TM-WRAP ,TM-ITS> FIX>>
  61
  62 ; "Offsets in TT-SPEC-CHARS"
  63 <MSETG TS-REPRINT 1>    ; "ctrl-R"
  64 <MSETG TS-WORD 2>       ; "ctrl-W"
  65 <MSETG TS-QUOTE 3>      ; "ctrl-V"
  66 <MSETG TS-RUBOUT 4>     ; "rubout"
  67 <MSETG TS-KILL 5>       ; "ctrl-U"
  68 <NEWSTRUC TTY VECTOR
  69           TT-OSTATE     TTSTATE ; "Saved state of tty, to win when quit"
  70           TT-NSTATE     TTSTATE ; "Current state of tty, to win when continue"
  71           TT-SCREWED    <OR ATOM FALSE> ; "True when in funny mode"
  72           TT-SPEC-CHARS STRING  ; "User's definitions of editing chars"
  73           TT-OSPEED     FIX     ; "Output speed, for padding"
  74           TT-X          FIX     ; "Current column"
  75           TT-Y          FIX     ; "Current line"
  76           TT-SAV-X      <OR FIX FALSE>  ; "Saved X position"
  77           TT-SAV-Y      <OR FIX FALSE>  ; "Saved Y position"
  78           TT-LAST-IN    <OR FIX FALSE>  ; "Last line input happened on"
  79           TT-LAST-MORE  FIX             ; "Set to 0 when more happens"
  80           TT-DESC       TTY-DESC
  81           TT-MORE-LINES <OR FIX FALSE>>
  82
  83 <NEWSTRUC TTSTATE VECTOR
  84           TST-TCHARS STRING
  85           TST-BITS <UVECTOR FIX>
  86           TST-SGTTYB STRING
  87           TST-LTCHARS STRING>
  88
  89 \f
  90 "MACROS"
  91
  92 ; "Test the mode word of the channel"
  93 <DEFMAC TEST-MODE ('MD 'MODE "ARGS" FOO)
  94   <COND (<NOT <EMPTY? .FOO>>
  95          <FORM NOT <FORM 0? <FORM ANDB .MD
  96                                   <FORM + .MODE !.FOO>>>>)
  97         (<FORM NOT <FORM 0? <FORM ANDB .MODE .MD>>>)>>
  98
  99 <DEFMAC TEST-TC-MODE ('TC 'MODE "ARGS" FOO)
 100   <FORM TEST-MODE <FORM TC-MODE .TC> .MODE !.FOO>>
 101
 102 <DEFMAC ECHO-ON? ('MD)
 103   <FORM AND <FORM TEST-MODE .MD ,TM-ECHO>
 104             <FORM NOT <FORM TEST-MODE .MD ,TM-IMAGE>>>>
 105
 106 ; "Update the mud-chan, to account for cursor motion"
 107 <DEFMAC UPDATE-MC ('CH 'X "OPTIONAL" 'Y "AUX" (L ()))
 108   <COND (<AND <ASSIGNED? X> .X <OR <NOT <STRUCTURED? .X>>
 109                                    <NOT <EMPTY? .X>>>>
 110          <SET L (<COND (<TYPE? .X LIST>
 111                         <FORM MC-HPOS '.SU <FORM + <FORM MC-HPOS '.SU>
 112                                                    <1 .X>>>)
 113                        (<FORM MC-HPOS '.SU .X>)>)>)>
 114   <COND (<AND <ASSIGNED? Y> .Y <OR <NOT <STRUCTURED? .Y>>
 115                                    <NOT <EMPTY? .Y>>>>
 116          <SET L (<COND (<TYPE? .Y LIST>
 117                         <FORM MC-VPOS '.SU <FORM + <FORM MC-VPOS '.SU>
 118                                                    <1 .Y>>>)
 119                        (<FORM MC-VPOS '.SU .Y>)> !.L)>)>
 120   <COND (<NOT <EMPTY? .L>>
 121          <FORM BIND ((SU <FORM CHANNEL-USER .CH>))
 122                <FORM COND (<FORM TYPE? '.SU MUD-CHAN> !.L)>>)>>
 123
 124 <DEFMAC DO-TTY-PARM ('TC OPER "OPTIONAL" 'NEW "AUX" (TTY <FORM TC-TTY .TC>)
 125                      (TD <FORM TT-DESC .TTY>))
 126   <COND (<==? .OPER PAGE-WIDTH>
 127          <COND (<ASSIGNED? NEW>
 128                 <FORM TD-WIDTH .TD .NEW>)
 129                (T
 130                 <FORM - <FORM TD-WIDTH .TD> 1>)>)
 131         (<==? .OPER PAGE-HEIGHT>
 132          <COND (<ASSIGNED? NEW>
 133                 <FORM TD-HEIGHT .TD .NEW>)
 134                (T
 135                 <FORM TD-HEIGHT .TD>)>)
 136         (<==? .OPER PAGE-X>
 137          <COND (<ASSIGNED? NEW>
 138                 <COND (<AND <TYPE? .NEW FIX>
 139                             <0? .NEW>>
 140                        <FORM TT-X .TTY .NEW>)
 141                       (T
 142                        <FORM BIND ((RTTY .TTY) (TD <FORM TT-DESC '.RTTY>)
 143                                    (RNEW <FORM MIN <FORM ABS .NEW>
 144                                                <FORM - <FORM TD-WIDTH '.TD>
 145                                                      1>>))
 146                              <FORM TT-X '.RTTY '.RNEW>>)>)
 147                (T
 148                 <FORM TT-X .TTY>)>)
 149         (<==? .OPER PAGE-Y>
 150          <COND (<ASSIGNED? NEW>
 151                 <COND (<AND <TYPE? .NEW FIX>
 152                             <0? .NEW>>
 153                        <FORM TT-Y .TTY .NEW>)
 154                       (T
 155                        <FORM BIND ((RTTY .TTY) (TD <FORM TT-DESC '.RTTY>)
 156                                    (RNEW <FORM MIN <FORM ABS .NEW>
 157                                                <FORM - <FORM TD-HEIGHT '.TD>
 158                                                      1>>))
 159                              <FORM TT-Y '.RTTY '.RNEW>>)>)
 160                (T
 161                 <FORM TT-Y .TTY>)>)>>
 162
 163