mim/development/mim/vax/vs/vsdefs.mud

   1 <DEFINITIONS "VSDEFS">
   2
   3 <INCLUDE "VSTYPES">
   4
   5 <USE "NEWSTRUC">
   6
   7 <EVAL-WHEN ("SUBSYSTEM" "MIMC") <L-FLOAD "UMC-DEFS.MUD">>
   8
   9 <MSETG X-DEFAULT-KEYMAP "VSKEYMAP">
  10
  11 <REPEAT (INCHAN VECTOR NM2 FIX (STRING '["NORMAL" X-NORMAL-KEYMAP
  12                                          "FUNCTION" X-FUNCTION-KEYMAP]))
  13    <SET NM2 <1 .STRING>>
  14    <COND (<SET INCHAN <GEN-OPEN ,X-DEFAULT-KEYMAP "READ" "BINARY" DISK>>
  15           <SET VECTOR <IVECTOR <CHANNEL-OP .INCHAN READ-BYTE> <>>>
  16           <SET FIX <CHANNEL-OP .INCHAN READ-BYTE>>
  17           <REPEAT ((UVECTOR <STACK <IUVECTOR 6>>))
  18              <COND (<0? <CHANNEL-OP .INCHAN READ-BUFFER .UVECTOR>>
  19                     <RETURN>)>
  20              <PUT .VECTOR <- <1 .UVECTOR> .FIX -1>
  21                   <CHTYPE <SUBSTRUC .UVECTOR 1 5> KEY>>>
  22           <CLOSE .INCHAN>
  23           <MSETG <2 .STRING> [.FIX .VECTOR]>)
  24          (T
  25           <MSETG <2 .STRING> <>>)>
  26    <COND (<EMPTY? <SET STRING <REST .STRING 2>>>
  27           <RETURN>)>>
  28
  29 ; "Input packet types"
  30 <MSETG X-EVENT 1>
  31 <MSETG X-ERROR 2>
  32 <MSETG X-REPLY 3>
  33
  34 ; "Error codes"
  35 <MSETG X-NO-SUCH-WINDOW 1>
  36 <MSETG X-NULL-WINDOW 2>
  37 <MSETG X-PARAMETER-ERROR 3>
  38 <MSETG X-UNKNOWN-REQUEST 4>
  39 <MSETG X-CANT-OPEN-FONT 5>
  40 <MSETG X-BAD-FONT 6>
  41 <MSETG X-CURSOR-ERROR 7>
  42 <MSETG X-NEGATIVE-SIZE 8>
  43 <MSETG X-ALREADY-GRABBED 9>
  44 <MSETG VS-ERRORS ["Window ID was not a Window"
  45                   "Window ID was not zero"
  46                   "Bad function code or other parameter"
  47                   "Bad request code"
  48                   "Bad font name"
  49                   "Font was not a Font"
  50                   "Cursor raster was NULL"
  51                   "Some argument L=? 0"
  52                   "Keyboard/mouse already grabbed"]>
  53
  54 ; "Event codes"
  55 <MSETG KEY-PRESSED 1>
  56 <MSETG KEY-RELEASED 2>
  57 <MSETG BUTTON-PRESSED 4>
  58 <MSETG BUTTON-RELEASED 8>
  59 <MSETG ENTER-WINDOW 16>
  60 <MSETG LEAVE-WINDOW 32>
  61 <MSETG MOUSE-MOVED 64>
  62 <MSETG EXPOSE-WINDOW 128>
  63 <MSETG EXPOSE-REGION 256>
  64 <MSETG EXPOSE-COPY 512>
  65 <MSETG RIGHT-DOWN-MOTION 1024>
  66 <MSETG MIDDLE-DOWN-MOTION 2048>
  67 <MSETG LEFT-DOWN-MOTION 4096>
  68 <MSETG UNMAP-WINDOW 8192>
  69 <MSETG MOTION-BITS <+ ,MOUSE-MOVED ,RIGHT-DOWN-MOTION ,MIDDLE-DOWN-MOTION
  70                       ,LEFT-DOWN-MOTION>>
  71 \f
  72 ; "Key shift codes"
  73
  74 <MSETG X-CONTROL-MASK <HEX "4000">>
  75 <MSETG X-META-MASK <HEX "2000">>
  76 <MSETG X-SHIFT-MASK <HEX "1000">>
  77 <MSETG X-SHIFT-LOCK-MASK <HEX "800">>
  78 <MSETG X-LEFT-MASK <HEX "400">>
  79 <MSETG X-MIDDLE-MASK <HEX "200">>
  80 <MSETG X-RIGHT-MASK <HEX "100">>
  81
  82 ; "There are three kinds of keys--shift keys, function keys, and normal keys.
  83 Shifts are shift, shift-lock, control, and symbol; function keys are everything
  84 off the main keypad."
  85 <MSETG KEY-MIN-SHIFT 174>
  86 <MSETG KEY-MAX-SHIFT 177>
  87
  88 <MSETG KEY-MIN-FCN 86>
  89 <MSETG KEY-MAX-FCN 170>
  90
  91 <MSETG KEY-MIN-NORM 188>
  92 <MSETG KEY-MAX-NORM 251>
  93 \f
  94
  95 <DEFINE DEFINE-BYTE (NAME WHICH "AUX" OFFS)
  96    <SET OFFS </ <+ .WHICH 3> 4>>
  97    <COND
  98     (<FEATURE? "COMPILER">
  99      <EVAL <FORM DEFMAC .NAME (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
 100                  <FORM COND
 101                        (<FORM ASSIGNED? NEW>
 102                         <FORM FORM
 103                               .OFFS
 104                               '.P
 105                               <FORM FORM PUTBITS
 106                                     <FORM FORM .OFFS '.P>
 107                                     <BITS 8 <* <MOD .WHICH 4> 8>>
 108                                     '.NEW>>)
 109                        (T
 110                         <FORM FORM GETBITS
 111                               <FORM FORM .OFFS '.P>
 112                               <BITS 8 <* <MOD .WHICH 4> 8>>>)>>>)
 113     (T
 114      <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW)
 115                     <FORM COND (<FORM ASSIGNED? NEW>
 116                                 <FORM .OFFS '.P
 117                                       <FORM PUTBITS <FORM .OFFS '.P>
 118                                             <BITS 8 <* <MOD .WHICH 4> 8>>
 119                                             '.NEW>>)
 120                           (T
 121                            <FORM GETBITS
 122                                  <FORM .OFFS '.P>
 123                                  <BITS 8 <* <MOD .WHICH 4> 8>>>)>>>)>>
 124
 125 <DEFINE DEFINE-WORD (NAME WHICH "OPTIONAL" (SIZE WORD)
 126                      "AUX" OFFS LEFT? (LONG? <>) (COMPILER? <>))
 127         #DECL ((NAME) ATOM (WHICH) FIX)
 128         <COND (<==? .SIZE WORD>
 129                <SET OFFS </ <+ .WHICH 1> 2>>
 130                <SET LEFT? <0? <MOD .WHICH 2>>>)
 131               (T
 132                <COND (<0? <MOD .WHICH 2>>
 133                       <ERROR LONG-WORD-STARTS-IN-LEFT-HALF .NAME
 134                              .WHICH DEFINE-WORD>)>
 135                <SET OFFS </ <+ .WHICH 1> 2>>
 136                <SET LONG? T>)>
 137         <COND
 138          (.LONG?
 139           <SETG .NAME <OFFSET .OFFS UVECTOR>>
 140           <MANIFEST .NAME>)
 141          (T
 142           <COND
 143            (<FEATURE? "COMPILER">
 144             <EVAL <FORM DEFMAC
 145                         .NAME
 146                         (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
 147                         <FORM COND
 148                               (<FORM ASSIGNED? NEW>
 149                                <FORM FORM
 150                                      .OFFS
 151                                      '.P
 152                                      <COND (.LEFT?
 153                                             <FORM FORM
 154                                                   PUTLHW
 155                                                   <FORM FORM .OFFS '.P>
 156                                                   '.NEW>)
 157                                            (T
 158                                             <FORM FORM
 159                                                   PUTRHW
 160                                                   <FORM FORM .OFFS '.P>
 161                                                   '.NEW>)>>)
 162                               (T
 163                                <FORM FORM
 164                                 BIND
 165                                 ((TEMP
 166                                   <COND (.LEFT?
 167                                          <FORM FORM LHW <FORM FORM .OFFS '.P>>)
 168                                         (T
 169                                          <FORM FORM RHW <FORM FORM .OFFS '.P>>)>))
 170                                 <FORM FORM COND (<FORM FORM 0?
 171                                                        <FORM FORM ANDB ''.TEMP
 172                                                                 *100000*>>
 173                                                  ''.TEMP)
 174                                       (T
 175                                        <FORM FORM PUTLHW ''.TEMP -1>)>>)>>>)
 176            (T
 177             <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW "AUX" TEMP)
 178                         <FORM COND (<FORM ASSIGNED? NEW>
 179                                     <FORM .OFFS '.P
 180                                           <COND (.LEFT?
 181                                                  <FORM PUTLHW <FORM .OFFS '.P>
 182                                                        '.NEW>)
 183                                                 (T
 184                                                  <FORM PUTRHW <FORM .OFFS '.P>
 185                                                        '.NEW>)>>)
 186                               (T
 187                                <FORM
 188                                 COND
 189                                  (<FORM
 190                                    NOT
 191                                    <FORM 0?
 192                                          <FORM
 193                                           ANDB
 194                                           <FORM
 195                                            SET TEMP
 196                                            <COND (.LEFT?
 197                                                   <FORM LHW <FORM .OFFS '.P>>)
 198                                                  (T
 199                                                   <FORM RHW <FORM .OFFS '.P>>)>>
 200                                           *100000*>>>
 201                                   <FORM PUTLHW '.TEMP -1>)
 202                                  (T '.TEMP)>)>>>)>)>>
 203
 204 <COND
 205  (<GASSIGNED? DEFINE-WORD>
 206   ; "Fields of input packet"
 207   <DEFINE-WORD I-LPAR0 3 LONG>
 208   <DEFINE-WORD I-LPAR1 5 LONG>
 209   <DEFINE-WORD I-LPAR2 7 LONG>
 210   <DEFINE-WORD I-LPAR3 9 LONG>
 211   <DEFINE-WORD I-LPAR4 11 LONG>
 212
 213   <DEFINE-WORD I-SPAR0 3>
 214   <DEFINE-WORD I-SPAR1 4>
 215   <DEFINE-WORD I-SPAR2 5>
 216   <DEFINE-WORD I-SPAR3 6>
 217   <DEFINE-WORD I-SPAR4 7>
 218   <DEFINE-WORD I-SPAR5 8>
 219   <DEFINE-WORD I-SPAR6 9>
 220   <DEFINE-WORD I-SPAR7 10>
 221   <DEFINE-WORD I-SPAR8 11>
 222   <DEFINE-WORD I-SPAR9 12>
 223
 224   <DEFINE-WORD VSI-CODE 1>
 225   <DEFINE-WORD VSI-TIME 2>
 226   <MSETG VSI-WINDOW ,I-LPAR0>
 227   <SETG VSI-KIND ,I-SPAR2>
 228   <SETG VSI-DETAIL ,I-SPAR3>
 229   <SETG VSI-X ,I-SPAR4>
 230   <SETG VSI-Y ,I-SPAR5>
 231   <MSETG VSI-SUBWINDOW ,I-LPAR3>
 232   <MSETG VSI-LOC ,I-LPAR4>
 233   <SETG VSI-TOP ,I-SPAR8>
 234   <SETG VSI-LEFT ,I-SPAR9>
 235
 236   <SETG I-ERRCODE ,I-SPAR2>
 237
 238   ; "Fields of output packet"
 239   <DEFINE-WORD O-CODE 1>
 240   <DEFINE-WORD O-FCN 2>
 241   <DEFINE-WORD O-FUNC&CODE 1 LONG>
 242   <DEFINE-WORD O-WINDOW 3 LONG>
 243
 244   <DEFINE-BYTE O-BPAR0 9>
 245   <DEFINE-BYTE O-BPAR1 10>
 246   <DEFINE-BYTE O-BPAR2 11>
 247   <DEFINE-BYTE O-BPAR3 12>
 248   <DEFINE-BYTE O-BPAR4 13>
 249   <DEFINE-BYTE O-BPAR5 14>
 250   <DEFINE-BYTE O-BPAR6 15>
 251   <DEFINE-BYTE O-BPAR7 16>
 252   <DEFINE-BYTE O-BPAR8 17>
 253   <DEFINE-BYTE O-BPAR9 18>
 254   <DEFINE-BYTE O-BPAR10 19>
 255   <DEFINE-BYTE O-BPAR11 20>
 256   <DEFINE-BYTE O-BPAR12 21>
 257   <DEFINE-BYTE O-BPAR13 22>
 258   <DEFINE-BYTE O-BPAR14 23>
 259   <DEFINE-BYTE O-BPAR15 24>
 260
 261   <DEFINE-WORD O-SPAR0 5>
 262   <DEFINE-WORD O-SPAR1 6>
 263   <DEFINE-WORD O-SPAR2 7>
 264   <DEFINE-WORD O-SPAR3 8>
 265   <DEFINE-WORD O-SPAR4 9>
 266   <DEFINE-WORD O-SPAR5 10>
 267   <DEFINE-WORD O-SPAR6 11>
 268   <DEFINE-WORD O-SPAR7 12>
 269
 270   <DEFINE-WORD O-LPAR0 5 LONG>
 271   <DEFINE-WORD O-LPAR1 7 LONG>
 272   <DEFINE-WORD O-LPAR2 9 LONG>
 273   <DEFINE-WORD O-LPAR3 11 LONG>)>
 274 \f
 275 <MSETG VWM-PAGE 1>
 276 <MSETG VWM-WRAP 2>
 277 <MSETG VWM-ITS 4>
 278 <MSETG VWM-UNSEEN 8>
 279 <MSETG VWM-CURSOR 16>
 280 <MSETG VWM-DEFAULT <+ ,VWM-PAGE ,VWM-WRAP ,VWM-ITS ,VWM-CURSOR>>
 281 <MSETG VWM-INVERT 32>
 282 <MSETG VWM-UNDER 64>
 283 <DEFMAC TEST-VW-MODE ('MODE "ARGS" STUFF)
 284    <FORM NOT <FORM 0? <FORM ANDB .MODE !.STUFF>>>>
 285 \f
 286 <DEFMAC UPDATE-MC ('CH 'X "OPTIONAL" 'Y "AUX" (L ()))
 287   <COND (<AND <ASSIGNED? X> .X <OR <NOT <STRUCTURED? .X>>
 288                                    <NOT <EMPTY? .X>>>>
 289          <SET L (<COND (<TYPE? .X LIST>
 290                         <FORM MC-HPOS '.SU <FORM + <FORM MC-HPOS '.SU>
 291                                                    <1 .X>>>)
 292                        (<FORM MC-HPOS '.SU .X>)>)>)>
 293   <COND (<AND <ASSIGNED? Y> .Y <OR <NOT <STRUCTURED? .Y>>
 294                                    <NOT <EMPTY? .Y>>>>
 295          <SET L (<COND (<TYPE? .Y LIST>
 296                         <FORM MC-VPOS '.SU <FORM + <FORM MC-VPOS '.SU>
 297                                                    <1 .Y>>>)
 298                        (<FORM MC-VPOS '.SU .Y>)> !.L)>)>
 299   <COND (<NOT <EMPTY? .L>>
 300          <FORM BIND ((SU <FORM CHANNEL-USER .CH>))
 301                <FORM COND (<FORM TYPE? '.SU MUD-CHAN> !.L)>>)>>
 302
 303 <END-DEFINITIONS>