--- /dev/null
+
+<PACKAGE "VS100">
+
+<ENTRY VS100
+ BLACK WHITE GRAY WINDOW-BITS
+ VS100-DIRECTORY
+ CHANGE-COLOR CURRENT-FONT LINE-HEIGHT CHAR-WIDTH SET-FONT
+ MAP UNMAP CURRENT-FONT
+ HOR-POS-ABS VER-POS-ABS
+ TEXT-CURSOR MOUSE-CURSOR
+ MAKE-MENU-WINDOW
+ WRITE-TO-MENU-WINDOW
+ INVERT-MENU-WINDOW
+ CLEAR-MENU-WINDOW
+ SELECT-MENU-WINDOW
+ BIT-BLT
+ DEFINE-PATTERN
+ SET-HIGHLIGHT
+ PAGE-TOP
+ PAGE-LEFT
+ FREE-PATTERN
+ INITIAL-FONT
+ INITIAL-BORDER
+ INITIAL-BACKGROUND
+ INITIAL-MOUSE-CURSOR
+ INITIAL-TEXT-CURSOR
+ LOAD-KEYMAPS
+ MOUSE-MOVE?
+ WARP-MOUSE
+ DRAW
+ DRAW-FILLED
+ DRAW-DASHED
+ DRAW-LINE
+ MOUSE-MOVE-WINDOW
+ MOUSE-RESIZE-WINDOW
+ MOUSE-OPEN-WINDOW
+ MAKE-TEMP-WINDOW
+ BUFTREE
+ MOVE-CURSOR-ABS
+ RECYCLE-EVENTS
+ PAGE-X-ABS
+ PAGE-Y-ABS
+ PAGE-WIDTH-ABS
+ PAGE-HEIGHT-ABS
+ MOVE-WINDOW
+ RESIZE
+ WINDOW-NAME
+ CLEAR-REGION
+ FILL-REGION
+ CUT-BUFFER
+ WINDOW-PARENT
+ WINDOW-CHILDREN
+ WINDOW-FUNCTION
+ DRAW-LEFT
+ DRAW-TOP
+ DRAW-WIDTH
+ DRAW-HEIGHT
+ INTERPRET-LOCATOR
+ DISPLAY-CURSOR
+ QUERY-MOUSE
+ RAISE-WINDOW
+ LOWER-WINDOW
+ CIRC-WINDOW
+ SCALED-TO-ABSOLUTE
+ ABSOLUTE-TO-SCALED
+ MOUSE-LOWER-WINDOW
+ ICONIFY
+ ICON?
+ ICONIFIED?
+ DE-ICONIFY
+ INVERT-ICON
+ KILL-SUBWINDOWS
+ SET-RESIZE-HINT
+ INVERSE-VIDEO
+ UNDERLINE>
+
+<USE "NETBASE" "NEWSTRUC" "HOSTS" "VSBASE">
+
+<EXPORT "TTY">
+
+<INCLUDE "VSTYPES" "VSUTYPES">
+
+<INCLUDE-WHEN <COMPILING? "VS100"> "NETDEFS" "VSDEFS" "VSOPS" "VSUDEFS">
+
+<NEW-CHANNEL-TYPE VS100 <>
+ OPEN VS-OPEN
+ CLOSE VS-CLOSE
+ READ-BYTE-IMMEDIATE VS-READ-IMMEDIATE
+ WRITE-BUFFER VS-NORMAL-OUT
+ IMAGE-OUT VS-IMAGE-OUT
+ CHANGE-COLOR VS-CHANGE-COLOR
+ CLEAR-EOL VS-CLEAR-EOL
+ MAP VS-MAP
+ UNMAP VS-UNMAP
+ SET-FONT VS-SET-FONT
+ BUFOUT VS-BUFOUT
+ BUFTREE VS-BUFTREE
+ CURRENT-FONT VS-SET-FONT
+ CLEAR-EOS VS-CLEAR-EOS
+ CLEAR-SCREEN VS-CLEAR-SCREEN
+ DOWN-CURSOR VS-DOWN-CURSOR
+ UP-CURSOR VS-UP-CURSOR
+ FORWARD-CURSOR VS-FORWARD-CURSOR
+ BACK-CURSOR VS-BACK-CURSOR
+ MOVE-CURSOR VS-MOVE-CURSOR
+ MOVE-CURSOR-ABS VS-MOVE-CURSOR-ABS
+ HOME-CURSOR VS-HOME-CURSOR
+ BOTTOM-CURSOR VS-BOTTOM-CURSOR
+ HOR-POS-CURSOR VS-HOR-POS
+ VER-POS-CURSOR VS-VER-POS
+ HOR-POS-ABS VS-HOR-POS-ABS
+ VER-POS-ABS VS-VER-POS-ABS
+ TEXT-CURSOR VS-TEXT-CURSOR
+ MOUSE-CURSOR VS-MOUSE-CURSOR
+ FRESH-LINE VS-FRESH-LINE
+ MAKE-MENU-WINDOW VS-MENU-WINDOW
+ WRITE-TO-MENU-WINDOW VS-WRITE-TO-MENU
+ INVERT-MENU-WINDOW VS-INVERT-MENU
+ CLEAR-MENU-WINDOW VS-CLEAR-MENU-WINDOW
+ SELECT-MENU-WINDOW VS-SELECT-MENU-WINDOW
+ BIT-BLT VS-BIT-BLT
+ INSERT-LINE VS-INSERT-LINE
+ INSERT-CHAR VS-INSERT-CHAR
+ ERASE-CHAR VS-ERASE-CHAR
+ KILL-CHAR VS-KILL-CHAR
+ DEFINE-PATTERN DEFINE-PATTERN
+ SET-HIGHLIGHT VS-SET-HIGHLIGHT
+ LOAD-KEYMAPS VS-LOAD-KEYMAPS
+ MOUSE-MOVE? VS-MOUSE-MOVE?
+ WARP-MOUSE VS-WARP-MOUSE
+ DRAW VS-DRAW
+ DRAW-DASHED VS-DRAW-DASHED
+ DRAW-FILLED VS-DRAW-FILLED
+ DRAW-LINE VS-DRAW-LINE
+ MOUSE-MOVE-WINDOW MOUSE-MOVE-WINDOW
+ MOUSE-RESIZE-WINDOW MOUSE-RESIZE-WINDOW
+ MOUSE-OPEN-WINDOW MOUSE-OPEN-WINDOW
+ MAKE-TEMP-WINDOW MAKE-TEMP-WINDOW
+ PAGE-X VS-HOR-POS
+ PAGE-X-ABS VS-HOR-POS-ABS
+ PAGE-Y VS-VER-POS
+ PAGE-Y-ABS VS-VER-POS-ABS
+ PAGE-HEIGHT VS-PAGE-HEIGHT
+ PAGE-WIDTH VS-PAGE-WIDTH
+ PAGE-TOP PAGE-LOC
+ PAGE-LEFT PAGE-LOC
+ PAGE-HEIGHT-ABS VS-PAGE-HEIGHT-ABS
+ PAGE-WIDTH-ABS VS-PAGE-WIDTH-ABS
+ RESIZE VS-RESIZE
+ MOVE-WINDOW VS-MOVE-WINDOW
+ WINDOW-NAME VS-WINDOW-NAME
+ CLEAR-REGION VS-CLEAR-REGION
+ FILL-REGION VS-FILL-REGION
+ FREE-PATTERN FREE-PATTERN
+ LINE-HEIGHT VS-LINE-HEIGHT
+ CHAR-WIDTH VS-CHAR-WIDTH
+ CUT-BUFFER VS-CUT-BUFFER
+ WINDOW-PARENT WINDOW-PARENT
+ WINDOW-CHILDREN WINDOW-CHILDREN
+ TYPE-AHEAD? VS100-TYPE-AHEAD?
+ WINDOW-FUNCTION VS-WINDOW-FUNCTION
+ DRAW-LEFT VS-SCALE
+ DRAW-TOP VS-SCALE
+ DRAW-WIDTH VS-SCALE
+ DRAW-HEIGHT VS-SCALE
+ INTERPRET-LOCATOR INTERPRET-LOCATOR
+ DISPLAY-CURSOR VS-DISPLAY-CURSOR
+ QUERY-MOUSE VS-QUERY-MOUSE
+ RAISE-WINDOW RAISE-WINDOW
+ LOWER-WINDOW LOWER-WINDOW
+ CIRC-WINDOW CIRC-WINDOW
+ SCALED-TO-ABSOLUTE SCALED-TO-ABSOLUTE
+ ABSOLUTE-TO-SCALED ABSOLUTE-TO-SCALED
+ ICON? ICON?
+ ICONIFIED? ICONIFIED?
+ ICONIFY ICONIFY
+ DE-ICONIFY DE-ICONIFY
+ MOUSE-LOWER-WINDOW MOUSE-LOWER-WINDOW
+ KILL-SUBWINDOWS KILL-SUBWINDOWS
+ REDISPLAY-ICON REDISPLAY-ICON
+ INVERT-ICON INVERT-ICON
+ SET-RESIZE-HINT SET-RESIZE-HINT
+ WINDOW-BITS WINDOW-BITS
+ INVERSE-VIDEO INVERSE-VIDEO
+ UNDERLINE UNDERLINE>
+
+<GDECL (VS100-LIST)
+ <LIST [REST VS]>
+ (INITIAL-FONT)
+ STRING
+ (INITIAL-BORDER INITIAL-BACKGROUND)
+ <OR FIX ATOM>
+ (INITIAL-TEXT-CURSOR)
+ <OR ATOM FALSE VECTOR CURSOR>
+ (VS100-DIRECTORY) <OR STRING FALSE>
+ (INITIAL-MOUSE-CURSOR)
+ <OR ATOM FALSE VECTOR CURSOR>>
+
+<SETG INITIAL-BORDER BLACK>
+
+<SETG INITIAL-BACKGROUND WHITE>
+
+<SETG INITIAL-FONT "8X13">
+
+<SETG INITIAL-TEXT-CURSOR T>
+
+<SETG VS100-DIRECTORY <>>
+
+<DEFINE RAISE-WINDOW (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VSOP <VW-VS100 .VW> X-RAISE-WINDOW <VW-ID .VW>>>
+
+<DEFINE LOWER-WINDOW (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VSOP <VW-VS100 .VW> X-LOWER-WINDOW <VW-ID .VW>>>
+
+<DEFINE CIRC-WINDOW (CHN:VSCHAN OPER "OPT" (UP? T)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (.UP?
+ <VSOP <VW-VS100 .VW> X-CIRC-WINDOW-UP <VW-ID .VW>>)
+ (T
+ <VSOP <VW-VS100 .VW> X-CIRC-WINDOW-DOWN <VW-ID .VW>>)>>
+
+<DEFINE VS100-TYPE-AHEAD? (CHN:VSCHAN OPER)
+ <ANY-INPUT? <VW-VS100 <CHANNEL-DATA .CHN>:VSW>>>
+
+<DEFINE SCALED-TO-ABSOLUTE (CHN:VSCHAN OPER:ATOM FIRST:<OR FIX FLOAT VECTOR>
+ "OPT" (SECOND:<OR FIX FLOAT FALSE> <>)
+ (REL?:<OR ATOM FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (SC:<OR SCALE FALSE> <VW-SCALE .VW>))
+ <COND (<NOT <TYPE? .FIRST VECTOR>>
+ <SET FIRST
+ <VECTOR .FIRST
+ <COND (<NOT .SECOND>
+ <CHANNEL-OP .CHN DRAW-TOP>)
+ (T .SECOND)>>>)>
+ <SCALE-POINT .FIRST .VW .REL?>
+ .FIRST>
+
+<DEFINE ABSOLUTE-TO-SCALED (CHN:VSCHAN OPER:ATOM FIRST:<OR FIX VECTOR>
+ "OPT" (SECOND:<OR FIX FALSE> <>)
+ (REL?:<OR ATOM FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (SC:<OR SCALE FALSE> <VW-SCALE .VW>)
+ NUM:FLOAT)
+ <COND (<NOT <TYPE? .FIRST VECTOR>>
+ <SET FIRST
+ <VECTOR .FIRST
+ <COND (<ASSIGNED? SECOND> .SECOND) (T 0)>>>)>
+ <COND (<NOT .SC> .FIRST)
+ (T
+ <1 .FIRST
+ <+ </ <SET NUM <FLOAT <1 .FIRST>>> <S-WSCALE .SC>>
+ <COND (<NOT .REL?> <S-LEFT .SC>) (T 0.0)>>>
+ <2 .FIRST
+ <+ </ <SET NUM <FLOAT <2 .FIRST>>> <S-HSCALE .SC>>
+ <COND (.REL? 0.0)(T <S-TOP .SC>)>>>)>
+ .FIRST>
+
+<DEFINE VS-SCALE (CHN:VSCHAN OPER:ATOM
+ "OPT" FROB:<OR FIX FLOAT FALSE>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (SC:<OR SCALE FALSE> <VW-SCALE .VW>) (OLD <>)
+ TEMP:<OR FLOAT FALSE>)
+ <COND (.SC
+ <SET OLD
+ <COND (<==? .OPER DRAW-LEFT>
+ <COND (<==? <SET OLD <S-LEFT .SC>> 0.0> <>) (T .OLD)>)
+ (<==? .OPER DRAW-TOP>
+ <COND (<==? <SET OLD <S-TOP .SC>> 0.0> <>) (T .OLD)>)
+ (<==? .OPER DRAW-HEIGHT> <S-HEIGHT .SC>)
+ (<==? .OPER DRAW-WIDTH> <S-WIDTH .SC>)>>)>
+ <COND (<ASSIGNED? FROB>
+ <COND (<NOT .SC>
+ <SET SC <CHTYPE [0.0 0.0 <> <> 1.0 1.0] SCALE>>
+ <VW-SCALE .VW .SC>)>
+ <COND (<TYPE? .FROB FIX> <SET FROB <FLOAT .FROB>>)>
+ <COND (<==? .OPER DRAW-LEFT>
+ <COND (<NOT .FROB> <S-LEFT .SC 0.0>) (T <S-LEFT .SC .FROB>)>)
+ (<==? .OPER DRAW-TOP>
+ <COND (<NOT .FROB> <S-TOP .SC 0.0>) (T <S-TOP .SC .FROB>)>)
+ (<==? .OPER DRAW-WIDTH> <S-WIDTH .SC .FROB>)
+ (<==? .OPER DRAW-HEIGHT> <S-HEIGHT .SC .FROB>)>
+ <COND (<AND <NOT <S-HEIGHT .SC>>
+ <NOT <S-WIDTH .SC>>
+ <==? <S-TOP .SC> 0.0>
+ <==? <S-LEFT .SC> 0.0>>
+ <VW-SCALE .VW <>>)
+ (T
+ <COND (<NOT <SET TEMP <S-WIDTH .SC>>> <S-WSCALE .SC 1.0>)
+ (T <S-WSCALE .SC </ <FLOAT <VW-WIDTH .VW>> .TEMP>>)>
+ <COND (<NOT <SET TEMP <S-HEIGHT .SC>>> <S-HSCALE .SC 1.0>)
+ (T
+ <S-HSCALE .SC </ <FLOAT <VW-HEIGHT .VW>> .TEMP>>)>)>)>
+ .OLD>
+
+<DEFINE VS-QUERY-MOUSE (CHN:VSCHAN OPER UV:<UVECTOR [2 FIX]>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P)
+ <COND (<SET P <VSOP <VW-VS100 .VW> X-QUERY-MOUSE <VW-ID .VW>>>
+ <1 .UV <I-SPAR2 .P>>
+ <2 .UV <I-SPAR3 .P>>)>>
+
+<DEFINE INTERPRET-LOCATOR (CHN:VSCHAN OPER LOC:FIX UV:<UVECTOR [2 FIX]>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P)
+ <COND (<SET P
+ <VSOP <VW-VS100 .VW> X-INTERPRET-LOCATOR <VW-ID .VW> .LOC>>
+ <1 .UV <I-SPAR2 .P>>
+ <2 .UV <I-SPAR3 .P>>
+ .UV)>>
+
+<DEFINE VS-WINDOW-FUNCTION (CHN:VSCHAN OPER
+ "OPT" FROB:<OR ATOM APPLICABLE FALSE>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<NOT <ASSIGNED? FROB>> <VW-FUNCTION .VW>)
+ (T <VW-FUNCTION .VW .FROB> .FROB)>>
+
+<DEFINE WINDOW-PARENT (CH:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CH>))
+ <COND (<==? <VW-PARENT .VW> <VS-TOPCHAN <VW-VS100 .VW>>> <>)
+ (T <VW-PARENT .VW>)>>
+
+<DEFINE WINDOW-CHILDREN (CH:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CH>))
+ <VW-KIDS .VW>>
+
+<DEFINE PRINT-VSW (VW:VSW
+ "OPTIONAL" (OUTCHAN:CHANNEL .OUTCHAN)
+ (VS:VS <VW-VS100 .VW>))
+ <PRINC "#VSW [">
+ <COND (<VS-HOST .VS> <PRIN1 <VS-HOST .VS>>)>
+ <PRINT-MANY .OUTCHAN
+ PRINC
+ !\:
+ <VS-WHICH .VS>
+ !\
+ "ID:"
+ <VW-ID .VW>
+ !\
+ <VW-WIDTH .VW>
+ !\x
+ <VW-HEIGHT .VW>
+ " ("
+ <VW-X .VW>
+ !\,
+ <VW-Y .VW>
+ ") "
+ !\"
+ <COND (<VW-CFONT .VW> <FONT-NAME <VW-CFONT .VW>>)>
+ !\">
+ <COND (<VW-CURSOR .VW> <PRINC " CURSOR">)>
+ <COND (<==? <VW-BG .VW> <VS-BLACK .VS>> <PRINC " BLACK">)
+ (<==? <VW-BG .VW> <VS-WHITE .VS>> <PRINC " WHITE">)
+ (<==? <VW-BG .VW> <VS-GRAY .VS>> <PRINC " GRAY">)
+ (T <PRINT-MANY .OUTCHAN PRINC " BG:" <VW-BG .VW>>)>
+ <COND (<VW-OBUF .VW>
+ <PRINT-MANY .OUTCHAN
+ PRINC
+ " OBUF:"
+ <VW-OCT .VW>
+ !\/
+ <LENGTH <VW-TOBUF .VW>>>)>
+ <PRINC !\]>
+ .VW>
+
+<COND (<GASSIGNED? PRINT-VSW> <PRINTTYPE VSW ,PRINT-VSW>)>
+
+<DEFINE PRINT-VS (VS:VS "OPTIONAL" (OUTCHAN:CHANNEL .OUTCHAN))
+ <PRINT-MANY
+ .OUTCHAN
+ PRINC
+ "#VS ["
+ <VS-HOST .VS>
+ !\:
+ <VS-WHICH .VS>
+ !\
+ <COND (<VS-TOPCHAN .VS> <VW-ID <CHANNEL-DATA <VS-TOPCHAN .VS>>>)>
+ " KIDS:"
+ <COND (<VS-TOPCHAN .VS>
+ <LENGTH <VW-KIDS <CHANNEL-DATA <VS-TOPCHAN .VS>>>>)>
+ " ALL:"
+ </ <LENGTH <VS-ALL .VS>> 2>
+ " FONTS:"
+ </ <LENGTH <VS-FONTS .VS>> 2>
+ " REQ:"
+ <VS-REQ .VS>
+ " OBUF:"
+ <COND (<VS-BUFFER .VS>
+ <- <LENGTH <VS-BUFFER-TOP .VS>:STRING>
+ <LENGTH <VS-BUFFER .VS>:STRING>>)
+ (T <>)>
+ " IBUF:"
+ <LENGTH <VS-IBUFFER .VS>>
+ " MAP:"
+ <VS-MAPNAME .VS>
+ "]">
+ T>
+
+<COND (<GASSIGNED? PRINT-VS> <PRINTTYPE VS ,PRINT-VS>)>
+
+<DEFINE PRINT-WE (WE:WINDOW-EVENT "OPT" (OUTCHAN:CHANNEL .OUTCHAN) "AUX" KIND)
+ <PRINT-MANY .OUTCHAN
+ PRINC
+ "#WINDOW-EVENT ["
+ <CASE ,==?
+ <SET KIND <WE-KIND .WE>>
+ (,WE-EXPOSE-WINDOW "EXPOSE")
+ (,WE-EXPOSE-REGION "EXPOSE-REGION")
+ (,WE-EXPOSE-COPY "EXPOSE-COPY")
+ (,WE-RESIZE-WINDOW "RESIZE")
+ (,WE-UNMAP-WINDOW "UNMAP")>
+ !\
+ <WE-WINDOW .WE>
+ !\
+ <WE-SUBWINDOW .WE>>
+ <COND (<OR <==? .KIND ,WE-EXPOSE-REGION>
+ <==? .KIND ,WE-EXPOSE-COPY>
+ <==? .KIND ,WE-RESIZE-WINDOW>>
+ <MAPF <>
+ <FUNCTION (R:WE-RECTANGLE)
+ <PRINT-MANY .OUTCHAN
+ PRINC
+ " ("
+ <REC-LEFT .R>
+ !\,
+ <REC-TOP .R>
+ ") "
+ <REC-WIDTH .R>
+ "x"
+ <REC-HEIGHT .R>>>
+ <WE-CHANGES .WE>>)>
+ <PRINC !\]>>
+
+<COND (<GASSIGNED? PRINT-WE> <PRINTTYPE WINDOW-EVENT ,PRINT-WE>)>
+
+<DEFINE PRINT-ME (ME:MOUSE-EVENT
+ "OPT" (OUTCHAN:CHANNEL .OUTCHAN)
+ "AUX" KIND (PREL 0))
+ <PRINT-MANY
+ .OUTCHAN
+ PRINC
+ "#MOUSE-EVENT ["
+ <COND (<NOT <0? <ANDB <SET KIND <ME-KIND .ME>> ,ME-PRESSED-MASK>>>
+ <SET PREL 1>
+ "PRESSED")
+ (<NOT <0? <ANDB .KIND ,ME-RELEASED-MASK>>> <SET PREL -1> "RELEASED")
+ (<==? .KIND ,ME-MOVED> "MOVED")
+ (<==? .KIND ,ME-ENTER-WINDOW> "ENTER")
+ (<==? .KIND ,ME-LEAVE-WINDOW> "LEAVE")>
+ !\
+ <COND (<NOT <0? .PREL>>
+ <COND (<NOT <0? <ANDB .KIND
+ <+ ,ME-LEFT-PRESSED ,ME-LEFT-RELEASED>>>>
+ "LEFT ")
+ (<NOT <0? <ANDB .KIND
+ <+ ,ME-MIDDLE-PRESSED ,ME-MIDDLE-RELEASED>>>>
+ "MIDDLE ")
+ (T "RIGHT ")>)
+ (T "")>
+ <ME-STATE .ME>
+ " ("
+ <ME-X .ME>
+ !\,
+ <ME-Y .ME>
+ ") "
+ <ME-TIME .ME>
+ !\
+ <ME-WINDOW .ME>
+ !\
+ <ME-SUBWINDOW .ME>
+ !\]>>
+
+<COND (<GASSIGNED? PRINT-ME> <PRINTTYPE MOUSE-EVENT ,PRINT-ME>)>
+
+<DEFINE VS-READ-IMMEDIATE (CHANNEL:VSCHAN OPER
+ "OPT" (NOWAIT?:<OR ATOM FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
+ (VS:VS <VW-VS100 .VW>))
+ <GET-EVENT .VS <NOT .NOWAIT?>>>
+
+<DEFINE RECYCLE-EVENTS ("TUPLE" STUFF)
+ <MAPF <>
+ <FUNCTION (X:ANY "AUX" L)
+ <COND (<TYPE? .X MOUSE-EVENT>
+ <1 <SET L <ME-CELL .X>> .X>
+ <SETG FREE-MOUSE-EVENTS
+ <PUTREST .L ,FREE-MOUSE-EVENTS>>)
+ (<TYPE? .X WINDOW-EVENT>
+ <PUTREST <REST <SET L <WE-CHANGES .X>>
+ <- <LENGTH .L> 1>>
+ ,FREE-RECTANGLES>
+ <SETG FREE-RECTANGLES .L>
+ <WE-CHANGES .X ()>
+ <1 <SET L <WE-CELL .X>> .X>
+ <SETG FREE-WINDOW-EVENTS
+ <PUTREST .L ,FREE-WINDOW-EVENTS>>)>>
+ .STUFF>
+ T>
+
+<DEFINE GET-VS100 (DESC:<OR STRING <PRIMTYPE LIST>>)
+ <COND
+ (<OR <NOT .DESC> <TYPE? .DESC STRING>>
+ <PROG (STR:<OR STRING FALSE> TS (HOST <>) (NUM <>))
+ <COND
+ (<SET STR <OR .DESC <GET-ENV-STR "DISPLAY">>>
+ <COND (<SET TS <MEMQ !\: .STR>>
+ <SET NUM <PARSE <REST .TS>>>
+ <COND (<N==? .TS .STR>
+ <SET HOST
+ <SUBSTRUC .STR
+ 0
+ <- <LENGTH .STR> <LENGTH .TS>>>>
+ <SET HOST <HOST .HOST>>)>
+ <SET DESC (.NUM)>
+ <COND (.HOST <SET DESC (.HOST !.DESC)>)>)
+ (T <SET DESC '(0)>)>)
+ (T <SET DESC '(0)>)>>)>
+ <COND (<==? <LENGTH .DESC:LIST> 1> <VS100-INIT <1 .DESC> <>>)
+ (T <VS100-INIT <2 .DESC> <1 .DESC>>)>>
+
+<DEFINE VS100-INIT (WHICH:FIX HOST:<OR FIX FALSE>
+ "AUX" CH L NVS P:<OR UVECTOR FALSE> BUF:STRING NVW
+ BLACK WHITE GRAY ROOT PLANES
+ CURRENT-ROOT-ID:<SPECIAL FIX>)
+ <COND (<NOT <GASSIGNED? VS100-LIST>> <SETG VS100-LIST <SET L ()>>)
+ (T <SET L ,VS100-LIST>)>
+ <COND
+ (<SET NVS <FIND-VS100 .WHICH .HOST>>)
+ (T
+ <COND (<NOT .HOST>
+ <SET CH
+ <CHANNEL-OPEN NETWORK
+ <STRING "VS" <UNPARSE .WHICH>>
+ <+ ,SERV-VS100 .WHICH>>>)
+ (T
+ <SET CH
+ <CHANNEL-OPEN NETWORK
+ <STRING <UNPARSE .HOST>
+ ":VS"
+ <UNPARSE .WHICH>>
+ <+ ,SERV-VS100 .WHICH>
+ .HOST>>)>
+ <COND (.CH
+ <SET NVS
+ <CHTYPE [.CH
+ .WHICH
+ .HOST
+ <>
+ T
+ ()
+ ()
+ 0
+ 0
+ 0
+ 0
+ <SET BUF <REQUEST-BUFFER <> STRING <>>>
+ 0
+ .BUF
+ ()
+ ()
+ <>
+ <>
+ <>]
+ VS>>
+ <LOAD-KEYMAPS .NVS ,X-DEFAULT-KEYMAP>
+ <COND (<SET P <VSOP .NVS X-SETUP 0>>
+ <SET ROOT <I-LPAR0 .P>>
+ <SET CURRENT-ROOT-ID .ROOT>
+ <SET PLANES <I-SPAR4 .P>>
+ <COND (<NOT <SET BLACK <VSOP .NVS X-MAKE-PIXMAP 0
+ 0 0 0>>>
+ <ERROR CANT-MAKE-BLACK!-ERRORS .BLACK>)>
+ <COND (<NOT <SET WHITE <VSOP .NVS X-MAKE-PIXMAP 0
+ 0 1 0>>>
+ <ERROR CANT-MAKE-WHITE!-ERRORS .WHITE>)>
+ <COND (<NOT <SET GRAY <VSOP .NVS X-STORE-PIXMAP
+ 0 0 <* 16 .PLANES>
+ <* 16 .PLANES>
+ <ISTRING <* 32 .PLANES>
+ <CHTYPE *252*
+ CHARACTER>>>>>
+ <ERROR CANT-MAKE-GRAY!-ERRORS .GRAY>)>
+ <VS-TOPCHAN .NVS
+ <CHTYPE [VS100
+ "Toplevel"
+ <>
+ T
+ <SET NVW
+ <CHTYPE [.NVS
+ .ROOT
+ <>
+ ()
+ 0
+ 0
+ 0
+ 0
+ <>
+ ,GX-XOR
+ .GRAY
+ .GRAY
+ 0
+ <>
+ <>
+ 0
+ 0
+ 0
+ 0
+ <>
+ <>
+ ()
+ <>
+ <>
+ -1
+ <>
+ <>
+ <>
+ <>
+ <>
+ <>
+ <>
+ <>]
+ VSW>>
+ <>]
+ CHANNEL>>
+ <VS-ALL .NVS (<VW-ID .NVW> <VS-TOPCHAN .NVS>)>
+ <VS-BLACK .NVS .BLACK>
+ <VS-WHITE .NVS .WHITE>
+ <VS-GRAY .NVS .GRAY>
+ <SET P <VSOP .NVS X-QUERY-WINDOW <VW-ID .NVW>>>
+ <VW-WIDTH .NVW <I-SPAR1 .P:UVECTOR>>
+ <VW-HEIGHT .NVW <I-SPAR0 .P:UVECTOR>>
+ <VW-BWIDTH .NVW <I-SPAR4 .P:UVECTOR>>
+ <SET L (.NVS !.L)>
+ <SETG VS100-LIST .L>
+ .NVS)
+ (T <CLOSE .CH> .P)>)>)>>
+
+<DEFINE VS-LOAD-KEYMAPS (CH:VSCHAN OPER STR:STRING "OPT" (FORCE? <>))
+ <LOAD-KEYMAPS <VW-VS100 <CHANNEL-DATA .CH>:VSW> .STR .FORCE?>>
+
+<DEFINE LOAD-KEYMAPS (VS:VS STR:<OR STRING FALSE> "OPT" (FORCE? <>) "AUX" M1 M2
+ (LOADS:<SPECIAL FIX> 0))
+ <COND (<OR .FORCE? <N=? .STR <VS-MAPNAME .VS>>>
+ <SET M1 <LOAD-MAP .STR "NORMAL">>
+ <SET M2 <LOAD-MAP .STR "FUNCTION">>
+ <COND (<AND .M1 .M2>
+ <COND (<==? .LOADS 2>
+ <VS-MAPNAME .VS T>)
+ (<NOT .STR>
+ <VS-MAPNAME .VS "">)
+ (T
+ <VS-MAPNAME .VS .STR>)>
+ <VS-MAPS .VS [.M1 .M2]>)>)
+ (T)>>
+
+<DEFINE LOAD-MAP (STR:<OR STRING FALSE> NM2:<SPECIAL STRING>
+ "AUX" CH:<OR FALSE <CHANNEL 'DISK>> V:VECTOR BASE:FIX
+ (BUF <STACK <IUVECTOR 6>>) CT:FIX TEMP)
+ <COND (<SET CH <GEN-OPEN <COND (,VS100-DIRECTORY
+ <STRING ,VS100-DIRECTORY
+ !\/ .STR>)
+ (.STR)> "READ" "BINARY" DISK>>
+ <SET LOADS <+ .LOADS:FIX 1>>
+ <SET V <IVECTOR <CHANNEL-OP .CH READ-BYTE> <>>>
+ <SET BASE <CHANNEL-OP .CH READ-BYTE>>
+ <REPEAT ()
+ <COND (<0? <SET CT <CHANNEL-OP .CH READ-BUFFER .BUF>>>
+ <RETURN>)>
+ <PUT .V
+ <- <1 .BUF> .BASE -1>
+ <CHTYPE <SUBSTRUC .BUF 1 5> KEY>>>
+ <CLOSE .CH>
+ [.BASE .V])
+ (<COND (<=? .NM2 "NORMAL"> <SET TEMP ,X-NORMAL-KEYMAP>)
+ (T <SET TEMP ,X-FUNCTION-KEYMAP>)>
+ .TEMP)
+ (T
+ <ERROR MISSING-KEYMAP!-ERRORS .NM2 LOAD-KEYMAP>)>>
+
+<DEFINE FIND-VS100 (WHICH:FIX HOST:<OR FIX FALSE> "AUX" (L:LIST ,VS100-LIST))
+ <REPEAT (VS:VS)
+ <COND (<EMPTY? .L> <RETURN <>>)>
+ <COND (<AND <==? <VS-WHICH <SET VS <1 .L>>> .WHICH>
+ <==? <VS-HOST .VS> .HOST>>
+ <RETURN .VS>)>
+ <SET L <REST .L>>>>
+
+<DEFINE MAKE-TEMP-WINDOW MTW
+ (DESC:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER
+ "OPT" (HEIGHT:<OR FIX FALSE> <>)
+ (WIDTH:<OR FIX FALSE> <>) (LEFT:FIX -1)
+ (TOP:FIX -1) (BWIDTH:<OR FIX FALSE> <>)
+ (BPATTERN:<OR ATOM FIX> WHITE)
+ (BACKGROUND:<OR ATOM FIX> BLACK)
+ (FONT:STRING ,INITIAL-FONT)
+ "AUX" PARENT:VSCHAN MX:FIX MY:FIX NVS
+ VW:VSW VS:VS SAVE-HEIGHT SAVE-WIDTH
+ (SAVE-RASTER:<SPECIAL <OR FIX FALSE>> <>)
+ P:UVECTOR)
+ <COND (<NOT <TYPE? .DESC CHANNEL>>
+ <COND (<SET NVS <GET-VS100 .DESC>>
+ <SET PARENT <VS-TOPCHAN .NVS>>)
+ (T
+ <RETURN .NVS .MTW>)>)
+ (T
+ <SET PARENT .DESC>)>
+ <SET VW <CHANNEL-DATA .PARENT>>
+ <SET VS <VW-VS100 .VW>>
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
+ <COND (<OR <L? .LEFT 0> <L? .TOP 0>>
+ <SET P <VSOP .VS X-QUERY-MOUSE <VW-ID .VW>>>
+ <COND (<L? .LEFT 0> <SET LEFT <I-SPAR2 .P>>)>
+ <COND (<L? .TOP 0> <SET TOP <I-SPAR3 .P>>)>)>
+ <COND (<NOT .HEIGHT>
+ <SET HEIGHT <- <VW-HEIGHT .VW> <* 2 .BWIDTH> .TOP>>)>
+ <COND (<NOT .WIDTH>
+ <SET WIDTH <- <VW-WIDTH .VW> <* 2 .BWIDTH> .LEFT>>)>
+ <SET SAVE-WIDTH
+ <MIN <- <VW-WIDTH .VW> .LEFT> <+ .WIDTH <* 2 .BWIDTH>>>>
+ <SET SAVE-HEIGHT
+ <MIN <- <VW-HEIGHT .VW> .TOP> <+ .HEIGHT <* 2 .BWIDTH>>>>
+ <SET SAVE-RASTER
+ <VSOP .VS
+ X-PIXMAP-SAVE
+ <VW-ID .VW>
+ .SAVE-HEIGHT
+ .SAVE-WIDTH
+ .LEFT
+ .TOP>>
+ <CHANNEL-OPEN VS100
+ "MENU"
+ .PARENT
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP
+ .BWIDTH
+ .BPATTERN
+ .BACKGROUND
+ .FONT
+ <>>>
+
+<DEFINE KILL-SUBWINDOWS (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ L)
+ <MAPF <>
+ <FUNCTION (CHN:VSCHAN)
+ <CLOSE .CHN>>
+ <VW-KIDS .VW>>
+ <COND (<NOT <EMPTY? <SET L <VW-MENU-WINDS .VW>>>>
+ <VSOP <VW-VS100 .VW> X-DESTROY-SUBWINDOWS <VW-ID .VW>>
+ <PUTREST <REST .L <- <LENGTH .L> 1>>
+ ,MENU-WINDOW-LIST>
+ <SETG MENU-WINDOW-LIST .L>
+ <VW-MENU-WINDS .VW ()>)>
+ T>
+
+<DEFINE VS-OPEN VO (STYPE OPER NAME DESC:<OR VSCHAN VS <PRIMTYPE LIST> STRING>
+ "OPT" (HEIGHT:<OR FIX FALSE> <>) (WIDTH:<OR FIX FALSE> <>)
+ (LEFT:FIX 0) (TOP:FIX 0) (BWIDTH:<OR FIX FALSE> <>)
+ (BPATTERN:<OR ATOM FIX FALSE> <>)
+ (BACKGROUND:<OR ATOM FIX FALSE> <>)
+ (FONT:<OR STRING FALSE> <>) (BUF? T)
+ (MIN-HEIGHT:FIX 0) (MIN-WIDTH:FIX 0)
+ "AUX" NVS WID F INPUTS PATTERN TEMP TPATTERN
+ (OBUF <COND (.BUF? <ISTRING 320>)>) NVW:VSW
+ P:<OR FALSE UVECTOR> RH:FIX RW:FIX PARENT:VSCHAN
+ (CC:CHANNEL .CURRENT-CHANNEL))
+ <COND (<NOT <TYPE? .DESC CHANNEL>>
+ <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
+ <COND (<TYPE? .DESC VS>
+ <SET NVS .DESC>)
+ (<NOT <SET NVS <GET-VS100 .DESC>>>
+ <RETURN .NVS .VO>)>
+ <SET PARENT <VS-TOPCHAN .NVS>>)
+ (T <SET PARENT .DESC>)>
+ <SET NVW <CHANNEL-DATA .PARENT>>
+ <COND (<VW-REAL .NVW>
+ <RETURN #FALSE ("ICONS CAN'T HAVE CHILDREN") .VO>)>
+ <VW-FLUSH-BUFFER .NVW>
+ <COND (<NOT .BWIDTH> <SET BWIDTH <VW-BWIDTH .NVW>>)>
+ <COND (<NOT .HEIGHT> <SET HEIGHT <- <VW-HEIGHT .NVW> <* 2 .BWIDTH>>>)>
+ <COND (<NOT .WIDTH> <SET WIDTH <- <VW-WIDTH .NVW> <* 2 .BWIDTH>>>)>
+ <SET NVS <VW-VS100 .NVW>>
+ <COND (.BPATTERN
+ <SET BPATTERN <TRANSLATE-COLOR .BPATTERN .NVS>>)
+ (<==? .PARENT .DESC>
+ ; "Inherit border from parent if there is one"
+ <SET BPATTERN <VW-BORDER .NVW>>)
+ (T
+ ; "Otherwise use initial setting"
+ <SET BPATTERN <TRANSLATE-COLOR ,INITIAL-BORDER .NVS>>)>
+ <COND (.BACKGROUND
+ <SET BACKGROUND <TRANSLATE-COLOR .BACKGROUND .NVS>>)
+ (<==? .PARENT .DESC>
+ ; "Same for background"
+ <SET BACKGROUND <VW-BG .NVW>>)
+ (T
+ <SET BACKGROUND <TRANSLATE-COLOR ,INITIAL-BACKGROUND .NVS>>)>
+ <COND (<NOT .FONT>
+ ; "And font"
+ <COND (<N==? .PARENT .DESC>
+ <SET FONT ,INITIAL-FONT>)
+ (T
+ <SET FONT <FONT-NAME <VW-CFONT .NVW>>>)>)>
+ <COND
+ (<SET F <GET-FONT .FONT .NVS>>
+ <SET MIN-WIDTH <* <FONT-WIDTH .F> .MIN-WIDTH>>
+ <SET MIN-HEIGHT <* <FONT-HEIGHT .F> .MIN-HEIGHT>>
+ <COND (<SET WID
+ <VSOP .NVS
+ X-CREATE-WINDOW
+ .BWIDTH
+ <VW-ID <CHANNEL-DATA .PARENT:VSCHAN>:VSW>
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP
+ .BPATTERN
+ .BACKGROUND>>
+ <SET MIN-HEIGHT <MAX 0 .MIN-HEIGHT>>
+ <SET MIN-WIDTH <MAX 0 .MIN-WIDTH>>
+ <VSOP .NVS
+ X-SET-RESIZE-HINT
+ .WID
+ .MIN-HEIGHT
+ <FONT-HEIGHT .F>
+ .MIN-WIDTH
+ <FONT-WIDTH .F>>
+ <VS-ALL .NVS (.WID .CC !<VS-ALL .NVS>)>
+ <VW-KIDS <CHANNEL-DATA .PARENT:VSCHAN>:VSW
+ (.CC
+ !<VW-KIDS <CHANNEL-DATA .PARENT:VSCHAN>:VSW>)>
+ <VSOP .NVS
+ X-STORE-NAME
+ .WID
+ <LENGTH <CHANNEL-NAME .CC>:STRING>
+ <CHANNEL-NAME .CC>>
+ <COND (<NOT <GASSIGNED? INITIAL-MOUSE-CURSOR>>
+ <SET TEMP ,MDL-CURSOR>)
+ (T <SET TEMP ,INITIAL-MOUSE-CURSOR>)>
+ <COND (<OR <AND <TYPE? .TEMP CURSOR> <SET PATTERN .TEMP>>
+ <AND <TYPE? .TEMP VECTOR>
+ <SET PATTERN <MAKE-PATTERN .NVS !.TEMP>>>>
+ <VSOP .NVS
+ X-DEFINE-CURSOR .WID
+ <C-CURSOR .PATTERN>>)
+ (.TEMP
+ <VSOP .NVS X-DEFINE-CURSOR .WID 0>
+ <SET PATTERN T>)
+ (T <SET PATTERN <>>)>
+ <COND (<NOT <GASSIGNED? INITIAL-TEXT-CURSOR>> <SET TEMP T>)
+ (T <SET TEMP ,INITIAL-TEXT-CURSOR>)>
+ <COND (<AND <TYPE? .TEMP VECTOR>
+ <SET TPATTERN <MAKE-PATTERN .NVS !.TEMP>>>)
+ (.TEMP <SET TPATTERN .TEMP>)
+ (T <SET TPATTERN <>>)>
+ <VSOP .NVS
+ X-SELECT-INPUT
+ .WID
+ <COND (<==? .PARENT <VS-TOPCHAN .NVS>>
+ <SET INPUTS
+ <ORB ,KEY-PRESSED
+ ,BUTTON-PRESSED
+ ,BUTTON-RELEASED
+ ,ENTER-WINDOW
+ ,LEAVE-WINDOW
+ ,EXPOSE-WINDOW
+ ,UNMAP-WINDOW
+ ,EXPOSE-REGION
+ ,EXPOSE-COPY>>)
+ (T
+ <SET INPUTS
+ <ORB ,ENTER-WINDOW
+ ,LEAVE-WINDOW
+ ,BUTTON-PRESSED
+ ,BUTTON-RELEASED
+ ,UNMAP-WINDOW
+ ,EXPOSE-REGION
+ ,EXPOSE-COPY>>)>>
+ <VSOP .NVS X-MAP-WINDOW .WID>
+ <CHTYPE [.NVS
+ .WID
+ .PARENT
+ ()
+ .WIDTH
+ .HEIGHT
+ 0
+ 0
+ .F
+ <COND (<==? .BACKGROUND <VS-BLACK .NVS>> ,GX-COPY)
+ (<==? .BACKGROUND <VS-WHITE .NVS>>
+ ,GX-COPY-INVERTED)
+ (T ,GX-XOR)>
+ .BACKGROUND
+ .BPATTERN
+ .BWIDTH
+ .OBUF
+ .OBUF
+ 0
+ 0
+ 0
+ <+ ,VWM-DEFAULT ,VWM-UNSEEN>
+ <>
+ T
+ ()
+ <>
+ <>
+ .INPUTS
+ .TPATTERN
+ <AND <ASSIGNED? SAVE-RASTER> .SAVE-RASTER>
+ .PATTERN
+ <>
+ <>
+ <>
+ <>
+ <>
+ <>]
+ VSW>)>)>>
+
+<DEFINE VS-WARP-MOUSE (CHN:VSCHAN OPER X:FIX Y:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-FLUSH-BUFFER .VW>
+ <VSOP <VW-VS100 .VW> X-WARP-MOUSE <VW-ID .VW> .X .Y>
+ .CHN>
+
+<DEFINE VS-DRAW-LINE (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
+ "TUPLE" POINTS
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<OR <NOT <0? <MOD <LENGTH .POINTS> 2>>> <L? <LENGTH .POINTS> 4>>
+ <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DRAW-LINE>)>
+ <SCALE-POINT .POINTS .VW>
+ <REPEAT ((X1 <1 .POINTS>) (Y1 <2 .POINTS>) (VV <REST .POINTS 2>))
+ <SCALE-POINT .VV .VW>
+ <VSOP <VW-VS100 .VW>
+ X-LINE
+ <COND (<NOT .FUNC> ,GX-XOR) (.FUNC)>
+ -1 ;"plane mask"
+ <VW-ID .VW>
+ .X1
+ .Y1
+ <1 .VV>
+ <2 .VV>
+ 1 1 1>
+ <SET X1 <1 .VV>>
+ <SET Y1 <2 .VV>>
+ <COND (<EMPTY? <SET VV <REST .VV 2>>> <RETURN>)>>
+ T>
+
+<DEFINE SCALE-POINT (PT:<<PRIMTYPE VECTOR> [2 <OR FIX FLOAT>]> VW:VSW
+ "OPT" (RELATIVE?:<OR ATOM FALSE> <>)
+ "AUX" (SC:<OR FALSE SCALE> <VW-SCALE .VW>) NUM)
+ <COND (<NOT .SC>
+ <COND (<TYPE? <SET NUM <1 .PT>> FLOAT>
+ <1 .PT <FIX <+ .NUM 0.5>>>)>
+ <COND (<TYPE? <SET NUM <2 .PT>> FLOAT>
+ <2 .PT <FIX <+ .NUM 0.5>>>)>)
+ (T
+ <COND (<TYPE? <SET NUM <1 .PT>> FIX> <SET NUM <FLOAT .NUM>>)>
+ <1 .PT
+ <FIX <+ <* <COND (.RELATIVE? .NUM) (T <- .NUM <S-LEFT .SC>>)>
+ <S-WSCALE .SC>>
+ 0.5>>>
+ <COND (<TYPE? <SET NUM <2 .PT>> FIX> <SET NUM <FLOAT .NUM>>)>
+ <2 .PT
+ <FIX <+ <* <COND (.RELATIVE? .NUM) (T <- .NUM <S-TOP .SC>>)>
+ <S-HSCALE .SC>>
+ 0.5>>>)>>
+
+<DEFINE VS-DRAW-FILLED
+ (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
+ FILL-PATTERN:<SPECIAL <OR ATOM FIX>> BORDER?:<SPECIAL <OR ATOM FALSE>>
+ X1:FIX Y1:FIX DFLAGS:<OR FIX FALSE>
+ "TUPLE" STUFF)
+ <COND (<TYPE? .FILL-PATTERN ATOM>
+ <SET FILL-PATTERN
+ <TRANSLATE-COLOR .FILL-PATTERN
+ <VW-VS100 <CHANNEL-DATA .CHN>:VSW>>>)>
+ <VS-DRAW .CHN .OPER .FUNC .X1 .Y1 .DFLAGS !.STUFF>>
+
+<DEFINE VS-DRAW-DASHED (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
+ DASHED-PATTERN:<SPECIAL FIX>
+ DP-LENGTH:<SPECIAL <OR FIX FALSE>>
+ DP-MULT:<SPECIAL <OR FIX FALSE>>
+ X1:<OR FIX FLOAT> Y1:<OR FIX FLOAT> DFLAGS:<OR FIX FALSE>
+ "TUPLE" STUFF)
+ <COND (<NOT .DP-LENGTH> <SET DP-LENGTH 16>)>
+ <COND (<NOT .DP-MULT> <SET DP-MULT 1>)>
+ <VS-DRAW .CHN .OPER .FUNC .X1 .Y1 .DFLAGS !.STUFF>>
+
+<DEFINE VS-DRAW
+ (CHN:VSCHAN OPER FUNC:<OR FIX FALSE> X1:<OR FIX FLOAT>
+ Y1:<OR FIX FLOAT> DFLAGS:<OR FIX FALSE>
+ "TUPLE" STUFF
+ "AUX" (VERTS <STACK <ISTRING <* 2 <+ 3 <LENGTH .STUFF>>>>>) (CT 1)
+ (VW:VSW <CHANNEL-DATA .CHN>) (P1 <STACK <VECTOR .X1 .Y1>>)
+ (VS:VS <VW-VS100 .VW>))
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<NOT .FUNC> <SET FUNC ,GX-XOR>)>
+ <COND (<NOT .DFLAGS> <SET DFLAGS 0>)>
+ <SCALE-POINT .P1 .VW>
+ <PUT-WORD .VERTS .CT <1 .P1>>
+ <PUT-WORD .VERTS <SET CT <+ .CT 1>> <2 .P1>>
+ <PUT-WORD .VERTS
+ <SET CT <+ .CT 1>>
+ <ANDB .DFLAGS <XORB ,VERTEX-RELATIVE -1>>>
+ <REPEAT ((VC 1))
+ <COND
+ (<EMPTY? .STUFF>
+ <COND (<ASSIGNED? DASHED-PATTERN>
+ <VSOP .VS
+ X-DRAW
+ .FUNC
+ -1
+ <VW-ID .VW>
+ .VC
+ 1
+ 1
+ 1
+ 1
+ 0
+ .DASHED-PATTERN
+ .DP-LENGTH
+ .DP-MULT
+ .VERTS>)
+ (<ASSIGNED? FILL-PATTERN>
+ <VSOP .VS
+ X-DRAW-FILLED
+ .FUNC
+ -1
+ <VW-ID .VW>
+ .VC
+ 1
+ .FILL-PATTERN
+ .VERTS>
+ <COND (.BORDER?
+ <VSOP .VS
+ X-DRAW
+ <COND (<==? <VW-BG .VW> <VS-WHITE .VS>>
+ ,GX-CLEAR)
+ (T ,GX-SET)>
+ -1
+ <VW-ID .VW>
+ .VC
+ 1
+ 1
+ 1
+ 0
+ 0
+ 0
+ 0
+ 0
+ .VERTS>)>)
+ (T <VSOP .VS X-DRAW .FUNC -1 <VW-ID .VW> .VC
+ 1 1 1 0 0 0 0 0 .VERTS>)>
+ <RETURN>)>
+ <COND (<L? <LENGTH .STUFF> 3>
+ <ERROR BAD-VERTICES!-ERRORS .STUFF DRAW>
+ <RETURN>)>
+ <SET VC <+ .VC 1>>
+ <SCALE-POINT .STUFF
+ .VW
+ <NOT <0? <ANDB <OR <3 .STUFF> .DFLAGS>
+ ,VERTEX-RELATIVE>>>>
+ <PUT-WORD .VERTS <SET CT <+ .CT 1>> <1 .STUFF>>
+ <PUT-WORD .VERTS <SET CT <+ .CT 1>> <2 .STUFF>>
+ <PUT-WORD .VERTS <SET CT <+ .CT 1>> <COND (<3 .STUFF>) (T .DFLAGS)>>
+ <SET STUFF <REST .STUFF 3>>>>
+
+<DEFINE PUT-WORD (BYTES:STRING OFFS:FIX WD:FIX "AUX" (TOFFS <* .OFFS 2>))
+ <PUT .BYTES .TOFFS <CHTYPE <LSH .WD -8> CHARACTER>>
+ <PUT .BYTES <- .TOFFS 1> <CHTYPE <ANDB .WD 255> CHARACTER>>>
+
+<DEFINE VS-MOUSE-MOVE? (CHN:VSCHAN OPER
+ "OPT" ON?:<OR ATOM FALSE FIX>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) OLD IP)
+ <SET OLD <ANDB <SET IP <VW-INPUTS .VW>> ,MOTION-BITS>>
+ <COND (<TYPE? .ON? ATOM> <SET ON? ,MOUSE-MOVED>)
+ (<NOT .ON?> <SET ON? 0>)
+ (<==? .ON? ,MOUSE-LEFT> <SET ON? ,LEFT-DOWN-MOTION>)
+ (<==? .ON? ,MOUSE-RIGHT> <SET ON? ,RIGHT-DOWN-MOTION>)
+ (<==? .ON? ,MOUSE-CENTER> <SET ON? ,MIDDLE-DOWN-MOTION>)
+ (T
+ <ERROR UNKNOWN-BIT-PATTERN!-ERRORS .ON? MOUSE-MOVE?>
+ <SET ON? .OLD>)>
+ <COND (<AND <ASSIGNED? ON?> <N==? .ON? .OLD>>
+ <SET IP <ORB <ANDB .IP <XORB ,MOTION-BITS -1>> .ON?>>
+ <VW-INPUTS .VW .IP>
+ <VSOP .VS X-SELECT-INPUT <VW-ID .VW> .IP>)>
+ <COND (<==? .OLD ,MOUSE-MOVED> T)
+ (<==? .OLD ,LEFT-DOWN-MOTION> ,MOUSE-LEFT)
+ (<==? .OLD ,RIGHT-DOWN-MOTION> ,MOUSE-RIGHT)
+ (<==? .OLD ,MIDDLE-DOWN-MOTION> ,MOUSE-CENTER)
+ (<0? .OLD> <>)>>
+
+<DEFINE DEFINE-PATTERN
+ (CHN:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER
+ BITS:<OR <UVECTOR [8 FIX]> <BYTES [32 FIX]>>
+ "AUX" VW:VSW VS:<OR VS FALSE>)
+ <COND (<TYPE? .CHN CHANNEL>
+ <SET VS <VW-VS100 <SET VW <CHANNEL-DATA .CHN>>>>)
+ (T
+ <SET VS <GET-VS100 .CHN>>)>
+ <COND (.VS
+ <VSOP .VS X-STORE-PIXMAP 0 0 16 16 .BITS>)>>
+
+<DEFINE FREE-PATTERN (CHN:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER PAT:FIX
+ "AUX" VW:VSW VS:<OR VS FALSE>)
+ <COND (<TYPE? .CHN CHANNEL>
+ <SET VS <VW-VS100 <SET VW <CHANNEL-DATA .CHN>>>>)
+ (T
+ <SET VS <GET-VS100 .CHN>>)>
+ <COND (.VS
+ <VSOP <VW-VS100 .VW> X-FREE-PIXMAP 0 .PAT>)>>
+
+<DEFINE VS-CLEAR-REGION
+ (CHN:VSCHAN OPER HEIGHT:<OR FIX FLOAT> WIDTH:<OR FIX FLOAT>
+ LEFT:<OR FIX FLOAT> TOP:<OR FIX FLOAT>
+ "OPT" FUNC:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
+ (CC <STACK <VECTOR .WIDTH .HEIGHT .LEFT .TOP>>))
+ <COND (<NOT <ASSIGNED? FUNC>>
+ <COND (<==? <VW-BG .VW> <VS-WHITE .VS>> <SET FUNC ,GX-SET>)
+ (T <SET FUNC ,GX-CLEAR>)>)>
+ <VW-FLUSH-BUFFER .VW>
+ <SCALE-POINT .CC .VW T>
+ <SCALE-POINT <REST .CC 2> .VW>
+ <VSOP .VS
+ X-PIX-FILL
+ .FUNC
+ -1
+ <VW-ID .VW>
+ <2 .CC>
+ <1 .CC>
+ <3 .CC>
+ <4 .CC>
+ 1
+ 0>>
+
+<DEFINE VS-FILL-REGION
+ (CHN:VSCHAN OPER PAT:<OR ATOM FIX> HEIGHT:<OR FIX FLOAT>
+ WIDTH:<OR FIX FLOAT> LEFT:<OR FIX FLOAT> TOP:<OR FIX FLOAT> FUNC:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
+ (CC <STACK <VECTOR .WIDTH .HEIGHT .LEFT .TOP>>))
+ <COND (<TYPE? .PAT ATOM> <SET PAT <TRANSLATE-COLOR .PAT .VS>>)>
+ <VW-FLUSH-BUFFER .VW>
+ <SCALE-POINT .CC .VW T>
+ <SCALE-POINT <REST .CC 2> .VW>
+ <VSOP .VS
+ X-TILE-FILL
+ .FUNC
+ -1
+ <VW-ID .VW>
+ <2 .CC>
+ <1 .CC>
+ <3 .CC>
+ <4 .CC>
+ .PAT
+ 0>>
+
+<DEFINE INVERSE-VIDEO (CHN:<OR VSCHAN VSW> OPER "OPT" ON?:<OR ATOM FALSE>
+ (CURSOFF? <>)
+ "AUX" (VW:VSW <COND (<TYPE? .CHN VSW> .CHN)
+ (T <CHANNEL-DATA .CHN>)>) OLD)
+ <SET OLD <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>>
+ <COND (<ASSIGNED? ON?>
+ <VW-FLUSH-BUFFER .VW .CURSOFF?>
+ <COND (.ON?
+ <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-INVERT>>)
+ (T
+ <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW> <XORB ,VWM-INVERT -1>>>)>)>
+ .OLD>
+
+<DEFINE UNDERLINE (CHN:<OR VSCHAN VSW> OPER "OPT" ON?:<OR ATOM FALSE>
+ (CURSOFF? <>)
+ "AUX" (VW:VSW <COND (<TYPE? .CHN VSW> .CHN)
+ (T <CHANNEL-DATA .CHN>)>) OLD)
+ <SET OLD <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>>
+ <COND (<ASSIGNED? ON?>
+ <VW-FLUSH-BUFFER .VW .CURSOFF?>
+ <COND (.ON?
+ <COND (<NOT <VW-HIGHX .VW>>
+ <VW-HIGHX .VW <VW-X .VW>>)>
+ <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNDER>>)
+ (T
+ <COND (<NOT <VW-HIGHLIGHT .VW>>
+ <VW-HIGHX .VW <>>)>
+ <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW> <XORB ,VWM-UNDER -1>>>)>)>
+ .OLD>
+
+<DEFINE VS-SET-HIGHLIGHT (CHN:<OR VSCHAN VSW> OPER
+ "OPT" PAT:<OR FIX FALSE>
+ (CURSOFF?:<OR ATOM FALSE> <>)
+ "AUX" (VW:VSW
+ <COND (<TYPE? .CHN VSW> .CHN)
+ (T <CHANNEL-DATA .CHN>)>))
+ <COND (<NOT <ASSIGNED? PAT>> <VW-HIGHLIGHT .VW>)
+ (T
+ <VW-FLUSH-BUFFER .VW <NOT .CURSOFF?>>
+ <VW-HIGHLIGHT .VW .PAT>
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>)
+ (<AND .PAT <NOT <0? .PAT>>>
+ <VW-HIGHX .VW <VW-X .VW>>)
+ (T
+ <VW-HIGHX .VW <>>)>)>>
+
+<DEFINE TRANSLATE-COLOR (CLR:<OR ATOM FIX> VS:VS)
+ <COND (<TYPE? .CLR FIX> .CLR)
+ (<==? .CLR BLACK> <VS-BLACK .VS>)
+ (<==? .CLR WHITE> <VS-WHITE .VS>)
+ (<==? .CLR GRAY> <VS-GRAY .VS>)
+ (T <ERROR BAD-COLOR-NAME!-ERRORS .CLR TRANSLATE-COLOR>)>>
+
+<DEFINE VS-CHANGE-COLOR (CHANNEL:VSCHAN OPER BG:<OR ATOM FIX>
+ "OPT" BORDER:<OR ATOM FIX>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
+ (VS <VW-VS100 .VW>))
+ <VW-FLUSH-BUFFER .VW>
+ <SET BG <TRANSLATE-COLOR .BG .VS>>
+ <COND (<NOT <ASSIGNED? BORDER>> <SET BORDER <VW-BORDER .VW>>)
+ (T <SET BORDER <TRANSLATE-COLOR .BORDER .VS>>)>
+ <COND (<N==? .BG <VW-BG .VW>>
+ <VW-BG .VW .BG>
+ <COND (<==? .BG <VS-BLACK .VS>>
+ <VW-TEXT-OP .VW ,GX-COPY>)
+ (<==? .BG <VS-WHITE .VS>>
+ <VW-TEXT-OP .VW ,GX-COPY-INVERTED>)
+ (T
+ <VW-TEXT-OP .VW ,GX-XOR>)>
+ <VSOP .VS X-CHANGE-BACKGROUND .VW .BG>)>
+ <COND (<N==? .BORDER <VW-BORDER .VW>>
+ <VW-BORDER .VW .BORDER>
+ <VSOP .VS X-CHANGE-BORDER .VW .BORDER>)>
+ T>
+
+<DEFINE VS-MAP MW (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P TOP:FIX LEFT:FIX
+ WIDTH:FIX HEIGHT:FIX (VS:VS <VW-VS100 .VW>) BWIDTH
+ NVW:VSW SAVE-RASTER)
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<SET SAVE-RASTER <VW-SAVE .VW>>
+ <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
+ <COND (<NOT <0? <I-BPAR10 .P>>> <RETURN .CHN .MW>)>
+ <COND (<NOT <0? .SAVE-RASTER>>
+ <VSOP .VS X-FREE-PIXMAP 0 .SAVE-RASTER>)>
+ <SET HEIGHT <I-SPAR0 .P>>
+ <SET WIDTH <I-SPAR1 .P>>
+ <SET TOP <I-SPAR3 .P>>
+ <SET LEFT <I-SPAR2 .P>>
+ <SET BWIDTH <I-SPAR4 .P>>
+ <SET NVW <CHANNEL-DATA <VW-PARENT .VW>:VSCHAN>>
+ <SET WIDTH
+ <MIN <- <VW-WIDTH .NVW> .LEFT>
+ <+ .WIDTH <* 2 .BWIDTH>>>>
+ <SET HEIGHT
+ <MIN <- <VW-HEIGHT .NVW> .TOP>
+ <+ .HEIGHT <* 2 .BWIDTH>>>>
+ <COND (<SET SAVE-RASTER
+ <VSOP .VS
+ X-PIXMAP-SAVE
+ <VW-ID .NVW>
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP>>
+ <VW-SAVE .VW .SAVE-RASTER>)>)>)>
+ <VSOP <VW-VS100 .VW> X-MAP-WINDOW <VW-ID .VW>>>
+
+<DEFINE VS-UNMAP (CHN:VSCHAN OPER "OPT" (QUIET? <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<OR .QUIET?
+ <AND <VW-PARENT .VW> <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>>
+ ; "Inhibit redisplay events in this case"
+ <VSOP <VW-VS100 .VW> X-UNMAP-TRANSPARENT <VW-ID .VW>>
+ <RESTORE-WIND .VW>)
+ (T
+ <VSOP <VW-VS100 .VW> X-UNMAP-WINDOW <VW-ID .VW>>)>>
+
+<DEFINE RESTORE-WIND RW (VW:VSW
+ "AUX" (RAST <VW-SAVE .VW>) P CM
+ (PCH:<OR FALSE VSCHAN> <VW-PARENT .VW>) NVW:VSW
+ (VS:VS <VW-VS100 .VW>) TOP:FIX LEFT:FIX)
+ <COND (<AND .PCH .RAST <NOT <0? .RAST>>>
+ <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
+ <SET TOP <I-SPAR3 .P>>
+ <SET LEFT <I-SPAR2 .P>>)
+ (T
+ <SET TOP 0>
+ <SET LEFT 0>)>
+ <SET NVW <CHANNEL-DATA .PCH>>
+ <COND (<AND <> <SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .NVW>>>>
+ ; "Doesn't seem to be any way to get clipmode"
+ <COND (<0? <I-BPAR10 .P>> <RETURN .VW .RW>)>
+ <SET CM <I-SPAR6 .P>>)
+ (T <SET CM 0>)>
+ <VSOP .VS X-CLIPMODE 1 <VW-ID .NVW>>
+ <VSOP .VS
+ X-PIXMAP-PUT
+ ,GX-COPY
+ -1
+ <VW-ID .NVW>
+ <MIN <- <VW-HEIGHT .NVW> .TOP>
+ <+ <* 2 <VW-BWIDTH .VW>> <VW-HEIGHT .VW>>>
+ <MIN <- <VW-WIDTH .NVW> .LEFT>
+ <+ <* 2 <VW-BWIDTH .VW>> <VW-WIDTH .VW>>>
+ 0
+ 0
+ .RAST
+ .LEFT
+ .TOP>
+ <VSOP .VS X-CLIPMODE .CM <VW-ID .NVW>>
+ <VSOP .VS X-FREE-PIXMAP 0 .RAST>
+ <VW-SAVE .VW 0>
+ <VSB-DUMP .VS>)>>
+
+<DEFINE VS-CLOSE (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (OC <AND <ASSIGNED? CLOSING?> .CLOSING?>)
+ (CLOSING?:<SPECIAL ATOM> T) (VS:VS <VW-VS100 .VW>)
+ PC:CHANNEL NVW:VSW CD RAST P CM TC)
+ <COND (<SET TC <VW-REAL .VW>>
+ <VW-ICON <CHANNEL-DATA .TC>:VSW <>>
+ <CLOSE .TC>)
+ (<SET TC <VW-ICON .VW>>
+ <VW-REAL <CHANNEL-DATA .TC>:VSW <>>
+ <CLOSE .TC>)>
+ <MAPF <> <FUNCTION (C:VSCHAN) <CLOSE .C>> <VW-KIDS .VW>>
+ <COND (<AND <SET CD <VW-CURS-DESC .VW>> <NOT <TYPE? .CD ATOM>>>
+ <DESTROY-CURSOR .CD .VS>)>
+ <COND (<NOT <EMPTY? <VW-MENU-WINDS .VW>>>
+ <PUTREST <REST <VW-MENU-WINDS .VW>
+ <- <LENGTH <VW-MENU-WINDS .VW>> 1>>
+ ,MENU-WINDOW-LIST>
+ <SETG MENU-WINDOW-LIST <VW-MENU-WINDS .VW>>
+ <VW-MENU-WINDS .VW ()>)>
+ <COND (<NOT .OC>
+ <VW-KIDS <SET NVW <CHANNEL-DATA <SET PC <VW-PARENT .VW>>>>
+ <SPLICE-OUT .CHN <VW-KIDS .NVW>>>
+ <VS-ALL .VS <SPLICE-OUT <VW-ID .VW> <VS-ALL .VS> 2>>
+ <COND (<AND <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>
+ ; "There's something underneath this"
+ <CHANNEL-OP .CHN UNMAP T>
+ ; "So unmap it quietly, which will restore the window")>
+ <VSOP .VS X-DESTROY-WINDOW <VW-ID .VW>>)
+ (<AND <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>
+ <VSOP .VS X-FREE-PIXMAP 0 <VW-SAVE .VW>>)>
+ .CHN>
+
+<DEFINE SPLICE-OUT (FROB:ANY L:LIST "OPT" (N:FIX 1) "AUX" TL:<OR LIST FALSE>)
+ <COND (<SET TL <MEMQ .FROB .L>>
+ <COND (<==? .TL .L> <REST .TL .N>)
+ (T
+ <SET TL <REST .L <- <LENGTH .L> <LENGTH .TL> 1>>>
+ <PUTREST .TL <REST .TL <+ .N 1>>>
+ .L)>)
+ (T .L)>>
+
+<SETG MENU-WINDOW-LIST ()>
+
+<GDECL (MENU-WINDOW-LIST) <LIST [REST MENU-WINDOW]>>
+
+<DEFINE VS-MENU-WINDOW
+ (CHN:VSCHAN OPER HEIGHT:<OR FIX FALSE> WIDTH:FIX LEFT:FIX TOP:FIX
+ "OPT" (OBJ:ANY <>) TXT:<OR STRING FALSE>
+ "AUX" WID (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
+ (MWL:LIST ,MENU-WINDOW-LIST) MW:MENU-WINDOW)
+ <COND (<NOT .HEIGHT> <SET HEIGHT <FONT-HEIGHT <VW-CFONT .VW>>>)>
+ <VW-FLUSH-BUFFER .VW>
+ <COND
+ (<SET WID
+ <VSOP .VS
+ X-CREATE-WINDOW
+ 0
+ <VW-ID .VW>
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP
+ <VW-BORDER .VW>
+ <VW-BG .VW>>>
+ <VSOP .VS X-DEFINE-CURSOR .WID 0>
+ <VSOP .VS X-MAP-WINDOW .WID>
+ <COND (<EMPTY? .MWL>
+ <VW-MENU-WINDS .VW
+ (<SET MW
+ <CHTYPE <VECTOR .WID
+ .HEIGHT
+ .WIDTH
+ .OBJ
+ ,VWM-UNSEEN>
+ MENU-WINDOW>>
+ !<VW-MENU-WINDS .VW>)>)
+ (T
+ <SET MW <1 .MWL>>
+ <MW-ID .MW .WID>
+ <MW-HEIGHT .MW .HEIGHT>
+ <MW-WIDTH .MW .WIDTH>
+ <MW-OBJ .MW .OBJ>
+ <MW-BITS .MW ,VWM-UNSEEN>
+ <SETG MENU-WINDOW-LIST <REST .MWL>>
+ <VW-MENU-WINDS .VW <PUTREST .MWL <VW-MENU-WINDS .VW>>>)>
+ <COND (<NOT <ASSIGNED? TXT>>
+ <COND (<TYPE? .OBJ STRING> <SET TXT .OBJ>) (T <SET TXT <>>)>)>
+ <COND (.TXT <CHANNEL-OP .CHN WRITE-TO-MENU-WINDOW .MW .TXT>)>
+ .MW)>>
+
+<DEFINE VS-CLEAR-MENU-WINDOW (CHN:VSCHAN OPER MW:MENU-WINDOW
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>))
+ <VSOP .VS X-CLEAR <MW-ID .MW>>
+ <MW-OBJ .MW <>>>
+
+<DEFINE VS-SELECT-MENU-WINDOW (CHN:VSCHAN OPER
+ "OPT" (MW:<OR MENU-WINDOW FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) L)
+ <COND (<NOT .MW>
+ <COND (<NOT <EMPTY? <SET L <VW-MENU-WINDS .VW>>>>
+ <SET MW <NTH .L <LENGTH .L>>>)>)>
+ <COND (.MW
+ <VSOP <VW-VS100 .VW>
+ X-WARP-MOUSE
+ <MW-ID .MW>
+ </ <MW-WIDTH .MW> 2>
+ </ <MW-HEIGHT .MW> 2>>)>>
+
+<DEFINE VS-WRITE-TO-MENU (CHN:VSCHAN OPER MW:MENU-WINDOW TXT:STRING
+ "OPT" (X:FIX 0) (Y:FIX 0) FONT:STRING
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (CFONT:<OR FONT FALSE> <VW-CFONT .VW>)
+ (VS:VS <VW-VS100 .VW>))
+ <COND (<ASSIGNED? FONT> <SET CFONT <GET-FONT .FONT .VS>>)>
+ <COND (.CFONT
+ <MW-OBJ .MW .TXT>
+ <VSOP .VS
+ X-TEXT
+ <VW-TEXT-OP .VW>
+ -1
+ <MW-ID .MW>
+ 0
+ 0
+ <FONT-ID .CFONT>
+ 1 0
+ <LENGTH .TXT>
+ 0 0 ;"PADDING BETWEEN CHARS"
+ .TXT>)>>
+
+<DEFINE VS-INVERT-MENU (CHN:VSCHAN OPER MW:MENU-WINDOW)
+ <VSOP <VW-VS100 <CHANNEL-DATA .CHN>:VSW>
+ X-PIX-FILL
+ ,GX-INVERT
+ -1
+ <MW-ID .MW>
+ <MW-HEIGHT .MW>
+ <MW-WIDTH .MW>
+ 0
+ 0
+ 1
+ 0>
+ T>
+
+<DEFINE VS-SET-FONT (CHN:VSCHAN OPER
+ "OPT" FONT:STRING
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) TF
+ (VS:VS <VW-VS100 .VW>) P (MH 0) (MW 0))
+ <COND (<NOT <ASSIGNED? FONT>>
+ <COND (<SET TF <VW-CFONT .VW>> <FONT-NAME .TF>)>)
+ (<SET TF <GET-FONT .FONT <VW-VS100 .VW>>>
+ <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
+ <SET MH <I-SPAR0 .P>>
+ <SET MW <I-SPAR2 .P>>)>
+ <VSOP .VS
+ X-SET-RESIZE-HINT
+ <VW-ID .VW>
+ .MH
+ <FONT-HEIGHT .TF>
+ .MW
+ <FONT-WIDTH .TF>>
+ <CURSOR-OFF .VW>
+ <VW-CFONT .VW .TF>
+ <CURSOR-ON .VW>
+ .FONT)>>
+
+<SETG BUF1 <ISTRING 1>>
+
+<GDECL (BUF1) STRING>
+
+<DEFINE VS-IMAGE-OUT (CHANNEL:VSCHAN OPER CHRS:<OR STRING CHARACTER>
+ "OPT" (LENGTH:<OR FIX FALSE> <>)
+ (X:<OR FIX FLOAT FALSE> <>)
+ (Y:<OR FIX FLOAT FALSE> <>)
+ (FONT:<OR FONT STRING FALSE> <>)
+ (DOP:<OR FIX FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
+ (PP <STACK <VECTOR .X .Y>>) (CFONT <VW-CFONT .VW>)
+ (VS:VS <VW-VS100 .VW>))
+ <VW-FLUSH-BUFFER .VW>
+ <COND (.FONT
+ <COND (<TYPE? .FONT FONT> <SET CFONT .FONT>)
+ (T <SET CFONT <GET-FONT .FONT .VS>>)>)>
+ <GET-COORDS .VW .PP>
+ <COND (<NOT .DOP> <SET DOP <VW-TEXT-OP .VW>>)>
+ <COND (<TYPE? .CHRS CHARACTER> <SET CHRS <1 ,BUF1 .CHRS>>)>
+ <COND (<NOT .LENGTH> <SET LENGTH <LENGTH .CHRS>>)
+ (T <SET LENGTH <MIN .LENGTH <LENGTH .CHRS>>>)>
+ <VSOP .VS
+ X-TEXT
+ .DOP
+ -1
+ <VW-ID .VW>
+ <1 .PP>
+ <2 .PP>
+ <FONT-ID .CFONT>
+ 1
+ 0
+ .LENGTH
+ 0 0
+ .CHRS>
+ .LENGTH>
+
+<DEFINE GET-COORDS (VW:VSW PP:<<PRIMTYPE VECTOR> [2 <OR FIX FLOAT FALSE>]>
+ "AUX" (SC <VW-SCALE .VW>) (OX <VW-X .VW>) (OY <VW-Y .VW>)
+ (X <1 .PP>) (Y <2 .PP>))
+ <COND (<NOT .SC>
+ <COND (<TYPE? .X FLOAT> <SET X <FIX <+ .X 0.5>>>)>
+ <1 .PP <OR .X .OX>>
+ <COND (<TYPE? .Y FLOAT> <SET Y <FIX <+ .Y 0.5>>>)>
+ <2 .PP <OR .Y .OY>>)
+ (<AND <NOT .X> <NOT .Y>> <1 .PP .OX> <2 .PP .OY>)
+ (T
+ <COND (<NOT .X>
+ <1 .PP <S-LEFT .SC>>
+ <SCALE-POINT .PP .VW>
+ <1 .PP .OX>)
+ (<NOT .Y>
+ <1 .PP <S-TOP .SC>>
+ <SCALE-POINT .PP .VW>
+ <2 .PP .OY>)
+ (T <SCALE-POINT .PP .VW>)>)>>
+
+<DEFINE VS-NORMAL-OUT (CHANNEL:VSCHAN OPER CHRS:<OR STRING CHARACTER>
+ "OPT" (LENGTH:<OR FIX FALSE> <>)
+ (X:<OR FIX FLOAT FALSE> <>)
+ (Y:<OR FIX FLOAT FALSE> <>)
+ (FONT:<OR FONT STRING FALSE> <>)
+ (DOP:<OR FIX FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>) ODOP
+ (CFONT <VW-CFONT .VW>) (RFONT .CFONT) HIGH
+ (PP <STACK <VECTOR .X .Y>>))
+ <COND (<TYPE? .CHRS CHARACTER> <SET CHRS <1 ,BUF1 .CHRS>> <SET LENGTH 1>)
+ (<NOT .LENGTH> <SET LENGTH <LENGTH .CHRS>>)
+ (T <SET LENGTH <MIN .LENGTH <LENGTH .CHRS>>>)>
+ <COND
+ (<G? .LENGTH 0>
+ <COND
+ (<COND (<NOT .FONT> T)
+ (<TYPE? .FONT FONT> <SET RFONT .FONT>)
+ (T <SET RFONT <GET-FONT .FONT <VW-VS100 .VW>>>)>
+ <GET-COORDS .VW .PP>
+ <SET X <1 .PP>>
+ <SET Y <2 .PP>>
+ <COND (<==? .DOP <SET ODOP <VW-TEXT-OP .VW>>> <SET DOP <>>)>
+ <COND (<OR <N==? .RFONT .CFONT>
+ <N==? .Y:FIX <VW-Y .VW>>
+ <N==? .X:FIX <VW-X .VW>>
+ .DOP>
+ <CURSOR-OFF .VW>
+ <COND (<G? <VW-OCT .VW> 0> <VW-FLUSH-BUFFER .VW T>)>
+ <CHANNEL-OP .CHANNEL MOVE-CURSOR-ABS .X .Y <> <>>
+ <VW-CFONT .VW .RFONT>)>
+ <COND (.DOP <VW-TEXT-OP .VW .DOP>)>
+ <REPEAT ((CT:FIX 0) CHR:CHARACTER (LAST <CHTYPE -1 CHARACTER>))
+ <SET CHR <CHTYPE <ANDB <1 .CHRS> 127> CHARACTER>>
+ <SET CHRS <REST .CHRS>>
+ <SET CT <+ .CT 1>>
+ <COND (<AND <G=? <ASCII .CHR> 33> <L=? <ASCII .CHR> 126>>
+ <VS-CHAR .CHANNEL .VW .CHR>)
+ (<==? .CHR <ASCII 27>> <VS-CHAR .CHANNEL .VW !\$>)
+ (<==? .CHR <ASCII 32>>
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
+ <VW-FLUSH-BUFFER .VW <>>
+ <CHANNEL-OP .CHANNEL UNDERLINE <>>
+ <VS-CHAR .CHANNEL .VW .CHR>
+ <CHANNEL-OP .CHANNEL UNDERLINE T>)
+ (T
+ <VS-CHAR .CHANNEL .VW .CHR>)>)
+ (<AND <==? .CHR <ASCII 10>> <==? .LAST <ASCII 13>>>)
+ (<OR <==? .CHR <ASCII 13>> <==? .CHR <ASCII 10>>>
+ <DO-LF .CHANNEL .VW>)
+ (<==? .CHR <ASCII 9>>
+ <CURSOR-OFF .VW>
+ <VW-FLUSH-BUFFER .VW <>>
+ <SET HIGH <>>
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
+ <SET HIGH <CHANNEL-OP .CHANNEL UNDERLINE <>>>
+ <CURSOR-OFF .VW>)>
+ <PROG ((X <VW-X .VW>) (AW <FONT-WIDTH <VW-CFONT .VW>>)
+ (LEN <- <* 8 .AW> <MOD .X <* 8 .AW>>>) OH)
+ <COND (<G? <SET X <+ .X .LEN>> <VW-WIDTH .VW>>
+ <COND (<SET OH <VW-HIGHLIGHT .VW>>
+ <CHANNEL-OP .CHANNEL SET-HIGHLIGHT <>>)>
+ <VW-X .VW 0>
+ <CHANNEL-OP .CHANNEL DOWN-CURSOR>
+ <CHANNEL-OP .CHANNEL CLEAR-EOL>
+ <COND (.OH
+ <CHANNEL-OP .CHANNEL SET-HIGHLIGHT .OH>)>
+ <VW-X .VW <- .X <VW-WIDTH .VW>>>)
+ (T <VW-X .VW .X>)>
+ <VW-OX .VW .X>>
+ <COND (.HIGH
+ <CHANNEL-OP .CHANNEL UNDERLINE T>)>
+ <CURSOR-ON .VW>)
+ (<==? .CHR <ASCII 7>>
+ <VW-FLUSH-BUFFER .VW>
+ <VSOP <VW-VS100 .VW> X-FEEP 0 <VW-ID .VW>>)
+ (<N==? .CHR <ASCII 127>>
+ <VS-CHAR .CHANNEL
+ .VW
+ !\^
+ <ASCII <ANDB <+ <ASCII .CHR> 64> 127>>>)>
+ <SET LAST .CHR>
+ <COND (<G=? .CT .LENGTH> <RETURN .CT>)>>
+ <COND (<OR .DOP <N==? .CFONT .RFONT>>
+ <VW-FLUSH-BUFFER .VW T>
+ <VW-TEXT-OP .VW .DOP>
+ <VW-CFONT .VW .CFONT>)>
+ .LENGTH)>)>>
+
+<DEFINE DO-LF (CHN:VSCHAN VW:VSW
+ "AUX" (Y <VW-Y .VW>) (X <VW-X .VW>) (HEIGHT <VW-HEIGHT .VW>)
+ (LH <FONT-HEIGHT <VW-CFONT .VW>>)
+ (MODE <VW-OUTMODE .VW>))
+ <CURSOR-OFF .VW>
+ <VW-FLUSH-BUFFER .VW <>>
+ <COND (<G? <SET Y <+ .Y .LH>> <- .HEIGHT .LH>> <SET Y 0>)>
+ <VW-Y .VW .Y>
+ <VW-X .VW 0>
+ <VW-OY .VW .Y>
+ <VW-OX .VW 0>
+ <VS-CLEAR-EOL .CHN CLEAR-EOL>>
+
+<DEFINE VS-CLEAR-EOL (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-CURSOR .VW <>>
+ <VW-FLUSH-BUFFER .VW <>>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT <VW-CFONT .VW>>
+ <- <VW-WIDTH .VW> <VW-X .VW>>
+ <VW-X .VW>
+ <VW-Y .VW>
+ <VW-BG .VW>
+ 0>
+ <CURSOR-ON .VW>>
+
+<DEFINE VS-CLEAR-SCREEN (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-HIGHLIGHT .VW <>>
+ <VW-HIGHX .VW <>>
+ <VW-OUTMODE .VW
+ <ANDB <VW-OUTMODE .VW> <XORB -1 <ORB ,VWM-UNDER ,VWM-INVERT>>>>
+ <VW-CURSOR .VW <>>
+ <VW-OCT .VW 0>
+ <VW-OBUF .VW <VW-TOBUF .VW>>
+ <VW-X .VW 0>
+ <VW-Y .VW 0>
+ <VW-OX .VW 0>
+ <VW-OY .VW 0>
+ <VSOP <VW-VS100 .VW> X-CLEAR <VW-ID .VW>>
+ <CURSOR-ON .VW>
+ <UPDATE-MC .CHN 0 0>>
+
+<DEFINE VS-CLEAR-EOS (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>))
+ <VW-CURSOR .VW <>>
+ <VW-FLUSH-BUFFER .VW <>>
+ <COND (<NOT <0? <VW-X .VW>>>
+ <CHANNEL-OP .CHN CLEAR-EOL>
+ <SET Y <+ .Y <FONT-HEIGHT <VW-CFONT .VW>>>>)>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ <- <VW-HEIGHT .VW> .Y>
+ <VW-WIDTH .VW>
+ 0
+ .Y
+ <VW-BG .VW>
+ 0>
+ <CURSOR-ON .VW>>
+
+<SETG CRLF-STRING <STRING <ASCII 13> <ASCII 10>>>
+
+<DEFINE VS-CHAR (CHN:VSCHAN VW:VSW
+ "TUPLE" CHARS:<<PRIMTYPE VECTOR> [REST CHARACTER]>
+ "AUX" (X:FIX <VW-X .VW>) (FONT:FONT <VW-CFONT .VW>)
+ (WIDTH:FIX <COND (<TYPE? <CHANNEL-USER .CHN> MUD-CHAN>
+ <* <M-HLEN .CHN> <FONT-WIDTH .FONT>>)
+ (T
+ <VW-WIDTH .VW>)>)
+ HIGH UNDER)
+ <MAPF <>
+ <FUNCTION (CHR:CHARACTER "AUX" WID)
+ <COND (<G? <SET X
+ <+ .X <SET WID <CHAR-WIDTH .CHR .FONT>>>>
+ .WIDTH>
+ <OUTPUT-STRING .CHN !\!>
+ <SET HIGH <VW-HIGHLIGHT .VW>>
+ <SET UNDER <CHANNEL-OP .CHN UNDERLINE <>>>
+ <CHANNEL-OP .CHN SET-HIGHLIGHT <>>
+ <VS-NORMAL-OUT .CHN NORMAL-OUT ,CRLF-STRING>
+ <CHANNEL-OP .CHN SET-HIGHLIGHT .HIGH>
+ <CHANNEL-OP .CHN UNDERLINE .UNDER>
+ <SET X .WID>)>
+ <VW-X .VW .X>
+ <OUTPUT-STRING .CHN .CHR>>
+ .CHARS>>
+
+<DEFINE OUTPUT-STRING (CHN:VSCHAN CHR:<OR CHARACTER STRING>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (OBUF <VW-OBUF .VW>)
+ (OCT <VW-OCT .VW>) LEN:FIX)
+ <COND (<TYPE? .CHR CHARACTER> <SET LEN 1> <SET CHR <1 ,BUF1 .CHR>>)
+ (T <SET LEN <LENGTH .CHR>>)>
+ <COND
+ (<NOT .OBUF>
+ <CURSOR-OFF .VW>
+ <VSOP <VW-VS100 .VW>
+ X-TEXT
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
+ <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY> ,GX-COPY-INVERTED)
+ (<==? <VW-TEXT-OP .VW> ,GX-COPY-INVERTED> ,GX-COPY)
+ (T ,GX-EQUIV)>)
+ (T <VW-TEXT-OP .VW>)>
+ -1
+ <VW-ID .VW>
+ <VW-OX .VW>
+ <VW-OY .VW>
+ <FONT-ID <VW-CFONT .VW>>
+ 1 0
+ .LEN
+ 0 0
+ .CHR>
+ <VW-OX .VW <VW-X .VW>>
+ <VW-OY .VW <VW-Y .VW>>
+ <CURSOR-ON .VW>)
+ (T
+ <PROG ((TRANS 0) (CURSOR-IS-OFF <>))
+ <COND (<G? .LEN <SET TRANS <LENGTH .OBUF>>>
+ <COND (<0? .OCT>
+ <CURSOR-OFF .VW>
+ <SET CURSOR-IS-OFF T>
+ <VSOP <VW-VS100 .VW>
+ X-TEXT
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
+ <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY>
+ ,GX-COPY-INVERTED)
+ (<==? <VW-TEXT-OP .VW>
+ ,GX-COPY-INVERTED>
+ ,GX-COPY)
+ (T ,GX-EQUIV)>)
+ (T <VW-TEXT-OP .VW>)>
+ -1
+ <VW-ID .VW>
+ <VW-OX .VW>
+ <VW-OY .VW>
+ <FONT-ID <VW-CFONT .VW>>
+ 1 0
+ .LEN
+ 0 0
+ .CHR>
+ <VW-OX .VW <VW-X .VW>>
+ <VW-OY .VW <VW-Y .VW>>)
+ (T
+ <COND (<NOT <EMPTY? .OBUF>>
+ <SUBSTRUC .CHR 0 .TRANS .OBUF>
+ <VW-OCT .VW <+ .OCT .TRANS>>)>
+ <CURSOR-OFF .VW>
+ <VW-FLUSH-BUFFER .VW <>>
+ <SET CURSOR-IS-OFF T>
+ <SET OCT 0>
+ <SET OBUF <VW-TOBUF .VW>:STRING>
+ <SET CHR <REST .CHR .TRANS>>
+ <SET LEN <- .LEN .TRANS>>
+ <AGAIN>)>)
+ (T
+ <SUBSTRUC .CHR 0 .LEN .OBUF>
+ <VW-OCT .VW <+ .OCT .LEN>>
+ <VW-OBUF .VW <REST .OBUF .LEN>>)>
+ <COND (.CURSOR-IS-OFF <CURSOR-ON .VW>)>>)>>
+
+<DEFINE CURSOR-OFF (VW:VSW)
+ <COND (<VW-CURSOR .VW> <SHOW-CURSOR .VW> <VW-CURSOR .VW <>>)>>
+
+<DEFINE CURSOR-ON (VW:VSW)
+ <COND (<NOT <VW-CURSOR .VW>> <SHOW-CURSOR .VW> <VW-CURSOR .VW T>)>>
+
+<DEFINE SHOW-CURSOR (VW:VSW "AUX" F:FONT (CD <VW-CURS-DESC .VW>))
+ <COND (<TYPE? .CD ATOM>
+ <SET F <VW-CFONT .VW>>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-XOR
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT .F>
+ <FONT-WIDTH .F>
+ <VW-OX .VW>
+ <VW-OY .VW>
+ <VS-WHITE <VW-VS100 .VW>>
+ 0>)
+ (<NOT .CD>)
+ (T
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-XOR
+ -1
+ <VW-ID .VW>
+ <C-HEIGHT .CD>
+ <C-WIDTH .CD>
+ <+ <VW-OX .VW> <C-LEFT .CD>>
+ <+ <VW-OY .VW> <C-TOP .CD>>
+ <VS-WHITE <VW-VS100 .VW>>
+ <C-RASTER .CD>>)>
+ T>
+
+<DEFINE VW-FLUSH-BUFFER (VW:VSW
+ "OPT" (CURS:<OR ATOM FALSE> T)
+ "AUX" (VS:VS <VW-VS100 .VW>) (W:FIX <VW-ID .VW>)
+ F:FONT Y)
+ <COND (<G? <VW-OCT .VW> 0>
+ <SET F <VW-CFONT .VW>>
+ <VSOP <VW-VS100 .VW>
+ X-TEXT
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
+ <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY>
+ ,GX-COPY-INVERTED)
+ (<==? <VW-TEXT-OP .VW> ,GX-COPY-INVERTED>
+ ,GX-COPY)
+ (T ,GX-EQUIV)>)
+ (T <VW-TEXT-OP .VW>)>
+ -1
+ <VW-ID .VW>
+ <VW-OX .VW>
+ <VW-OY .VW>
+ <FONT-ID <VW-CFONT .VW>>
+ 1 0
+ <VW-OCT .VW>
+ 0 0
+ <VW-TOBUF .VW>:STRING>
+ <VW-OX .VW <VW-X .VW>>
+ <VW-OY .VW <VW-Y .VW>>
+ <VW-OCT .VW 0>
+ <VW-OBUF .VW <VW-TOBUF .VW>>)>
+ <COND (<VW-HIGHX .VW>
+ <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
+ <VSOP <VW-VS100 .VW> X-LINE ,GX-XOR -1
+ <VW-ID .VW>
+ <MIN <VW-X .VW> <VW-HIGHX .VW>>
+ <SET Y <- <+ <VW-Y .VW> <FONT-HEIGHT <VW-CFONT .VW>>>
+ 1>>
+ <MAX <VW-X .VW> <VW-HIGHX .VW>>
+ .Y 1 1 1>)>
+ <COND (<VW-HIGHLIGHT .VW>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-XOR
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT <VW-CFONT .VW>>
+ <ABS <- <VW-X .VW> <VW-HIGHX .VW>>>
+ <MIN <VW-X .VW> <VW-HIGHX .VW>>
+ <VW-Y .VW>
+ <VW-HIGHLIGHT .VW>
+ 0>)>
+ <VW-HIGHX .VW <VW-X .VW>>)>
+ <COND (.CURS <CURSOR-ON .VW>)>>
+
+<DEFINE VS-BUFOUT (CHN:VSCHAN OPER
+ "OPT" (FORCE? <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (CDONE? <>))
+ <COND (<G? <VW-OCT .VW> 0>
+ <SET CDONE? T>
+ <CURSOR-OFF .VW>
+ <VW-FLUSH-BUFFER .VW T>)>
+ <COND (.FORCE?
+ <COND (<NOT .CDONE?>
+ <CURSOR-OFF .VW>
+ <CURSOR-ON .VW>)>
+ <VSB-DUMP <VW-VS100 .VW>>)>
+ T>
+
+<DEFINE VS-BUFTREE (CHN:VSCHAN OPER
+ "OPT" (FORCE? <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<G? <VW-OCT .VW> 0> <CURSOR-OFF .VW> <VW-FLUSH-BUFFER .VW T>)>
+ <MAPF <>
+ <FUNCTION (KID:VSCHAN) <CHANNEL-OP .KID BUFTREE <>>>
+ <VW-KIDS .VW>>
+ <COND (.FORCE? <VSB-DUMP <VW-VS100 .VW>>)>
+ T>
+
+<DEFINE VS-DOWN-CURSOR (CHN:VSCHAN OPER
+ "OPT" (CT:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>)
+ (CH <FONT-HEIGHT <VW-CFONT .VW>>))
+ <SET Y <+ .Y <* .CT .CH>>>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y T>>
+
+<DEFINE VS-UP-CURSOR (CHN:VSCHAN OPER
+ "OPT" (CT:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>))
+ <SET Y <- .Y <* .CT <FONT-HEIGHT <VW-CFONT .VW>>>>>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y T>>
+
+<DEFINE VS-HOME-CURSOR (CHN:VSCHAN OPER)
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS 0 0 <> <>>>
+
+<DEFINE VS-BOTTOM-CURSOR (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) H CH)
+ <CHANNEL-OP .CHN
+ MOVE-CURSOR-ABS
+ 0
+ <* <- </ <SET H <VW-HEIGHT .VW>>
+ <SET CH <FONT-HEIGHT <VW-CFONT .VW>>>>
+ 1>
+ .CH>
+ <>
+ <>>>
+
+<DEFINE VS-HOR-POS (CHN:VSCHAN OPER
+ "OPT" X:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<ASSIGNED? X>
+ <CHANNEL-OP .CHN
+ MOVE-CURSOR-ABS
+ <* .X <FONT-WIDTH <VW-CFONT .VW>>>
+ <VW-Y .VW>
+ <>
+ <>>
+ .X)
+ (T </ <VW-X .VW> <FONT-WIDTH <VW-CFONT .VW>>>)>>
+
+<DEFINE VS-VER-POS (CHN:VSCHAN OPER
+ "OPT" Y:<OR FIX FLOAT>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<ASSIGNED? Y>
+ <CHANNEL-OP .CHN
+ MOVE-CURSOR-ABS
+ <VW-X .VW>
+ <* .Y <FONT-HEIGHT <VW-CFONT .VW>>>
+ <>
+ <>>
+ .Y)
+ (T </ <VW-Y .VW> <FONT-HEIGHT <VW-CFONT .VW>>>)>>
+
+<DEFINE VS-HOR-POS-ABS (CHN:VSCHAN OPER
+ "OPT" X:<OR FIX FLOAT>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<ASSIGNED? X>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW>>
+ <VW-X .VW>)
+ (T <VW-X .VW>)>>
+
+<DEFINE VS-VER-POS-ABS (CHN:VSCHAN OPER
+ "OPT" Y:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <COND (<ASSIGNED? Y> <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y>)
+ (T <VW-Y .VW>)>>
+
+<DEFINE VS-MOVE-CURSOR (CHN:VSCHAN OPER X:FIX Y:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) F)
+ <CHANNEL-OP .CHN
+ MOVE-CURSOR-ABS
+ <* .X <FONT-WIDTH <SET F <VW-CFONT .VW>>>>
+ <* .Y <FONT-HEIGHT .F>>
+ T>>
+
+<DEFINE VS-MOVE-CURSOR-ABS (CHN:VSCHAN OPER NX:<OR FIX FLOAT> NY:<OR FIX FLOAT>
+ "OPT" (CHAR?:<OR ATOM FALSE> <>)
+ (SCALE?:<OR ATOM FALSE> <NOT .CHAR?>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) BOT RIGHT
+ (CH <FONT-HEIGHT <VW-CFONT .VW>>)
+ (CW <FONT-WIDTH <VW-CFONT .VW>>) (RCH .CH)
+ (RCW .CW) (PP <STACK <VECTOR .NX .NY>>) X:FIX
+ Y:FIX)
+ <COND (.SCALE? <SCALE-POINT .PP .VW> <SET X <1 .PP>> <SET Y <2 .PP>>)
+ (T
+ <COND (<TYPE? .NX FLOAT> <SET X <FIX <+ .NX 0.5>>>)
+ (T <SET X .NX>)>
+ <COND (<TYPE? .NY FLOAT> <SET Y <FIX <+ .NY 0.5>>>)
+ (T <SET Y .NY>)>)>
+ <COND (<OR <N==? .X <VW-X .VW>> <N==? .Y <VW-Y .VW>>>
+ <CURSOR-OFF .VW>
+ <PROG (YC)
+ <SET YC <>>
+ <COND (.CHAR?
+ <SET BOT </ <VW-HEIGHT .VW> .CH>>
+ <SET RIGHT </ <VW-WIDTH .VW> .CW>>
+ <SET Y </ .Y .CH>>
+ <SET X </ .X .CW>>)
+ (T
+ <SET BOT <VW-HEIGHT .VW>>
+ <SET RIGHT <VW-WIDTH .VW>>
+ <SET CH 1>
+ <SET CW 1>)>
+ <COND (<L? .Y 0>
+ <REPEAT ()
+ <SET Y <+ .Y .BOT>>
+ <COND (<G? .Y 0> <RETURN>)>>)>
+ <COND (<G=? .Y .BOT> <SET Y <MOD .Y .BOT>>)>
+ <COND (.CHAR? <SET Y <* .Y .CH>>)>
+ <COND (<L? .X 0>
+ <REPEAT ()
+ <SET X <+ .X .RIGHT>>
+ <SET Y <+ .Y .CH>>
+ <SET YC T>
+ <COND (<G? .X 0> <RETURN>)>>)>
+ <COND (<G=? .X .RIGHT>
+ <SET Y <+ .Y <* .CH </ .X .RIGHT>>>>
+ <SET YC T>
+ <SET X <MOD .X .RIGHT>>)>
+ <COND (.CHAR? <SET X <* .X .CW>>)>
+ <COND (.YC <AGAIN>)>>
+ <COND (<G? <VW-OCT .VW> 0> <VW-FLUSH-BUFFER .VW <>>)>
+ <VW-X .VW .X>
+ <VW-OX .VW .X>
+ <VW-Y .VW .Y>
+ <VW-OY .VW .Y>
+ <CURSOR-ON .VW>)>
+ <UPDATE-MC .CHN </ .X .RCW> </ .Y .RCH>>
+ .CHN>
+
+<DEFINE VS-FORWARD-CURSOR (CHN:VSCHAN OPER
+ "OPT" (CT:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) X)
+ <SET X <+ <VW-X .VW> <* .CT <FONT-WIDTH <VW-CFONT .VW>>>>>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW> T>>
+
+<DEFINE VS-BACK-CURSOR (CHN:VSCHAN OPER
+ "OPT" (CT:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) X)
+ <SET X <- <VW-X .VW> <* .CT <FONT-WIDTH <VW-CFONT .VW>>>>>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW> T>>
+
+<DEFINE DESTROY-CURSOR (CD:<OR CURSOR ATOM> VS:VS)
+ <COND (<TYPE? .CD ATOM>)
+ (T
+ <C-REF .CD <- <C-REF .CD> 1>>
+ <COND (<L=? <C-REF .CD> 0>
+ <VSOP .VS X-FREE-CURSOR 0 <C-CURSOR .CD>>
+ <COND (<NOT <0? <C-MASK .CD>>>
+ <VSOP .VS X-FREE-BITMAP 0 <C-MASK .CD>>)>
+ <VSOP .VS X-FREE-BITMAP 0 <C-RASTER .CD>>)>)>
+ T>
+
+<DEFINE VS-MOUSE-CURSOR (CHN:VSCHAN OPER
+ "OPT" PATTERN:<OR STRING BYTES FALSE CURSOR ATOM>
+ WIDTH:FIX HEIGHT:FIX (TOP:FIX 0) (LEFT:FIX 0)
+ (MASK:<OR FALSE STRING BYTES> <>)
+ (DISPLAY:FIX ,GX-XOR)
+ (PRESERVE?:<OR ATOM FALSE> T)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) (OLD <VW-MOUSE-DESC .VW>)
+ R CURSOR)
+ <COND (<AND <ASSIGNED? PATTERN> <N=? .PATTERN .OLD>>
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<TYPE? .PATTERN CURSOR>
+ <COND (<G? <C-REF .PATTERN> 0>
+ <C-REF .PATTERN <+ <C-REF .PATTERN> 1>>
+ <VW-MOUSE-DESC .VW .PATTERN>)
+ (T
+ <ERROR DEAD-CURSOR!-ERRORS
+ .PATTERN
+ MOUSE-CURSOR>)>)
+ (<OR <NOT .PATTERN> <TYPE? .PATTERN ATOM>>
+ <COND (<TYPE? .OLD CURSOR> <DESTROY-CURSOR .OLD .VS>)>
+ <VW-MOUSE-DESC .VW .PATTERN>)
+ (<SET PATTERN
+ <MAKE-PATTERN .VS
+ .PATTERN
+ .WIDTH
+ .HEIGHT
+ .TOP
+ .LEFT
+ .MASK
+ .DISPLAY>>
+ <COND (<AND <TYPE? .OLD CURSOR> <NOT .PRESERVE?>>
+ <DESTROY-CURSOR .OLD .VS>)>
+ <VW-MOUSE-DESC .VW .PATTERN>)>
+ <COND (<NOT <VW-MOUSE-DESC .VW>>
+ <VSOP .VS X-DEFINE-CURSOR <VW-ID .VW> 0>)
+ (<TYPE? <VW-MOUSE-DESC .VW> ATOM>
+ <VSOP .VS
+ X-DEFINE-CURSOR <VW-ID .VW> 0>)
+ (T
+ <VSOP .VS
+ X-DEFINE-CURSOR
+ <VW-ID .VW>
+ <C-CURSOR <SET CURSOR <VW-MOUSE-DESC .VW>>>>)>)>
+ .OLD>
+
+<DEFINE MAKE-PATTERN
+ (VS:VS PATTERN:<OR STRING BYTES> WIDTH:FIX HEIGHT:FIX TOP:FIX LEFT:FIX
+ "OPT" (MASK:<OR STRING BYTES FALSE> <>) (DISPLAY:FIX ,GX-XOR)
+ "AUX" R (NR 0) CURSOR)
+ <COND (<N==? <LENGTH .PATTERN> <* 2 .HEIGHT </ <+ .WIDTH 15> 16>>>
+ <ERROR CURSOR-PATTERN-WRONG-LENGTH!-ERRORS
+ .PATTERN
+ .WIDTH
+ .HEIGHT
+ MAKE-PATTERN>)
+ (<AND .MASK <N==? <LENGTH .PATTERN> <LENGTH .MASK>>>
+ <ERROR MASK-IS-WRONG-LENGTH!-ERRORS
+ .MASK
+ .PATTERN
+ MAKE-PATTERN>)
+ (<SET R <VSOP .VS X-STORE-BITMAP 0 .HEIGHT .WIDTH .PATTERN>>
+ <COND (<OR <NOT .MASK>
+ <SET NR
+ <VSOP .VS
+ X-STORE-BITMAP
+ 0
+ .HEIGHT
+ .WIDTH
+ .MASK>>>
+ <COND
+ (<SET CURSOR <VSOP .VS X-STORE-CURSOR
+ .DISPLAY 0 .R 1 0 .NR .TOP .LEFT>>
+ <CHTYPE [.R .NR .HEIGHT .WIDTH .TOP .LEFT 1 .DISPLAY
+ .CURSOR]
+ CURSOR>)
+ (T
+ <VSOP .VS X-FREE-BITMAP 0 .R>
+ <COND (.MASK
+ <VSOP .VS X-FREE-BITMAP 0 .NR>)>
+ .CURSOR)>)
+ (T <VSOP .VS X-FREE-BITMAP 0 .R> .NR)>)>>
+
+<DEFINE VS-TEXT-CURSOR (CHN:VSCHAN OPER
+ "OPT" PATTERN:<OR STRING BYTES FALSE CURSOR ATOM>
+ WIDTH:FIX HEIGHT:FIX (TOP:FIX 0) (LEFT:FIX 0)
+ (PRESERVE?:<OR ATOM FALSE> T)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) (OLD <VW-CURS-DESC .VW>)
+ R)
+ <COND (<ASSIGNED? PATTERN>
+ <VW-FLUSH-BUFFER .VW>
+ <CURSOR-OFF .VW>
+ <COND (<TYPE? .PATTERN CURSOR>
+ <COND (<L=? <C-REF .PATTERN> 0>
+ <ERROR DEAD-CURSOR!-ERRORS .PATTERN TEXT-CURSOR>)
+ (T
+ <C-REF .PATTERN <+ <C-REF .PATTERN> 1>>
+ <VW-CURS-DESC .VW .PATTERN>)>)
+ (<OR <NOT .PATTERN> <TYPE? .PATTERN ATOM>>
+ <COND (<AND .OLD
+ <NOT <TYPE? .OLD ATOM>>
+ <NOT .PRESERVE?>>
+ <DESTROY-CURSOR .OLD .VS>)>
+ <VW-CURS-DESC .VW .PATTERN>)
+ (T
+ <COND (<SET PATTERN
+ <MAKE-PATTERN .VS
+ .PATTERN
+ .WIDTH
+ .HEIGHT
+ .TOP
+ .LEFT>>
+ <COND (.OLD <DESTROY-CURSOR .OLD .VS>)>
+ <VW-CURS-DESC .VW .PATTERN>)>)>
+ <CURSOR-ON .VW>)>
+ .OLD>
+
+<DEFINE VS-DISPLAY-CURSOR (CHN:VSCHAN OPER PAT:<OR CURSOR ATOM FALSE>
+ "OPT" (X:<OR FIX FLOAT FALSE> <>)
+ (Y:<OR FIX FLOAT FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (PP <STACK <VECTOR .X .Y>>) F)
+ <VW-FLUSH-BUFFER .VW>
+ <GET-COORDS .VW .PP>
+ <COND (<==? .PAT TEXT-CURSOR> <SET PAT <VW-CURS-DESC .VW>>)
+ (<TYPE? .PAT ATOM> <SET PAT <VW-MOUSE-DESC .VW>>)>
+ <COND (<NOT .PAT>)
+ (<NOT <TYPE? .PAT CURSOR>>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-XOR
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT <SET F <VW-CFONT .VW>>>
+ <FONT-WIDTH .F>
+ <1 .PP>
+ <2 .PP>
+ <VS-WHITE <VW-VS100 .VW>>
+ 0>)
+ (T
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-XOR
+ -1
+ <VW-ID .VW>
+ <C-HEIGHT .PAT>
+ <C-WIDTH .PAT>
+ <+ <1 .PP>:FIX <C-LEFT .PAT>>
+ <+ <2 .PP>:FIX <C-TOP .PAT>>
+ <VS-WHITE <VW-VS100 .VW>>
+ <C-RASTER .PAT>>)>>
+
+<DEFINE VS-FRESH-LINE (CHN:VSCHAN OPER
+ "OPT" (N:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (H <FONT-HEIGHT <VW-CFONT .VW>>))
+ <COND (<NOT <0? <VW-X .VW>>>
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS 0 <+ <VW-Y .VW> .H> <> T>
+ <CHANNEL-OP .CHN CLEAR-EOL>
+ <SET N <- .N 1>>)>
+ <COND (<G? .N 0>
+ <REPEAT ()
+ <CHANNEL-OP .CHN
+ MOVE-CURSOR-ABS
+ 0
+ <+ <VW-Y .VW> .H>
+ <>
+ T>
+ <COND (<L=? <SET N <- .N 1>> 0> <RETURN>)>>)>
+ .CHN>
+
+<DEFINE VS-BIT-BLT
+ (CHN:VSCHAN OPER HEIGHT:FIX WIDTH:FIX SLEFT:FIX STOP:FIX DLEFT:FIX
+ DTOP:FIX
+ "OPT" (FCN:FIX ,GX-COPY) (DOCURS?:<OR ATOM FALSE> T)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>))
+ <COND (.DOCURS? <CURSOR-OFF .VW>)>
+ <VW-FLUSH-BUFFER .VW <>>
+ <VSOP .VS
+ X-COPY-AREA
+ .FCN
+ -1
+ <VW-ID .VW>
+ .HEIGHT
+ .WIDTH
+ .SLEFT
+ .STOP
+ .DLEFT
+ .DTOP>
+ <COND (.DOCURS? <CURSOR-ON .VW>)>
+ .CHN>
+
+<DEFINE VS-INSERT-LINE (CHN:VSCHAN OPER
+ "OPT" (N:FIX 1) (TOP:<OR FALSE FIX> <>)
+ (BOT:<OR FALSE FIX> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (FONT <VW-CFONT .VW>) (H:FIX <FONT-HEIGHT .FONT>)
+ TEMP (RBOT <- <VW-HEIGHT .VW> 1>))
+ <COND (<NOT .TOP> <SET TOP <VW-Y .VW>>) (T <SET TOP <* .TOP .H>>)>
+ <COND (<NOT .BOT> <SET BOT .RBOT>) (T <SET BOT <* .BOT .H>>)>
+ <COND (<G? .TOP .BOT> <SET TEMP .BOT> <SET BOT .TOP> <SET TOP .TEMP>)>
+ <COND (<AND <L=? .TOP .RBOT> <NOT <0? .N>>>
+ <SET BOT <MIN .BOT .RBOT>>
+ <CURSOR-OFF .VW>
+ <CHANNEL-OP .CHN
+ BIT-BLT
+ <- .BOT .TOP <* <ABS .N> .H>>
+ <VW-WIDTH .VW>
+ 0
+ <COND (<G? .N 0> .TOP) (T <+ .TOP <* <- .N> .H>>)>
+ 0
+ <COND (<G? .N 0> <+ .TOP <* .N .H>>) (T .TOP)>
+ ,GX-COPY
+ <>>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ <* <ABS .N> .H>
+ <VW-WIDTH .VW>
+ 0
+ <COND (<G? .N 0> .TOP) (T <+ .BOT <* .N .H>>)>
+ <VW-BG .VW>
+ 0>
+ <CURSOR-ON .VW>
+ .CHN)>>
+
+<DEFINE VS-INSERT-CHAR (CHN:VSCHAN OPER
+ "OPT" (N:FIX 1) (LEFT:<OR FALSE FIX> <>)
+ (RIGHT:<OR FALSE FIX> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (FONT <VW-CFONT .VW>) (W:FIX <FONT-WIDTH .FONT>)
+ TEMP (RRIGHT <- <VW-WIDTH .VW> 1>))
+ <COND (<NOT .LEFT> <SET LEFT <VW-X .VW>>) (T <SET LEFT <* .LEFT .W>>)>
+ <COND (<NOT .RIGHT> <SET RIGHT .RRIGHT>) (T <SET RIGHT <* .RIGHT .W>>)>
+ <COND (<G? .LEFT .RIGHT>
+ <SET TEMP .LEFT>
+ <SET LEFT .RIGHT>
+ <SET RIGHT .TEMP>)>
+ <COND (<AND <L=? .LEFT .RRIGHT> <NOT <0? .N>>>
+ <CURSOR-OFF .VW>
+ <CHANNEL-OP .CHN
+ BIT-BLT
+ <FONT-HEIGHT .FONT>
+ <- .RIGHT .LEFT <* <ABS .N> .W>>
+ <COND (<G? .N 0> .LEFT) (T <+ .LEFT <* <- .N> .W>>)>
+ <VW-Y .VW>
+ <COND (<G? .N 0> <+ .LEFT <* .N .W>>) (T .LEFT)>
+ <VW-Y .VW>
+ ,GX-COPY
+ <>>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT .FONT>
+ <* <ABS .N> .W>
+ <COND (<G? .N 0> .LEFT) (T <+ .RIGHT <* .N .W>>)>
+ <VW-Y .VW>
+ <VW-BG .VW>
+ 0>
+ <CURSOR-ON .VW>
+ .CHN)>>
+
+<DEFINE VS-ERASE-CHAR (CHN:VSCHAN OPER
+ "OPTIONAL" (N:FIX 1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (X <VW-X .VW>)
+ (FONT <VW-CFONT .VW>) (W <FONT-WIDTH .FONT>)
+ (H <FONT-HEIGHT .FONT>) (VS:VS <VW-VS100 .VW>))
+ <COND
+ (<G? .N 0>
+ <VW-FLUSH-BUFFER .VW>
+ <REPEAT (NX (NY <VW-Y .VW>) (DIST <* .N .W>))
+ <COND
+ (<G=? .X .W>
+ <COND (<G? .DIST .X> <SET NX 0> <SET DIST <- .DIST .X>>)
+ (T <SET NX <- .X .DIST>> <SET DIST 0>)>
+ <VSOP .VS
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ .H
+ <- .X .NX>
+ .NX
+ .NY
+ <VW-BG .VW>
+ 0>
+ <COND (<G? .DIST 0>
+ <COND (<L? <SET NY <- .NY .H>> 0>
+ <SET NY <- <* </ <VW-HEIGHT .VW> .H> .H> .H>>)>
+ <SET X <- <VW-WIDTH .VW> .W>>)
+ (T
+ <CHANNEL-OP .CHN MOVE-CURSOR-ABS .NX .NY <> <>>
+ <RETURN>)>)>>)>>
+
+<DEFINE VS-KILL-CHAR (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (FONT <VW-CFONT .VW>))
+ <CHANNEL-OP .CHN BACK-CURSOR>
+ <CURSOR-OFF .VW>
+ <VSOP <VW-VS100 .VW>
+ X-TILE-FILL
+ ,GX-COPY
+ -1
+ <VW-ID .VW>
+ <FONT-HEIGHT .FONT>
+ <FONT-WIDTH .FONT>
+ <VW-X .VW>
+ <VW-Y .VW>
+ <VW-BG .VW>
+ 0>
+ <CHANNEL-OP .CHN FORWARD-CURSOR>>
+
+\f
+
+<DEFINE ICON? (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-REAL .VW>>
+
+<DEFINE ICONIFIED? (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <VW-ICON .VW>>
+
+<DEFINE INVERT-ICON (CHN:<OR VSCHAN FALSE> OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>))
+ <COND (<NOT <VW-REAL .VW>>
+ <SET CHN <VW-ICON .VW>>)>
+ <COND (.CHN
+ <SET VW <CHANNEL-DATA .CHN>>
+ <CHANNEL-OP .CHN
+ CHANGE-COLOR
+ <COND (<==? <VW-BG .VW> <VS-BLACK .VS>>
+ <VS-WHITE .VS>)
+ (T
+ <VS-BLACK .VS>)>
+ <COND (<==? <VW-BORDER .VW> <VS-BLACK .VS>>
+ <VS-WHITE .VS>)
+ (T
+ <VS-WHITE .VS>)>>
+ <CHANNEL-OP .CHN REDISPLAY-ICON>
+ T)>>
+
+<DEFINE ICONIFY (CHN:VSCHAN OPER X:FIX Y:FIX
+ "OPT" (IN?:<OR VSCHAN FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) FONT NCH NAME:STRING
+ WID:FIX HIGH:FIX)
+ <COND (<VW-REAL .VW> #FALSE ("CAN'T ICONIFY AN ICON"))
+ (<VW-ICON .VW>)
+ (<SET FONT <GET-FONT ,INITIAL-FONT .VS>>
+ <SET NAME <CHANNEL-NAME .CHN>>
+ <SET HIGH <+ 8 <FONT-HEIGHT .FONT>>>
+ <SET WID <+ 8 <* <FONT-WIDTH .FONT> <LENGTH .NAME>>>>
+ <COND (<SET NCH <CHANNEL-OPEN VS100 <STRING "ICON-" .NAME>
+ <OR .IN? .VS>
+ .HIGH .WID .X .Y
+ 1 BLACK WHITE
+ ,INITIAL-FONT
+ <>>>
+ <VW-ICON .VW .NCH>
+ <CHANNEL-OP .NCH MOUSE-CURSOR !,CROSS-CURSOR
+ ,GX-COPY-INVERTED <>>
+ <CHANNEL-OP .NCH TEXT-CURSOR <>>
+ <SET VW <CHANNEL-DATA .NCH>>
+ <VW-REAL .VW .CHN>
+ <CHANNEL-OP .CHN UNMAP>
+ <CHANNEL-OP .NCH REDISPLAY-ICON>
+ .NCH)>)>>
+
+<DEFINE REDISPLAY-ICON (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ REAL:<OR VSCHAN FALSE> (VS:VS <VW-VS100 .VW>)
+ NAME:STRING)
+ <COND (<NOT <SET REAL <VW-REAL .VW>>>
+ <COND (<SET REAL <VW-ICON .VW>>
+ <SET REAL .CHN>
+ <SET CHN <VW-ICON .VW>>
+ <SET VW <CHANNEL-DATA .CHN>>)>)>
+ <COND (.REAL
+ <VSOP .VS X-CLEAR <VW-ID .VW>>
+ <VSOP .VS X-TILE-FILL ,GX-COPY -1 <VW-ID .VW>
+ <VW-HEIGHT .VW> <VW-WIDTH .VW> 0 0 <VS-GRAY .VS> 0>
+ <VSOP .VS X-TEXT <COND (<==? <VW-BG .VW> <VS-WHITE .VS>>
+ ,GX-COPY-INVERTED)
+ (T
+ ,GX-COPY)>
+ -1
+ <VW-ID .VW> 4 4
+ <FONT-ID <VW-CFONT .VW>>
+ 1 0
+ <LENGTH <SET NAME <CHANNEL-NAME .REAL>>>
+ 0 0
+ .NAME>
+ <VSB-DUMP .VS>)>>
+
+<DEFINE DE-ICONIFY (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ REAL)
+ <COND (<SET REAL <VW-REAL .VW>>
+ ; "We were given the icon"
+ <VW-REAL .VW <>>
+ ; "Break the link, so close won't kill the real thing"
+ <CLOSE .CHN>
+ <CHANNEL-OP .REAL MAP>
+ <VW-ICON <CHANNEL-DATA .REAL>:VSW <>>
+ .REAL)
+ (<SET REAL <VW-ICON .VW>>
+ ; "Well, there is an icon"
+ <CHANNEL-OP .REAL DE-ICONIFY>)>>
+
+<DEFINE MOUSE-LOWER-WINDOW (CHN:VSCHAN OPER EVENT:MOUSE-EVENT "OPT" (SLOP:FIX 20)
+ (ICON-PARENT:<OR VSCHAN FALSE> <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>)
+ OLD-X:FIX OLD-Y:FIX
+ (OLD-EVENT <ME-KIND .EVENT>) OLD
+ EXEVENT VAL P (UV <STACK <IUVECTOR 2>>))
+ <COND
+ (<VW-REAL .VW>
+ <CHANNEL-OP .CHN LOWER-WINDOW>)
+ (T
+ <CHANNEL-OP .CHN INTERPRET-LOCATOR <ME-LOCATOR .EVENT> .UV>
+ ; "Get coordinates relative to this window"
+ <SET OLD-X <1 .UV>>
+ <SET OLD-Y <2 .UV>>
+ <COND (<==? .OLD-EVENT ,ME-LEFT-PRESSED> <SET EXEVENT ,ME-LEFT-RELEASED>)
+ (<==? .OLD-EVENT ,ME-MIDDLE-PRESSED> <SET EXEVENT ,ME-MIDDLE-RELEASED>)
+ (<==? .OLD-EVENT ,ME-RIGHT-PRESSED> <SET EXEVENT ,ME-RIGHT-RELEASED>)
+ (T <SET EXEVENT ,ME-LEFT-RELEASED>)>
+ <SET OLD <CHANNEL-OP .CHN MOUSE-MOVE? T>>
+ <SET SLOP <* .SLOP .SLOP>>
+ <SET VAL
+ <GRAB-MOUSE-AND-DO
+ <BIND (VAL)
+ <REPEAT (EV (ICON? <>) KIND TFIX:FIX NEW-CURS)
+ <COND
+ (<SET EV <CHANNEL-OP .CHN READ-BYTE-IMMEDIATE>>
+ <COND
+ (<TYPE? .EV MOUSE-EVENT>
+ <COND (<==? <SET KIND <ME-KIND .EV>> .EXEVENT>
+ <COND (.ICON?
+ <DESTROY-CURSOR .NEW-CURS .VS>
+ <SET P <VSOP .VS X-INTERPRET-LOCATOR
+ <VW-ID
+ <CHANNEL-DATA
+ <OR .ICON-PARENT
+ <VS-TOPCHAN .VS>>:VSCHAN>:VSW>
+ <ME-LOCATOR .EV>>>
+ <SET VAL
+ <CHANNEL-OP .CHN ICONIFY <I-SPAR2 .P:UVECTOR>
+ <I-SPAR3 .P:UVECTOR> .ICON-PARENT>>)
+ (T
+ <CHANNEL-OP .CHN LOWER-WINDOW>
+ <SET VAL .CHN>)>
+ <RECYCLE-EVENTS .EV>
+ <RETURN .VAL>)
+ (<NOT <0? <ANDB .KIND ,ME-PRESSED-MASK>>>
+ <RETURN <>>)
+ (<==? .KIND ,MOUSE-MOVED>
+ <COND (<AND <NOT .ICON?>
+ <G? <+ <* <SET TFIX <- <ME-X .EV> .OLD-X>> .TFIX>
+ <* <SET TFIX <- <ME-Y .EV> .OLD-Y>> .TFIX>>
+ .SLOP>>
+ <SET ICON? T>
+ <SET NEW-CURS
+ <MAKE-PATTERN .VS !,ICONIFY-CURSOR ,GX-COPY>>
+ <VSOP .VS X-UNGRAB-MOUSE 0>
+ <VSOP .VS X-GRAB-MOUSE
+ <VW-ID .VW> <C-CURSOR .NEW-CURS>
+ <VW-INPUTS .VW>>)>)>)>
+ <RECYCLE-EVENTS .EV>)
+ (T
+ <RETURN .EV>)>>
+ <CHANNEL-OP .CHN MOUSE-MOVE? .OLD>>
+ .CHN
+ !,CROSS-CURSOR>>
+ .VAL)>>
+
+<DEFMAC GRAB-MOUSE-AND-DO ('GM-THING 'GM-W GM-PATTERN GM-WIDTH GM-HEIGHT
+ "OPT" (GM-TOP 0) (GM-LEFT 0) (GM-MASK <>)
+ (GM-DISPLAY ,GX-COPY-INVERTED))
+ <FORM BIND (('GM-VW:VSW <FORM CHANNEL-DATA .GM-W>)
+ 'GM-CURS:CURSOR GM-VAL GM-OCM ('GM-VS:VS <FORM VW-VS100 '.GM-VW>)
+ (GM-ID <FORM VW-ID '.GM-VW>))
+ <FORM UNWIND
+ <FORM BIND (P ('MOUSE-GRABBED?:<SPECIAL ATOM> T))
+ <FORM COND (<FORM NOT
+ <FORM SET GM-CURS <FORM MAKE-PATTERN '.GM-VS
+ .GM-PATTERN .GM-WIDTH
+ .GM-HEIGHT .GM-TOP .GM-LEFT
+ .GM-MASK .GM-DISPLAY>>>
+ <FORM ERROR CANT-MAKE-CURSOR!-ERRORS '.GM-CURS GRAB-MOUSE>)>
+ <FORM
+ COND
+ (<FORM SET P <FORM VSOP '.GM-VS X-QUERY-WINDOW '.GM-ID>>
+ <FORM SET GM-OCM 0 ;<FORM I-SPAR6 '.P>>
+ <FORM VSOP '.GM-VS X-CLIPMODE 1 '.GM-ID>
+ <FORM
+ COND
+ (<FORM VSOP '.GM-VS
+ X-GRAB-MOUSE '.GM-ID
+ <FORM C-CURSOR '.GM-CURS>
+ <FORM VW-INPUTS '.GM-VW>>
+ <FORM SET GM-VAL .GM-THING>
+ <FORM VSOP '.GM-VS X-CLIPMODE '.GM-OCM '.GM-ID>
+ <FORM VSOP '.GM-VS X-UNGRAB-MOUSE 0>
+ <FORM DESTROY-CURSOR '.GM-CURS '.GM-VS>
+ '.GM-VAL)>)>>
+ <FORM COND (<FORM ASSIGNED? GM-CURS>
+ <FORM VSOP '.GM-VS X-CLIPMODE '.GM-OCM '.GM-ID>
+ <FORM VSOP '.GM-VS X-UNGRAB-MOUSE 0>
+ <FORM DESTROY-CURSOR '.GM-CURS '.GM-VS>)>>>>
+
+<DEFINE MOUSE-OPEN-WINDOW MOW
+ (DESC:<OR FALSE <PRIMTYPE LIST> VSCHAN> OPER NAME:STRING
+ "OPT" (BWIDTH:<OR FIX FALSE> <>) (BPATTERN:<OR ATOM FIX FALSE> <>)
+ (BACKGROUND:<OR ATOM FIX FALSE> <>) (FONT:<OR STRING FALSE> <>)
+ (BUF? T) (DEFAULT-HEIGHT:FIX 24) (DEFAULT-WIDTH:FIX 80)
+ (MIN-HEIGHT:FIX 2) (MIN-WIDTH:FIX 2)
+ "AUX" VW:VSW (SPEC? <>) VS:VS OLD PID NVS:<OR FALSE VS>
+ RFONT:<OR FALSE FONT>
+ MH:FIX MW:FIX DH:FIX DW:FIX PARENT:VSCHAN P OLD-CURSOR TOP:FIX
+ LEFT:FIX WIDTH:FIX HEIGHT:FIX MY-FONT:FONT MY-WIND MY-WIDTH
+ VAL)
+ <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
+ <COND (<NOT <TYPE? .DESC CHANNEL>>
+ <COND (<SET NVS <GET-VS100 .DESC>> <SET PARENT <VS-TOPCHAN .NVS>>)
+ (<RETURN .NVS .MOW>)>)
+ (T <SET PARENT .DESC>)>
+ <SET VW <CHANNEL-DATA .PARENT>>
+ <SET VS <VW-VS100 .VW>>
+ <SET PID <VW-ID .VW>>
+ <VW-FLUSH-BUFFER .VW>
+ <SET MY-FONT <GET-FONT ,INITIAL-FONT .VS>>
+ <COND (<NOT .FONT>
+ <COND (<N==? .PARENT .DESC>
+ <SET FONT ,INITIAL-FONT>)
+ (T
+ <SET FONT <FONT-NAME <VW-CFONT .VW>>>)>)>
+ <COND (<NOT <SET RFONT <GET-FONT .FONT .VS>>>
+ <RETURN .RFONT .MOW>)>
+ <SET MH <+ <* .BWIDTH 2> <* .MIN-HEIGHT <SET DH <FONT-HEIGHT .RFONT>>>>>
+ <SET MW <+ <* .BWIDTH 2> <* .MIN-WIDTH <SET DW <FONT-WIDTH .RFONT>>>>>
+ <SET OLD <CHANNEL-OP .PARENT MOUSE-MOVE? T>>
+ <COND (<TYPE? .DESC CHANNEL>
+ <CHANNEL-OP .PARENT RAISE-WINDOW>)>
+ <SET MY-WIND
+ <VSOP .VS
+ X-CREATE-WINDOW
+ 2
+ <VW-ID <CHANNEL-DATA <VS-TOPCHAN .VS>:CHANNEL>:VSW>
+ <FONT-HEIGHT .MY-FONT>
+ <SET MY-WIDTH <* <FONT-WIDTH .MY-FONT> <+ 10 <LENGTH .NAME>>>>
+ 0
+ 0
+ <VS-WHITE .VS>
+ <VS-BLACK .VS>>>
+ <VSOP .VS X-MAP-WINDOW .MY-WIND>
+ <SETG DRAW-CHANGED? T>
+ <SETG DRAW-ODD? -1>
+ <GRAB-MOUSE-AND-DO
+ <COND
+ (<SET P <VSOP .VS X-QUERY-MOUSE .PID>>
+ <SET TOP <I-SPAR3 .P:UVECTOR>>
+ <SET LEFT <I-SPAR2 .P:UVECTOR>>
+ <SET WIDTH .MW>
+ <SET HEIGHT .MH>
+ <REPEAT ((DRAW? T) E (LOC? <>) KIND (NEW-SIZE? T)
+ (TV <STACK <UVECTOR 0 15000>>)
+ (FH:FIX <CHANNEL-OP <VS-CHANNEL .VS> FILE-HANDLE>)
+ (RD:FIX <LSH 1 .FH>) (MX:FIX <+ .FH 1>)
+ (VV <STACK <IUVECTOR 1>>) CT:<OR FIX FALSE>)
+ <COND (.DRAW? <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>)>
+ <COND (.NEW-SIZE?
+ <UPDATE-SIZE .VS
+ .MY-WIND
+ .MY-FONT
+ .NAME
+ .BWIDTH
+ .WIDTH
+ .HEIGHT
+ .DW
+ .DH>)>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <SET NEW-SIZE? <>>
+ <SET DRAW? <>>
+ <COND
+ (<OR <NOT <SET CT <CALL SYSCALL SELECT .MX <1 .VV .RD> 0 0 .TV>>>
+ <0? .CT>>
+ <SET E <>>
+ <SET DRAW? T>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <CALL SYSCALL SELECT 0 0 0 0 .TV>)
+ (<TYPE? <SET E <CHANNEL-OP .PARENT READ-BYTE-IMMEDIATE T>>
+ MOUSE-EVENT>
+ <COND (<==? <SET KIND <ME-KIND .E>> ,ME-MOVED>
+ <SET DRAW? T>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <COND (.LOC?
+ <SET NEW-SIZE? T>
+ <SETG DRAW-CHANGED? T>
+ <SET HEIGHT <- <ME-Y .E> .TOP>>
+ <COND (<L? <ABS .HEIGHT> .MH>
+ <COND (<L? .HEIGHT 0> <SET HEIGHT <- .MH>>)
+ (T <SET HEIGHT .MH>)>)>
+ <SET WIDTH <- <ME-X .E> .LEFT>>
+ <COND (<L? <ABS .WIDTH> .MW>
+ <COND (<L? .WIDTH 0> <SET WIDTH <- .MW>>)
+ (T <SET WIDTH .MW>)>)>)
+ (T
+ <SETG DRAW-CHANGED? T>
+ <SET TOP <ME-Y .E>>
+ <SET LEFT <ME-X .E>>)>)
+ (.LOC?
+ <COND (<==? .KIND ,ME-MIDDLE-RELEASED>
+ <RECYCLE-EVENTS .E>
+ <RETURN>)>)
+ (<==? .KIND ,ME-LEFT-PRESSED>
+ <SET SPEC? 1>
+ <RECYCLE-EVENTS .E>
+ <RETURN>)
+ (<==? .KIND ,ME-RIGHT-PRESSED>
+ <SET SPEC? 2>
+ <RECYCLE-EVENTS .E>
+ <RETURN>)
+ (<==? .KIND ,ME-MIDDLE-PRESSED>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT MOUSE-MOVE? ,MOUSE-CENTER>
+ <SET LOC? T>
+ <SET DRAW? T>)>)>
+ <RECYCLE-EVENTS .E>>
+ <VSOP .VS X-DESTROY-WINDOW .MY-WIND>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT MOUSE-MOVE? .OLD>
+ <COND (.SPEC?
+ <PROG ((RFONT <GET-FONT .FONT .VS>))
+ <SET WIDTH <* .DEFAULT-WIDTH <FONT-WIDTH .RFONT>>>
+ <COND (<==? .SPEC? 1>
+ <SET HEIGHT <* .DEFAULT-HEIGHT <FONT-HEIGHT .RFONT>>>)
+ (T <SET HEIGHT <- <VW-HEIGHT .VW> .TOP <* 2 .BWIDTH>>>)>>)
+ (T
+ <COND (<L? .HEIGHT 0>
+ <SET TOP <+ .TOP .HEIGHT>>
+ <SET HEIGHT <- .HEIGHT>>)>
+ <COND (<L? .WIDTH 0>
+ <SET LEFT <+ .LEFT .WIDTH>>
+ <SET WIDTH <- .WIDTH>>)>)>
+ <SET VAL
+ <CHANNEL-OPEN VS100
+ .NAME
+ .DESC
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP
+ .BWIDTH
+ .BPATTERN
+ .BACKGROUND
+ .FONT
+ .BUF?
+ .MIN-HEIGHT
+ .MIN-WIDTH>>
+ .VAL)>
+ .PARENT
+ !,CROSS-CURSOR>>
+
+<DEFINE UPDATE-SIZE
+ (VS:VS MY-WIND:FIX MY-FONT:FONT NAME:STRING BWIDTH:FIX WIDTH:FIX
+ HEIGHT:FIX DW:FIX DH:FIX
+ "AUX" (ST <STACK <ISTRING <+ 10 <LENGTH .NAME>>>>)
+ (SS <REST .ST <LENGTH .NAME>>))
+ <SUBSTRUC .NAME 0 <LENGTH .NAME> .ST>
+ <1 .SS !\:>
+ <SET SS <REST .SS>>
+ <SET HEIGHT <ABS .HEIGHT>>
+ <SET WIDTH <ABS .WIDTH>>
+ <SET SS <DUMP-NUMBER .SS <MAX 1 </ <- .HEIGHT <* 2 .BWIDTH>> .DH>>>>
+ <1 .SS !\x>
+ <SET SS <REST .SS>>
+ <DUMP-NUMBER .SS <MAX 1 </ <- .WIDTH <* 2 .BWIDTH>> .DW>>>
+ <VSOP .VS X-CLEAR .MY-WIND>
+ <VSOP .VS
+ X-TEXT
+ ,GX-COPY
+ -1
+ .MY-WIND
+ 0
+ 0
+ <FONT-ID .MY-FONT>
+ 1 0
+ <LENGTH .ST>
+ 0 0
+ .ST>>
+
+<DEFINE DUMP-NUMBER (SS:STRING NUM:FIX "AUX" (BASE:FIX 1000))
+ <REPEAT ((ANY? <>) DIG)
+ <SET DIG </ .NUM .BASE>>
+ <SET NUM <MOD .NUM .BASE>>
+ <COND (<OR .ANY? <NOT <0? .DIG>>>
+ <SET ANY? T>
+ <1 .SS <ASCII <+ .DIG <ASCII !\0>>>>
+ <SET SS <REST .SS>>)
+ (T <1 .SS !\ > <SET SS <REST .SS>>)>
+ <COND (<0? <SET BASE </ .BASE 10>>> <RETURN .SS>)>>>
+
+<GDECL (TEMP-VERTS) STRING
+ (DRAW-CHANGED?) <OR ATOM FALSE>
+ (DRAW-ODD?) FIX>
+
+<DEFINE FDRAW (CH:VSCHAN LEFT:FIX TOP:FIX WIDTH:FIX HEIGHT:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CH>) (VS:VS <VW-VS100 .VW>)
+ VERTS:STRING)
+ <COND (<NOT <GASSIGNED? TEMP-VERTS>>
+ <SETG TEMP-VERTS <ISTRING 30>>
+ <SETG DRAW-ODD? -1>
+ <SETG DRAW-CHANGED? T>)>
+ <SET VERTS ,TEMP-VERTS>
+ <COND (,DRAW-CHANGED?
+ <COND (<L? .WIDTH 0>
+ <SET LEFT <+ .LEFT .WIDTH>>
+ <SET WIDTH <- .WIDTH>>)>
+ <COND (<L? .HEIGHT 0>
+ <SET TOP <+ .TOP .HEIGHT>>
+ <SET HEIGHT <- .HEIGHT>>)>
+ <PUT-WORD .VERTS 1 .LEFT>
+ <PUT-WORD .VERTS 2 .TOP>
+ <PUT-WORD .VERTS 3 0>
+ <PUT-WORD .VERTS 4 .WIDTH>
+ <PUT-WORD .VERTS 5 0>
+ <PUT-WORD .VERTS 6 ,VERTEX-RELATIVE>
+ <PUT-WORD .VERTS 7 0>
+ <PUT-WORD .VERTS 8 .HEIGHT>
+ <PUT-WORD .VERTS 9 ,VERTEX-RELATIVE>
+ <PUT-WORD .VERTS 10 <- .WIDTH>>
+ <PUT-WORD .VERTS 11 0>
+ <PUT-WORD .VERTS 12 ,VERTEX-RELATIVE>
+ <PUT-WORD .VERTS 13 0>
+ <PUT-WORD .VERTS 14 <- .HEIGHT>>
+ <PUT-WORD .VERTS 15 ,VERTEX-RELATIVE>
+ <SETG DRAW-CHANGED? <>>)>
+ <VSOP .VS X-DRAW ,GX-XOR -1 <VW-ID .VW> 5
+ 1 1 1 1 0
+ <LSH *25252525252*
+ <MOD <LSH <SETG DRAW-ODD? <MOD <+ ,DRAW-ODD? 1> 4>> -1> 2>>
+ 16 1
+ .VERTS>>
+
+<DEFINE MOUSE-RESIZE-WINDOW (CH:VSCHAN OPER WHICH:FIX)
+ <COND (<NOT <CHANNEL-OP .CH ICON?>>
+ <MOUSE-MOVE-WINDOW .CH .OPER .WHICH T>)>>
+
+<DEFINE MOUSE-MOVE-WINDOW (CH:VSCHAN OPER WHICH:FIX
+ "OPT" (RESIZE? <>)
+ "AUX" (VW:VSW <CHANNEL-DATA .CH>)
+ (VS:VS <VW-VS100 .VW>)
+ (PARENT:VSCHAN <VW-PARENT .VW>) TOP:FIX LEFT:FIX
+ BOT:FIX RIGHT:FIX
+ WEVENT:FIX
+ (HEIGHT:FIX
+ <+ <* 2 <VW-BWIDTH .VW>> <VW-HEIGHT .VW> -1>)
+ (WIDTH
+ <+ <* 2 <VW-BWIDTH .VW>> <VW-WIDTH .VW> -1>)
+ P:<OR FALSE UVECTOR> MX:FIX MY:FIX
+ PID:FIX OLD (CDIST:FIX <MIN>)
+ TMP MINW:FIX MINH:FIX FH:FIX FW:FIX
+ (MOVE-RIGHT? <>) (MOVE-LEFT? <>)
+ (MOVE-TOP? <>) (MOVE-BOTTOM? <>))
+ <COND (<==? .WHICH ,MOUSE-LEFT> <SET WEVENT ,ME-LEFT-RELEASED>)
+ (<==? .WHICH ,MOUSE-RIGHT> <SET WEVENT ,ME-RIGHT-RELEASED>)
+ (<==? .WHICH ,MOUSE-CENTER> <SET WEVENT ,ME-MIDDLE-RELEASED>)
+ (T <SET WEVENT ,ME-RELEASED-MASK>)>
+ <VW-FLUSH-BUFFER .VW>
+ <COND (<==? .PARENT <VS-TOPCHAN .VS>>
+ <CHANNEL-OP .CH RAISE-WINDOW>)
+ (T
+ <CHANNEL-OP .PARENT RAISE-WINDOW>)>
+ <SET PID <VW-ID <CHANNEL-DATA .PARENT>:VSW>>
+ <SET OLD <CHANNEL-OP .PARENT MOUSE-MOVE? .WHICH>>
+ <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
+ <SET LEFT <I-SPAR2 .P>>
+ <SET TOP <I-SPAR3 .P>>)>
+ <SET RIGHT <+ .LEFT .WIDTH>>
+ <SET BOT <+ .TOP .HEIGHT>>
+ <COND (.RESIZE?
+ <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
+ <SET FH <I-SPAR1 .P>>
+ <SET FW <I-SPAR3 .P>>
+ <SET MINW <MIN <+ 1 <* <VW-BWIDTH .VW> 2>> <I-SPAR2 .P>>>
+ <SET MINH <MIN <+ 1 <* <VW-BWIDTH .VW> 2>> <I-SPAR0 .P>>>)
+ (T
+ <SET FH 1>
+ <SET FW 1>
+ <SET MINW <+ 1 <* 2 <VW-BWIDTH .VW>>>>
+ <SET MINH .MINW>)>)>
+ <GRAB-MOUSE-AND-DO
+ <COND
+ (<SET P <VSOP .VS X-QUERY-MOUSE .PID>>
+ <SET MX <I-SPAR2 .P:UVECTOR>>
+ <SET MY <I-SPAR3 .P:UVECTOR>>
+ <COND (.RESIZE?
+ <BIND ((FT <* <+ .TOP <VW-BWIDTH .VW>> 3>)
+ (FL <* <+ .LEFT <VW-BWIDTH .VW>> 3>)
+ (FW <* .WIDTH 3>)
+ (FH <* .HEIGHT 3>)
+ (FMX <* .MX 3>)
+ (FMY <* .MY 3>))
+ <COND (<L? .FMY <+ .FT .HEIGHT>>
+ <SET MOVE-TOP? T>)
+ (<G? .FMY <+ .FT <* 2 .HEIGHT>>>
+ <SET MOVE-BOTTOM? T>)>
+ <COND (<L? .FMX <+ .FL .WIDTH>>
+ <SET MOVE-LEFT? T>)
+ (<G? .FMX <+ .FL <* 2 .WIDTH>>>
+ <SET MOVE-RIGHT? T>)>
+ <COND (<AND <NOT .MOVE-TOP?> <NOT .MOVE-BOTTOM?>
+ <NOT .MOVE-LEFT?> <NOT .MOVE-RIGHT?>>
+ <COND (<L? <- .FMY .FT> <- <+ .FT .FH> .FMY>>
+ <SET MOVE-TOP? T>)
+ (T
+ <SET MOVE-BOTTOM? T>)>
+ <COND (<L? <- .FMX .FL> <- <+ .FL .FW> .FMX>>
+ <SET MOVE-LEFT? T>)
+ (T
+ <SET MOVE-RIGHT? T>)>)>>)>
+ <SETG DRAW-CHANGED? T>
+ <SETG DRAW-ODD? -1>
+ <REPEAT (E DX:FIX DY:FIX (DRAW? T) (FLUSH? <>)
+ (FH:FIX <CHANNEL-OP <VS-CHANNEL .VS> FILE-HANDLE>)
+ (TV <STACK <UVECTOR 0 15000>>) (MXD:FIX <+ .FH 1>)
+ (VV <STACK <IUVECTOR 1>>) (RD:FIX <LSH 1 .FH>)
+ CT:<OR FIX FALSE>)
+ <COND (.DRAW?
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <SET DRAW? <>>
+ <CHANNEL-OP .PARENT BUFOUT>)>
+ <COND
+ (<OR <NOT <SET CT <CALL SYSCALL SELECT .MXD <1 .VV .RD> 0 0 .TV>>>
+ <0? .CT>>
+ <SET E <>>
+ <SET DRAW? T>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <CALL SYSCALL SELECT 0 0 0 0 .TV>)
+ (<TYPE? <SET E <GET-EVENT .VS <>>> MOUSE-EVENT>
+ <COND
+ (<OR <NOT <0? <ANDB <ME-KIND .E> .WEVENT>>>
+ <SET FLUSH? <NOT <0? <ANDB <ME-KIND .E> ,ME-PRESSED-MASK>>>>>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <CHANNEL-OP .PARENT MOUSE-MOVE? .OLD>
+ <CHANNEL-OP .CH BUFOUT>
+ <COND (.FLUSH?)
+ (.RESIZE?
+ <SET HEIGHT <- .HEIGHT -1 <* 2 <VW-BWIDTH .VW>>>>
+ <SET WIDTH <- .WIDTH -1 <* 2 <VW-BWIDTH .VW>>>>
+ <VW-HEIGHT .VW .HEIGHT>
+ <VW-WIDTH .VW .WIDTH>
+ <COND (<VW-SCALE .VW>
+ <CHANNEL-OP .CH DRAW-LEFT <S-LEFT <VW-SCALE .VW>>>)>
+ <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNSEEN>>
+ <VSOP .VS
+ X-CONFIGURE-WINDOW
+ <VW-ID .VW>
+ .HEIGHT
+ .WIDTH
+ .LEFT
+ .TOP>)
+ (T
+ <VSOP .VS X-MOVE-WINDOW <VW-ID .VW> .LEFT .TOP>)>
+ <RECYCLE-EVENTS .E>
+ <RETURN <NOT .FLUSH?>>)
+ (<==? <ME-KIND .E> ,ME-MOVED>
+ <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
+ <CHANNEL-OP .PARENT BUFOUT>
+ <SETG DRAW-CHANGED? T>
+ <SET DRAW? T>
+ <SET DX <- <ME-X .E> .MX>>
+ <SET DY <- <ME-Y .E> .MY>>
+ <SET MX <ME-X .E>>
+ <SET MY <ME-Y .E>>
+ <COND (.RESIZE?
+ <COND (.MOVE-LEFT?
+ <COND (<L? <- .RIGHT .MX> .MINW>
+ <SET LEFT <- .RIGHT .MINW>>)
+ (T
+ <SET LEFT .MX>)>)
+ (.MOVE-RIGHT?
+ <COND (<L? <- .MX .LEFT> .MINW>
+ <SET RIGHT <+ .LEFT .MINW>>)
+ (T
+ <SET RIGHT .MX>)>)>
+ <COND (.MOVE-TOP?
+ <COND (<L? <- .BOT .MY> .MINH>
+ <SET TOP <- .BOT .MINH>>)
+ (T
+ <SET TOP .MY>)>)
+ (.MOVE-BOTTOM?
+ <COND (<L? <- .MY .TOP> .MINH>
+ <SET BOT <+ .TOP .MINH>>)
+ (T
+ <SET BOT .MY>)>)>
+ <SET WIDTH <- .RIGHT .LEFT>>
+ <SET HEIGHT <- .BOT .TOP>>
+ <COND (<NOT <0? <MOD <SET TMP <- .WIDTH .MINW>> .FW>>>
+ <SET WIDTH <+ .MINW
+ <* .FW
+ </ <FIX <+ .TMP </ .FW 2.0>>>
+ .FW>>>>
+ <COND (.MOVE-LEFT?
+ <SET LEFT <- .RIGHT .WIDTH>>)
+ (.MOVE-RIGHT?
+ <SET RIGHT <+ .LEFT .WIDTH>>)>)>
+ <COND (<NOT <0? <MOD <SET TMP <- .HEIGHT .MINH>> .FH>>>
+ <SET HEIGHT <+ .MINH
+ <* .FH
+ </ <FIX <+ .TMP </ .FH 2.0>>>
+ .FH>>>>
+ <COND (.MOVE-TOP?
+ <SET TOP <- .BOT .HEIGHT>>)
+ (.MOVE-BOTTOM?
+ <SET BOT <+ .TOP .HEIGHT>>)>)>)
+ (T <SET LEFT <+ .DX .LEFT>> <SET TOP <+ .DY .TOP>>)>)>)>
+ <RECYCLE-EVENTS .E>>)>
+ .PARENT
+ !,CROSS-CURSOR>>
+
+<DEFINE PAGE-LOC (CHN:VSCHAN OPER
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>) P)
+ <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
+ <COND (<==? .OPER PAGE-TOP> <I-SPAR3 .P>) (T <I-SPAR2 .P>)>)>>
+
+<DEFINE VS-PAGE-HEIGHT (CHN:VSCHAN OPER
+ "OPT" NEW:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD
+ (CFONT <VW-CFONT .VW>))
+ <SET OLD </ <VW-HEIGHT .VW> <FONT-HEIGHT .CFONT>>>
+ <COND (<ASSIGNED? NEW>
+ <SET NEW <* <FONT-HEIGHT .CFONT> .NEW>>
+ <COND (<L=? .NEW 0>)
+ (T <CHANNEL-OP .CHN RESIZE .NEW <VW-WIDTH .VW>>)>)>
+ .OLD>
+
+<DEFINE VS-PAGE-WIDTH (CHN:VSCHAN OPER
+ "OPT" NEW:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD
+ (CFONT <VW-CFONT .VW>))
+ <SET OLD </ <VW-WIDTH .VW> <FONT-WIDTH .CFONT>>>
+ <COND (<ASSIGNED? NEW>
+ <SET NEW <* <FONT-WIDTH .CFONT> .NEW>>
+ <COND (<L=? .NEW 0>)
+ (T <CHANNEL-OP .CHN RESIZE <VW-HEIGHT .VW> .NEW>)>)>
+ .OLD>
+
+<DEFINE VS-PAGE-WIDTH-ABS (CHN:VSCHAN OPER
+ "OPT" NEW:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD)
+ <SET OLD <VW-WIDTH .VW>>
+ <COND (<ASSIGNED? NEW> <CHANNEL-OP .CHN RESIZE <VW-HEIGHT .VW> .NEW>)>
+ .OLD>
+
+<DEFINE VS-PAGE-HEIGHT-ABS (CHN:VSCHAN OPER
+ "OPT" NEW:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD)
+ <SET OLD <VW-HEIGHT .VW>>
+ <COND (<ASSIGNED? NEW> <CHANNEL-OP .CHN RESIZE .NEW <VW-WIDTH .VW>>)>
+ .OLD>
+
+<DEFINE VS-RESIZE (CHN:VSCHAN OPER HEIGHT:<OR FIX FALSE> WIDTH:<OR FIX FALSE>
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>))
+ <VW-FLUSH-BUFFER .VW>
+ <COND (.HEIGHT <VW-HEIGHT .VW .HEIGHT>)
+ (T <SET HEIGHT <VW-HEIGHT .VW>>)>
+ <COND (.WIDTH <VW-WIDTH .VW .WIDTH>) (T <SET WIDTH <VW-WIDTH .VW>>)>
+ <COND (<VW-SCALE .VW>
+ <CHANNEL-OP .CHN DRAW-LEFT <S-LEFT <VW-SCALE .VW>>>)>
+ <VSOP .VS X-CHANGE-WINDOW <VW-ID .VW> .HEIGHT .WIDTH>
+ <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNSEEN>>
+ .CHN>
+
+<DEFINE VS-MOVE-WINDOW (CHN:VSCHAN OPER LEFT:FIX TOP:FIX
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>))
+ <VW-FLUSH-BUFFER .VW>
+ <VSOP .VS X-MOVE-WINDOW <VW-ID .VW> .LEFT .TOP>>
+
+<DEFINE SET-RESIZE-HINT (CHN:VSCHAN OPER "OPT" (MIN-HEIGHT:FIX -1)
+ (HINCR:FIX -1) (MIN-WIDTH:FIX -1) (WINCR:FIX -1)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
+ P)
+ <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
+ <COND (<L? .MIN-HEIGHT 0> <SET MIN-HEIGHT <I-SPAR0 .P>>)>
+ <COND (<L? .HINCR 0> <SET HINCR <I-SPAR1 .P>>)>
+ <COND (<L? .MIN-WIDTH 0> <SET MIN-WIDTH <I-SPAR2 .P>>)>
+ <COND (<L? .WINCR 0> <SET WINCR <I-SPAR3 .P>>)>)>
+ <VSOP .VS X-SET-RESIZE-HINT <VW-ID .VW> .MIN-HEIGHT .HINCR .MIN-WIDTH .WINCR>>
+
+<DEFINE VS-WINDOW-NAME (CHN:VSCHAN OPER
+ "OPT" NAME:STRING
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) TS)
+ <COND (<ASSIGNED? NAME>
+ <VSOP .VS X-STORE-NAME <VW-ID .VW> <LENGTH .NAME> .NAME>
+ .NAME)
+ (<SET TS <VSOP .VS X-FETCH-NAME <VW-ID .VW>>>
+ <STRING .TS>)>>
+
+<DEFINE VS-CUT-BUFFER (CHN:VSCHAN OPER
+ "OPT" STUFF:STRING (ID:FIX 0)
+ "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
+ (VS:VS <VW-VS100 .VW>) TS)
+ <COND (<ASSIGNED? STUFF>
+ <VSOP .VS X-STORE-BYTES .ID 0 <LENGTH .STUFF> .STUFF>
+ .STUFF)
+ (<SET TS <VSOP .VS X-FETCH-BYTES .ID 0>>
+ <STRING .TS>)>>
+
+<DEFINE GET-FONT (NAME:STRING VS:VS)
+ <REPEAT ((L:<LIST [REST FIX FONT]> <VS-FONTS .VS>))
+ <COND (<NOT <EMPTY? .L>>
+ <COND (<=? .NAME <FONT-NAME <2 .L>>> <RETURN <2 .L>>)>
+ <SET L <REST .L 2>>)
+ (T <RETURN <LOAD-FONT .NAME .VS>>)>>>
+
+<DEFINE LOAD-FONT LF (NAME:STRING VS:VS
+ "AUX" (NS <STANDARD-NAME .NAME>) F P FS:FONT FIRST LAST
+ ST)
+ <SUBSTRUC .NS 0 <- <LENGTH .NS> 1> <REST .NS>>
+ <COND
+ (<SET F <VSOP .VS X-GET-FONT 0 <- <LENGTH .NS> 1> <REST .NS>>>
+ <SET FS <CHTYPE [.NAME .F 0 0 0 <> 0 <>] FONT>>
+ <COND
+ (<SET P <VSOP .VS X-QUERY-FONT 0 .F>>
+ <FONT-HEIGHT .FS <I-SPAR0 .P>>
+ <FONT-WIDTH .FS <I-SPAR1 .P>>
+ <FONT-BASE .FS <I-SPAR4 .P>>
+ <COND
+ (<NOT <0? <I-SPAR5 .P>>> <FONT-FIXED? .FS T>)
+ (T
+ <SET FIRST <I-SPAR2 .P>>
+ <SET LAST <I-SPAR3 .P>>
+ <COND
+ (<SET ST <VSOP .VS X-CHAR-WIDTHS 0 .F 2 "W1">>
+ <COND (<AND <==? <1 .ST> <3 .ST>>
+ <==? <2 .ST> <4 .ST>>>
+ <FONT-WIDTH .FS <I-SPAR2 .P>>
+ <FONT-FIXED? .FS T>)
+ (T
+ <COND
+ (<SET ST <VSOP .VS X-FONT-WIDTHS 0 .F>>
+ <REPEAT ((C .FIRST)
+ (UV:<UVECTOR [REST FIX]>
+ <IUVECTOR <+ 1 <- .LAST .FIRST>>>))
+ <COND (<EMPTY? .ST>
+ <FONT-CHARS .FS .UV>
+ <RETURN>)>
+ <PUT .UV <+ 1 <- .C .FIRST>>
+ <+ <ASCII <1 .ST>>
+ <LSH <ASCII <2 .ST>> 8>>>
+ <SET C <+ .C 1>>
+ <SET ST <REST .ST 2>>>)>)>
+ <FONT-FIRST .FS .FIRST>)
+ (T <RETURN .P .LF>)>)>
+ <VS-FONTS .VS (.F .FS !<VS-FONTS .VS>)>
+ .FS)>)>>
+
+<DEFINE CHAR-WIDTH (CHAR:CHARACTER FONT:FONT "AUX" FF:FIX)
+ <COND (<FONT-FIXED? .FONT> <FONT-WIDTH .FONT>)
+ (<OR <L? <ASCII .CHAR> <SET FF <FONT-FIRST .FONT>>>
+ <G=? <ASCII .CHAR>
+ <+ .FF <LENGTH <FONT-CHARS .FONT>:UVECTOR>>>>
+ 0)
+ (T
+ <NTH <FONT-CHARS .FONT>:UVECTOR <+ <- <ASCII .CHAR> .FF> 1>>)>>
+
+<DEFINE STRING-WIDTH (STR:STRING FONT:FONT VS:VS)
+ <VSOP .VS X-STRING-WIDTH 0 <FONT-ID .FONT> <LENGTH .STR> .STR>>
+
+<DEFINE VS-LINE-HEIGHT (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <FONT-HEIGHT <VW-CFONT .VW>>>
+
+<DEFINE VS-CHAR-WIDTH (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
+ <FONT-WIDTH <VW-CFONT .VW>>>
+
+<ENDPACKAGE>
projects / pdp10-muddle.git / blobdiff