mim/development/mim/vax/nvs/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-ERROR -1>
  31 <MSETG X-REPLY 0>
  32
  33 ; "Error codes"
  34 <MSETG X-UNKNOWN-REQUEST 1>
  35 <MSETG X-BAD-VALUE 2>
  36 <MSETG X-NO-SUCH-WINDOW 3>
  37 <MSETG X-BAD-PIXMAP 4>
  38 <MSETG X-BAD-BITMAP 5>
  39 <MSETG X-BAD-CURSOR 6>
  40 <MSETG X-BAD-FONT 7>
  41 <MSETG X-BAD-MATCH 8>
  42 <MSETG X-BAD-TILE 9>
  43 <MSETG X-ALREADY-GRABBED 10>
  44 <MSETG X-BAD-ACCESS 11>
  45 <MSETG X-BAD-ALLOC 12>
  46
  47 <MSETG VS-ERRORS ["Bad request code"
  48                   "Parameter out of range"
  49                   "Parameter not a window"
  50                   "Parameter not a pixmap"
  51                   "Parameter not a bitmap"
  52                   "Parameter not a cursor"
  53                   "Parameter not a font"
  54                   "Parameter mismatch"
  55                   "Pixmap shape invalid for tiling"
  56                   "Mouse/button already grabbed"
  57                   "Access control violation"
  58                   "Insufficient resources"]>
  59
  60 ; "Event codes"
  61 <MSETG KEY-PRESSED 1>
  62 <MSETG KEY-RELEASED 2>
  63 <MSETG BUTTON-PRESSED 4>
  64 <MSETG BUTTON-RELEASED 8>
  65 <MSETG ENTER-WINDOW 16>
  66 <MSETG LEAVE-WINDOW 32>
  67 <MSETG MOUSE-MOVED 64>
  68 <MSETG EXPOSE-WINDOW 128>
  69 <MSETG EXPOSE-REGION 256>
  70 <MSETG EXPOSE-COPY 512>
  71 <MSETG RIGHT-DOWN-MOTION 1024>
  72 <MSETG MIDDLE-DOWN-MOTION 2048>
  73 <MSETG LEFT-DOWN-MOTION 4096>
  74 <MSETG UNMAP-WINDOW 8192>
  75 <MSETG MOTION-BITS <+ ,MOUSE-MOVED ,RIGHT-DOWN-MOTION ,MIDDLE-DOWN-MOTION
  76                       ,LEFT-DOWN-MOTION>>
  77 \f
  78 ; "Key shift codes"
  79
  80 <MSETG X-CONTROL-MASK <HEX "4000">>
  81 <MSETG X-META-MASK <HEX "2000">>
  82 <MSETG X-SHIFT-MASK <HEX "1000">>
  83 <MSETG X-SHIFT-LOCK-MASK <HEX "800">>
  84 <MSETG X-LEFT-MASK <HEX "400">>
  85 <MSETG X-MIDDLE-MASK <HEX "200">>
  86 <MSETG X-RIGHT-MASK <HEX "100">>
  87
  88 ; "There are three kinds of keys--shift keys, function keys, and normal keys.
  89 Shifts are shift, shift-lock, control, and symbol; function keys are everything
  90 off the main keypad."
  91 <MSETG KEY-MIN-SHIFT 174>
  92 <MSETG KEY-MAX-SHIFT 177>
  93
  94 <MSETG KEY-MIN-FCN 86>
  95 <MSETG KEY-MAX-FCN 170>
  96
  97 <MSETG KEY-MIN-NORM 188>
  98 <MSETG KEY-MAX-NORM 251>
  99 \f
 100
 101 <DEFINE DEFINE-BYTE (NAME WHICH "AUX" OFFS)
 102    <SET OFFS </ <+ .WHICH 3> 4>>
 103    <COND
 104     (<FEATURE? "COMPILER">
 105      <EVAL <FORM DEFMAC .NAME (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
 106                  <FORM COND
 107                        (<FORM ASSIGNED? NEW>
 108                         <FORM FORM
 109                               .OFFS
 110                               '.P
 111                               <FORM FORM PUTBITS
 112                                     <FORM FORM .OFFS '.P>
 113                                     <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>
 114                                     '.NEW>>)
 115                        (T
 116                         <FORM FORM GETBITS
 117                               <FORM FORM .OFFS '.P>
 118                               <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>>)>>>)
 119     (T
 120      <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW)
 121                     <FORM COND (<FORM ASSIGNED? NEW>
 122                                 <FORM .OFFS '.P
 123                                       <FORM PUTBITS <FORM .OFFS '.P>
 124                                             <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>
 125                                             '.NEW>>)
 126                           (T
 127                            <FORM GETBITS
 128                                  <FORM .OFFS '.P>
 129                                  <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>>)>>>)>>
 130
 131 <DEFINE DEFINE-WORD (NAME WHICH "OPTIONAL" (SIZE WORD)
 132                      "AUX" OFFS LEFT? (LONG? <>) (COMPILER? <>))
 133         #DECL ((NAME) ATOM (WHICH) FIX)
 134         <COND (<==? .SIZE WORD>
 135                <SET OFFS </ <+ .WHICH 1> 2>>
 136                <SET LEFT? <0? <MOD .WHICH 2>>>)
 137               (T
 138                <COND (<0? <MOD .WHICH 2>>
 139                       <ERROR LONG-WORD-STARTS-IN-LEFT-HALF .NAME
 140                              .WHICH DEFINE-WORD>)>
 141                <SET OFFS </ <+ .WHICH 1> 2>>
 142                <SET LONG? T>)>
 143         <COND
 144          (.LONG?
 145           <SETG .NAME <OFFSET .OFFS UVECTOR>>
 146           <MANIFEST .NAME>)
 147          (T
 148           <COND
 149            (<FEATURE? "COMPILER">
 150             <EVAL <FORM DEFMAC
 151                         .NAME
 152                         (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
 153                         <FORM COND
 154                               (<FORM ASSIGNED? NEW>
 155                                <FORM FORM
 156                                      .OFFS
 157                                      '.P
 158                                      <COND (.LEFT?
 159                                             <FORM FORM
 160                                                   PUTLHW
 161                                                   <FORM FORM .OFFS '.P>
 162                                                   '.NEW>)
 163                                            (T
 164                                             <FORM FORM
 165                                                   PUTRHW
 166                                                   <FORM FORM .OFFS '.P>
 167                                                   '.NEW>)>>)
 168                               (T
 169                                <FORM FORM
 170                                 BIND
 171                                 ((TEMP
 172                                   <COND (.LEFT?
 173                                          <FORM FORM LHW <FORM FORM .OFFS '.P>>)
 174                                         (T
 175                                          <FORM FORM RHW <FORM FORM .OFFS '.P>>)>))
 176                                 <FORM FORM COND (<FORM FORM 0?
 177                                                        <FORM FORM ANDB ''.TEMP
 178                                                                 *100000*>>
 179                                                  ''.TEMP)
 180                                       (T
 181                                        <FORM FORM PUTLHW ''.TEMP -1>)>>)>>>)
 182            (T
 183             <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW "AUX" TEMP)
 184                         <FORM COND (<FORM ASSIGNED? NEW>
 185                                     <FORM .OFFS '.P
 186                                           <COND (.LEFT?
 187                                                  <FORM PUTLHW <FORM .OFFS '.P>
 188                                                        '.NEW>)
 189                                                 (T
 190                                                  <FORM PUTRHW <FORM .OFFS '.P>
 191                                                        '.NEW>)>>)
 192                               (T
 193                                <FORM
 194                                 COND
 195                                  (<FORM
 196                                    NOT
 197                                    <FORM 0?
 198                                          <FORM
 199                                           ANDB
 200                                           <FORM
 201                                            SET TEMP
 202                                            <COND (.LEFT?
 203                                                   <FORM LHW <FORM .OFFS '.P>>)
 204                                                  (T
 205                                                   <FORM RHW <FORM .OFFS '.P>>)>>
 206                                           *100000*>>>
 207                                   <FORM PUTLHW '.TEMP -1>)
 208                                  (T '.TEMP)>)>>>)>)>>
 209
 210 <COND
 211  (<GASSIGNED? DEFINE-WORD>
 212   ; "Fields of input packet"
 213   <DEFINE-WORD I-LPAR0 3 LONG>
 214   <DEFINE-WORD I-LPAR1 5 LONG>
 215   <DEFINE-WORD I-LPAR2 7 LONG>
 216   <DEFINE-WORD I-LPAR3 9 LONG>
 217   <DEFINE-WORD I-LPAR4 11 LONG>
 218
 219   <DEFINE-WORD I-SPAR0 3>
 220   <DEFINE-WORD I-SPAR1 4>
 221   <DEFINE-WORD I-SPAR2 5>
 222   <DEFINE-WORD I-SPAR3 6>
 223   <DEFINE-WORD I-SPAR4 7>
 224   <DEFINE-WORD I-SPAR5 8>
 225   <DEFINE-WORD I-SPAR6 9>
 226   <DEFINE-WORD I-SPAR7 10>
 227   <DEFINE-WORD I-SPAR8 11>
 228   <DEFINE-WORD I-SPAR9 12>
 229
 230   <DEFINE-BYTE I-BPAR0 5>
 231   <DEFINE-BYTE I-BPAR1 6>
 232   <DEFINE-BYTE I-BPAR2 7>
 233   <DEFINE-BYTE I-BPAR3 8>
 234   <DEFINE-BYTE I-BPAR4 9>
 235   <DEFINE-BYTE I-BPAR5 10>
 236   <DEFINE-BYTE I-BPAR6 11>
 237   <DEFINE-BYTE I-BPAR7 12>
 238   <DEFINE-BYTE I-BPAR8 13>
 239   <DEFINE-BYTE I-BPAR9 14>
 240   <DEFINE-BYTE I-BPAR10 15>
 241   <DEFINE-BYTE I-BPAR11 16>
 242   <DEFINE-BYTE I-BPAR12 17>
 243   <DEFINE-BYTE I-BPAR13 18>
 244   <DEFINE-BYTE I-BPAR14 19>
 245   <DEFINE-BYTE I-BPAR15 20>
 246   <DEFINE-BYTE I-BPAR16 21>
 247   <DEFINE-BYTE I-BPAR17 22>
 248   <DEFINE-BYTE I-BPAR18 23>
 249   <DEFINE-BYTE I-BPAR19 24>
 250
 251   <MSETG VSERR-REQNUM ,I-LPAR0>
 252   <MSETG VSERR-ERRCODE ,I-BPAR4>
 253   <MSETG VSERR-REQCODE ,I-BPAR5>
 254   <MSETG VSERR-REQFUNC ,I-BPAR6>
 255   <MSETG VSERR-WINDOW ,I-LPAR2>
 256
 257   <DEFINE-WORD VSI-CODE 1 LONG>
 258   <MSETG VSI-WINDOW ,I-LPAR0>
 259   <MSETG VSI-TIME ,I-SPAR2>
 260   <SETG VSI-DETAIL ,I-SPAR3>
 261   <SETG VSI-X ,I-SPAR4>
 262   <SETG VSI-Y ,I-SPAR5>
 263   <MSETG VSI-SUBWINDOW ,I-LPAR3>
 264   <MSETG VSI-LOC ,I-LPAR4>
 265   <SETG VSI-TOP ,I-SPAR8>
 266   <SETG VSI-LEFT ,I-SPAR9>
 267
 268   <SETG I-ERRCODE ,I-BPAR4>
 269
 270   ; "Fields of output packet"
 271   <DEFINE-BYTE O-CODE 1>
 272   <DEFINE-BYTE O-FCN 2>
 273   <DEFINE-WORD O-FUNC&CODE 1>
 274   <DEFINE-WORD O-MASK 2>
 275   <DEFINE-WORD O-FUNC-CODE-MASK 1 LONG>
 276   <DEFINE-WORD O-WINDOW 3 LONG>
 277
 278   <DEFINE-BYTE O-BPAR0 9>
 279   <DEFINE-BYTE O-BPAR1 10>
 280   <DEFINE-BYTE O-BPAR2 11>
 281   <DEFINE-BYTE O-BPAR3 12>
 282   <DEFINE-BYTE O-BPAR4 13>
 283   <DEFINE-BYTE O-BPAR5 14>
 284   <DEFINE-BYTE O-BPAR6 15>
 285   <DEFINE-BYTE O-BPAR7 16>
 286   <DEFINE-BYTE O-BPAR8 17>
 287   <DEFINE-BYTE O-BPAR9 18>
 288   <DEFINE-BYTE O-BPAR10 19>
 289   <DEFINE-BYTE O-BPAR11 20>
 290   <DEFINE-BYTE O-BPAR12 21>
 291   <DEFINE-BYTE O-BPAR13 22>
 292   <DEFINE-BYTE O-BPAR14 23>
 293   <DEFINE-BYTE O-BPAR15 24>
 294
 295   <DEFINE-WORD O-SPAR0 5>
 296   <DEFINE-WORD O-SPAR1 6>
 297   <DEFINE-WORD O-SPAR2 7>
 298   <DEFINE-WORD O-SPAR3 8>
 299   <DEFINE-WORD O-SPAR4 9>
 300   <DEFINE-WORD O-SPAR5 10>
 301   <DEFINE-WORD O-SPAR6 11>
 302   <DEFINE-WORD O-SPAR7 12>
 303
 304   <DEFINE-WORD O-LPAR0 5 LONG>
 305   <DEFINE-WORD O-LPAR1 7 LONG>
 306   <DEFINE-WORD O-LPAR2 9 LONG>
 307   <DEFINE-WORD O-LPAR3 11 LONG>)>
 308 \f
 309 <MSETG VWM-PAGE 1>
 310 <MSETG VWM-WRAP 2>
 311 <MSETG VWM-ITS 4>
 312 <MSETG VWM-UNSEEN 8>
 313 <MSETG VWM-CURSOR 16>
 314 <MSETG VWM-DEFAULT <+ ,VWM-PAGE ,VWM-WRAP ,VWM-ITS ,VWM-CURSOR>>
 315 <MSETG VWM-INVERT 32>
 316 <MSETG VWM-UNDER 64>
 317 <DEFMAC TEST-VW-MODE ('MODE "ARGS" STUFF)
 318    <FORM NOT <FORM 0? <FORM ANDB .MODE !.STUFF>>>>
 319 \f
 320 <DEFMAC UPDATE-MC ('CH 'X "OPTIONAL" 'Y "AUX" (L ()))
 321   <COND (<AND <ASSIGNED? X> .X <OR <NOT <STRUCTURED? .X>>
 322                                    <NOT <EMPTY? .X>>>>
 323          <SET L (<COND (<TYPE? .X LIST>
 324                         <FORM MC-HPOS '.SU <FORM + <FORM MC-HPOS '.SU>
 325                                                    <1 .X>>>)
 326                        (<FORM MC-HPOS '.SU .X>)>)>)>
 327   <COND (<AND <ASSIGNED? Y> .Y <OR <NOT <STRUCTURED? .Y>>
 328                                    <NOT <EMPTY? .Y>>>>
 329          <SET L (<COND (<TYPE? .Y LIST>
 330                         <FORM MC-VPOS '.SU <FORM + <FORM MC-VPOS '.SU>
 331                                                    <1 .Y>>>)
 332                        (<FORM MC-VPOS '.SU .Y>)> !.L)>)>
 333   <COND (<NOT <EMPTY? .L>>
 334          <FORM BIND ((SU <FORM CHANNEL-USER .CH>))
 335                <FORM COND (<FORM TYPE? '.SU MUD-CHAN> !.L)>>)>>
 336
 337 <END-DEFINITIONS>