--- /dev/null
+<DEFINITIONS "VSDEFS">
+
+<INCLUDE "VSTYPES">
+
+<USE "NEWSTRUC">
+
+<EVAL-WHEN ("SUBSYSTEM" "MIMC") <L-FLOAD "UMC-DEFS.MUD">>
+
+<MSETG X-DEFAULT-KEYMAP "VSKEYMAP">
+
+<REPEAT (INCHAN VECTOR NM2 FIX (STRING '["NORMAL" X-NORMAL-KEYMAP
+ "FUNCTION" X-FUNCTION-KEYMAP]))
+ <SET NM2 <1 .STRING>>
+ <COND (<SET INCHAN <GEN-OPEN ,X-DEFAULT-KEYMAP "READ" "BINARY" DISK>>
+ <SET VECTOR <IVECTOR <CHANNEL-OP .INCHAN READ-BYTE> <>>>
+ <SET FIX <CHANNEL-OP .INCHAN READ-BYTE>>
+ <REPEAT ((UVECTOR <STACK <IUVECTOR 6>>))
+ <COND (<0? <CHANNEL-OP .INCHAN READ-BUFFER .UVECTOR>>
+ <RETURN>)>
+ <PUT .VECTOR <- <1 .UVECTOR> .FIX -1>
+ <CHTYPE <SUBSTRUC .UVECTOR 1 5> KEY>>>
+ <CLOSE .INCHAN>
+ <MSETG <2 .STRING> [.FIX .VECTOR]>)
+ (T
+ <MSETG <2 .STRING> <>>)>
+ <COND (<EMPTY? <SET STRING <REST .STRING 2>>>
+ <RETURN>)>>
+
+; "Input packet types"
+<MSETG X-ERROR -1>
+<MSETG X-REPLY 0>
+
+; "Error codes"
+<MSETG X-UNKNOWN-REQUEST 1>
+<MSETG X-BAD-VALUE 2>
+<MSETG X-NO-SUCH-WINDOW 3>
+<MSETG X-BAD-PIXMAP 4>
+<MSETG X-BAD-BITMAP 5>
+<MSETG X-BAD-CURSOR 6>
+<MSETG X-BAD-FONT 7>
+<MSETG X-BAD-MATCH 8>
+<MSETG X-BAD-TILE 9>
+<MSETG X-ALREADY-GRABBED 10>
+<MSETG X-BAD-ACCESS 11>
+<MSETG X-BAD-ALLOC 12>
+
+<MSETG VS-ERRORS ["Bad request code"
+ "Parameter out of range"
+ "Parameter not a window"
+ "Parameter not a pixmap"
+ "Parameter not a bitmap"
+ "Parameter not a cursor"
+ "Parameter not a font"
+ "Parameter mismatch"
+ "Pixmap shape invalid for tiling"
+ "Mouse/button already grabbed"
+ "Access control violation"
+ "Insufficient resources"]>
+
+; "Event codes"
+<MSETG KEY-PRESSED 1>
+<MSETG KEY-RELEASED 2>
+<MSETG BUTTON-PRESSED 4>
+<MSETG BUTTON-RELEASED 8>
+<MSETG ENTER-WINDOW 16>
+<MSETG LEAVE-WINDOW 32>
+<MSETG MOUSE-MOVED 64>
+<MSETG EXPOSE-WINDOW 128>
+<MSETG EXPOSE-REGION 256>
+<MSETG EXPOSE-COPY 512>
+<MSETG RIGHT-DOWN-MOTION 1024>
+<MSETG MIDDLE-DOWN-MOTION 2048>
+<MSETG LEFT-DOWN-MOTION 4096>
+<MSETG UNMAP-WINDOW 8192>
+<MSETG MOTION-BITS <+ ,MOUSE-MOVED ,RIGHT-DOWN-MOTION ,MIDDLE-DOWN-MOTION
+ ,LEFT-DOWN-MOTION>>
+\f
+; "Key shift codes"
+
+<MSETG X-CONTROL-MASK <HEX "4000">>
+<MSETG X-META-MASK <HEX "2000">>
+<MSETG X-SHIFT-MASK <HEX "1000">>
+<MSETG X-SHIFT-LOCK-MASK <HEX "800">>
+<MSETG X-LEFT-MASK <HEX "400">>
+<MSETG X-MIDDLE-MASK <HEX "200">>
+<MSETG X-RIGHT-MASK <HEX "100">>
+
+; "There are three kinds of keys--shift keys, function keys, and normal keys.
+Shifts are shift, shift-lock, control, and symbol; function keys are everything
+off the main keypad."
+<MSETG KEY-MIN-SHIFT 174>
+<MSETG KEY-MAX-SHIFT 177>
+
+<MSETG KEY-MIN-FCN 86>
+<MSETG KEY-MAX-FCN 170>
+
+<MSETG KEY-MIN-NORM 188>
+<MSETG KEY-MAX-NORM 251>
+\f
+
+<DEFINE DEFINE-BYTE (NAME WHICH "AUX" OFFS)
+ <SET OFFS </ <+ .WHICH 3> 4>>
+ <COND
+ (<FEATURE? "COMPILER">
+ <EVAL <FORM DEFMAC .NAME (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
+ <FORM COND
+ (<FORM ASSIGNED? NEW>
+ <FORM FORM
+ .OFFS
+ '.P
+ <FORM FORM PUTBITS
+ <FORM FORM .OFFS '.P>
+ <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>
+ '.NEW>>)
+ (T
+ <FORM FORM GETBITS
+ <FORM FORM .OFFS '.P>
+ <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>>)>>>)
+ (T
+ <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW)
+ <FORM COND (<FORM ASSIGNED? NEW>
+ <FORM .OFFS '.P
+ <FORM PUTBITS <FORM .OFFS '.P>
+ <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>
+ '.NEW>>)
+ (T
+ <FORM GETBITS
+ <FORM .OFFS '.P>
+ <BITS 8 <* <MOD <- .WHICH 1> 4> 8>>>)>>>)>>
+
+<DEFINE DEFINE-WORD (NAME WHICH "OPTIONAL" (SIZE WORD)
+ "AUX" OFFS LEFT? (LONG? <>) (COMPILER? <>))
+ #DECL ((NAME) ATOM (WHICH) FIX)
+ <COND (<==? .SIZE WORD>
+ <SET OFFS </ <+ .WHICH 1> 2>>
+ <SET LEFT? <0? <MOD .WHICH 2>>>)
+ (T
+ <COND (<0? <MOD .WHICH 2>>
+ <ERROR LONG-WORD-STARTS-IN-LEFT-HALF .NAME
+ .WHICH DEFINE-WORD>)>
+ <SET OFFS </ <+ .WHICH 1> 2>>
+ <SET LONG? T>)>
+ <COND
+ (.LONG?
+ <SETG .NAME <OFFSET .OFFS UVECTOR>>
+ <MANIFEST .NAME>)
+ (T
+ <COND
+ (<FEATURE? "COMPILER">
+ <EVAL <FORM DEFMAC
+ .NAME
+ (<FORM QUOTE P> "OPTIONAL" <FORM QUOTE NEW>)
+ <FORM COND
+ (<FORM ASSIGNED? NEW>
+ <FORM FORM
+ .OFFS
+ '.P
+ <COND (.LEFT?
+ <FORM FORM
+ PUTLHW
+ <FORM FORM .OFFS '.P>
+ '.NEW>)
+ (T
+ <FORM FORM
+ PUTRHW
+ <FORM FORM .OFFS '.P>
+ '.NEW>)>>)
+ (T
+ <FORM FORM
+ BIND
+ ((TEMP
+ <COND (.LEFT?
+ <FORM FORM LHW <FORM FORM .OFFS '.P>>)
+ (T
+ <FORM FORM RHW <FORM FORM .OFFS '.P>>)>))
+ <FORM FORM COND (<FORM FORM 0?
+ <FORM FORM ANDB ''.TEMP
+ *100000*>>
+ ''.TEMP)
+ (T
+ <FORM FORM PUTLHW ''.TEMP -1>)>>)>>>)
+ (T
+ <EVAL <FORM DEFINE .NAME (P "OPTIONAL" NEW "AUX" TEMP)
+ <FORM COND (<FORM ASSIGNED? NEW>
+ <FORM .OFFS '.P
+ <COND (.LEFT?
+ <FORM PUTLHW <FORM .OFFS '.P>
+ '.NEW>)
+ (T
+ <FORM PUTRHW <FORM .OFFS '.P>
+ '.NEW>)>>)
+ (T
+ <FORM
+ COND
+ (<FORM
+ NOT
+ <FORM 0?
+ <FORM
+ ANDB
+ <FORM
+ SET TEMP
+ <COND (.LEFT?
+ <FORM LHW <FORM .OFFS '.P>>)
+ (T
+ <FORM RHW <FORM .OFFS '.P>>)>>
+ *100000*>>>
+ <FORM PUTLHW '.TEMP -1>)
+ (T '.TEMP)>)>>>)>)>>
+
+<COND
+ (<GASSIGNED? DEFINE-WORD>
+ ; "Fields of input packet"
+ <DEFINE-WORD I-LPAR0 3 LONG>
+ <DEFINE-WORD I-LPAR1 5 LONG>
+ <DEFINE-WORD I-LPAR2 7 LONG>
+ <DEFINE-WORD I-LPAR3 9 LONG>
+ <DEFINE-WORD I-LPAR4 11 LONG>
+
+ <DEFINE-WORD I-SPAR0 3>
+ <DEFINE-WORD I-SPAR1 4>
+ <DEFINE-WORD I-SPAR2 5>
+ <DEFINE-WORD I-SPAR3 6>
+ <DEFINE-WORD I-SPAR4 7>
+ <DEFINE-WORD I-SPAR5 8>
+ <DEFINE-WORD I-SPAR6 9>
+ <DEFINE-WORD I-SPAR7 10>
+ <DEFINE-WORD I-SPAR8 11>
+ <DEFINE-WORD I-SPAR9 12>
+
+ <DEFINE-BYTE I-BPAR0 5>
+ <DEFINE-BYTE I-BPAR1 6>
+ <DEFINE-BYTE I-BPAR2 7>
+ <DEFINE-BYTE I-BPAR3 8>
+ <DEFINE-BYTE I-BPAR4 9>
+ <DEFINE-BYTE I-BPAR5 10>
+ <DEFINE-BYTE I-BPAR6 11>
+ <DEFINE-BYTE I-BPAR7 12>
+ <DEFINE-BYTE I-BPAR8 13>
+ <DEFINE-BYTE I-BPAR9 14>
+ <DEFINE-BYTE I-BPAR10 15>
+ <DEFINE-BYTE I-BPAR11 16>
+ <DEFINE-BYTE I-BPAR12 17>
+ <DEFINE-BYTE I-BPAR13 18>
+ <DEFINE-BYTE I-BPAR14 19>
+ <DEFINE-BYTE I-BPAR15 20>
+ <DEFINE-BYTE I-BPAR16 21>
+ <DEFINE-BYTE I-BPAR17 22>
+ <DEFINE-BYTE I-BPAR18 23>
+ <DEFINE-BYTE I-BPAR19 24>
+
+ <MSETG VSERR-REQNUM ,I-LPAR0>
+ <MSETG VSERR-ERRCODE ,I-BPAR4>
+ <MSETG VSERR-REQCODE ,I-BPAR5>
+ <MSETG VSERR-REQFUNC ,I-BPAR6>
+ <MSETG VSERR-WINDOW ,I-LPAR2>
+
+ <DEFINE-WORD VSI-CODE 1 LONG>
+ <MSETG VSI-WINDOW ,I-LPAR0>
+ <MSETG VSI-TIME ,I-SPAR2>
+ <SETG VSI-DETAIL ,I-SPAR3>
+ <SETG VSI-X ,I-SPAR4>
+ <SETG VSI-Y ,I-SPAR5>
+ <MSETG VSI-SUBWINDOW ,I-LPAR3>
+ <MSETG VSI-LOC ,I-LPAR4>
+ <SETG VSI-TOP ,I-SPAR8>
+ <SETG VSI-LEFT ,I-SPAR9>
+
+ <SETG I-ERRCODE ,I-BPAR4>
+
+ ; "Fields of output packet"
+ <DEFINE-BYTE O-CODE 1>
+ <DEFINE-BYTE O-FCN 2>
+ <DEFINE-WORD O-FUNC&CODE 1>
+ <DEFINE-WORD O-MASK 2>
+ <DEFINE-WORD O-FUNC-CODE-MASK 1 LONG>
+ <DEFINE-WORD O-WINDOW 3 LONG>
+
+ <DEFINE-BYTE O-BPAR0 9>
+ <DEFINE-BYTE O-BPAR1 10>
+ <DEFINE-BYTE O-BPAR2 11>
+ <DEFINE-BYTE O-BPAR3 12>
+ <DEFINE-BYTE O-BPAR4 13>
+ <DEFINE-BYTE O-BPAR5 14>
+ <DEFINE-BYTE O-BPAR6 15>
+ <DEFINE-BYTE O-BPAR7 16>
+ <DEFINE-BYTE O-BPAR8 17>
+ <DEFINE-BYTE O-BPAR9 18>
+ <DEFINE-BYTE O-BPAR10 19>
+ <DEFINE-BYTE O-BPAR11 20>
+ <DEFINE-BYTE O-BPAR12 21>
+ <DEFINE-BYTE O-BPAR13 22>
+ <DEFINE-BYTE O-BPAR14 23>
+ <DEFINE-BYTE O-BPAR15 24>
+
+ <DEFINE-WORD O-SPAR0 5>
+ <DEFINE-WORD O-SPAR1 6>
+ <DEFINE-WORD O-SPAR2 7>
+ <DEFINE-WORD O-SPAR3 8>
+ <DEFINE-WORD O-SPAR4 9>
+ <DEFINE-WORD O-SPAR5 10>
+ <DEFINE-WORD O-SPAR6 11>
+ <DEFINE-WORD O-SPAR7 12>
+
+ <DEFINE-WORD O-LPAR0 5 LONG>
+ <DEFINE-WORD O-LPAR1 7 LONG>
+ <DEFINE-WORD O-LPAR2 9 LONG>
+ <DEFINE-WORD O-LPAR3 11 LONG>)>
+\f
+<MSETG VWM-PAGE 1>
+<MSETG VWM-WRAP 2>
+<MSETG VWM-ITS 4>
+<MSETG VWM-UNSEEN 8>
+<MSETG VWM-CURSOR 16>
+<MSETG VWM-DEFAULT <+ ,VWM-PAGE ,VWM-WRAP ,VWM-ITS ,VWM-CURSOR>>
+<MSETG VWM-INVERT 32>
+<MSETG VWM-UNDER 64>
+<DEFMAC TEST-VW-MODE ('MODE "ARGS" STUFF)
+ <FORM NOT <FORM 0? <FORM ANDB .MODE !.STUFF>>>>
+\f
+<DEFMAC UPDATE-MC ('CH 'X "OPTIONAL" 'Y "AUX" (L ()))
+ <COND (<AND <ASSIGNED? X> .X <OR <NOT <STRUCTURED? .X>>
+ <NOT <EMPTY? .X>>>>
+ <SET L (<COND (<TYPE? .X LIST>
+ <FORM MC-HPOS '.SU <FORM + <FORM MC-HPOS '.SU>
+ <1 .X>>>)
+ (<FORM MC-HPOS '.SU .X>)>)>)>
+ <COND (<AND <ASSIGNED? Y> .Y <OR <NOT <STRUCTURED? .Y>>
+ <NOT <EMPTY? .Y>>>>
+ <SET L (<COND (<TYPE? .Y LIST>
+ <FORM MC-VPOS '.SU <FORM + <FORM MC-VPOS '.SU>
+ <1 .Y>>>)
+ (<FORM MC-VPOS '.SU .Y>)> !.L)>)>
+ <COND (<NOT <EMPTY? .L>>
+ <FORM BIND ((SU <FORM CHANNEL-USER .CH>))
+ <FORM COND (<FORM TYPE? '.SU MUD-CHAN> !.L)>>)>>
+
+<END-DEFINITIONS>
projects / pdp10-muddle.git / blobdiff