mim/development/mim/vax/nvs/vs100.mud

   1
   2 <PACKAGE "VS100">
   3
   4 <ENTRY VS100
   5        BLACK WHITE GRAY WINDOW-BITS
   6        VS100-DIRECTORY
   7        CHANGE-COLOR CURRENT-FONT LINE-HEIGHT CHAR-WIDTH SET-FONT
   8        MAP UNMAP CURRENT-FONT
   9        HOR-POS-ABS VER-POS-ABS
  10        TEXT-CURSOR MOUSE-CURSOR
  11        MAKE-MENU-WINDOW
  12        WRITE-TO-MENU-WINDOW
  13        INVERT-MENU-WINDOW
  14        CLEAR-MENU-WINDOW
  15        SELECT-MENU-WINDOW
  16        BIT-BLT
  17        DEFINE-PATTERN
  18        SET-HIGHLIGHT
  19        PAGE-TOP
  20        PAGE-LEFT
  21        FREE-PATTERN
  22        INITIAL-FONT
  23        INITIAL-BORDER
  24        INITIAL-BACKGROUND
  25        INITIAL-MOUSE-CURSOR
  26        INITIAL-TEXT-CURSOR
  27        LOAD-KEYMAPS
  28        MOUSE-MOVE?
  29        WARP-MOUSE
  30        DRAW
  31        DRAW-FILLED
  32        DRAW-DASHED
  33        DRAW-LINE
  34        MOUSE-MOVE-WINDOW
  35        MOUSE-RESIZE-WINDOW
  36        MOUSE-OPEN-WINDOW
  37        MAKE-TEMP-WINDOW
  38        BUFTREE
  39        MOVE-CURSOR-ABS
  40        RECYCLE-EVENTS
  41        PAGE-X-ABS
  42        PAGE-Y-ABS
  43        PAGE-WIDTH-ABS
  44        PAGE-HEIGHT-ABS
  45        MOVE-WINDOW
  46        RESIZE
  47        WINDOW-NAME
  48        CLEAR-REGION
  49        FILL-REGION
  50        CUT-BUFFER
  51        WINDOW-PARENT
  52        WINDOW-CHILDREN
  53        WINDOW-FUNCTION
  54        DRAW-LEFT
  55        DRAW-TOP
  56        DRAW-WIDTH
  57        DRAW-HEIGHT
  58        INTERPRET-LOCATOR
  59        DISPLAY-CURSOR
  60        QUERY-MOUSE
  61        RAISE-WINDOW
  62        LOWER-WINDOW
  63        CIRC-WINDOW
  64        SCALED-TO-ABSOLUTE
  65        ABSOLUTE-TO-SCALED
  66        MOUSE-LOWER-WINDOW
  67        ICONIFY
  68        ICON?
  69        ICONIFIED?
  70        DE-ICONIFY
  71        INVERT-ICON
  72        KILL-SUBWINDOWS
  73        SET-RESIZE-HINT
  74        INVERSE-VIDEO
  75        UNDERLINE>
  76
  77 <USE "NETBASE" "NEWSTRUC" "HOSTS" "VSBASE">
  78
  79 <EXPORT "TTY">
  80
  81 <INCLUDE "VSTYPES" "VSUTYPES">
  82
  83 <INCLUDE-WHEN <COMPILING? "VS100"> "NETDEFS" "VSDEFS" "VSOPS" "VSUDEFS">
  84
  85 <NEW-CHANNEL-TYPE VS100 <>
  86                   OPEN VS-OPEN
  87                   CLOSE VS-CLOSE
  88                   READ-BYTE-IMMEDIATE VS-READ-IMMEDIATE
  89                   WRITE-BUFFER VS-NORMAL-OUT
  90                   IMAGE-OUT VS-IMAGE-OUT
  91                   CHANGE-COLOR VS-CHANGE-COLOR
  92                   CLEAR-EOL VS-CLEAR-EOL
  93                   MAP VS-MAP
  94                   UNMAP VS-UNMAP
  95                   SET-FONT VS-SET-FONT
  96                   BUFOUT VS-BUFOUT
  97                   BUFTREE VS-BUFTREE
  98                   CURRENT-FONT VS-SET-FONT
  99                   CLEAR-EOS VS-CLEAR-EOS
 100                   CLEAR-SCREEN VS-CLEAR-SCREEN
 101                   DOWN-CURSOR VS-DOWN-CURSOR
 102                   UP-CURSOR VS-UP-CURSOR
 103                   FORWARD-CURSOR VS-FORWARD-CURSOR
 104                   BACK-CURSOR VS-BACK-CURSOR
 105                   MOVE-CURSOR VS-MOVE-CURSOR
 106                   MOVE-CURSOR-ABS VS-MOVE-CURSOR-ABS
 107                   HOME-CURSOR VS-HOME-CURSOR
 108                   BOTTOM-CURSOR VS-BOTTOM-CURSOR
 109                   HOR-POS-CURSOR VS-HOR-POS
 110                   VER-POS-CURSOR VS-VER-POS
 111                   HOR-POS-ABS VS-HOR-POS-ABS
 112                   VER-POS-ABS VS-VER-POS-ABS
 113                   TEXT-CURSOR VS-TEXT-CURSOR
 114                   MOUSE-CURSOR VS-MOUSE-CURSOR
 115                   FRESH-LINE VS-FRESH-LINE
 116                   MAKE-MENU-WINDOW VS-MENU-WINDOW
 117                   WRITE-TO-MENU-WINDOW VS-WRITE-TO-MENU
 118                   INVERT-MENU-WINDOW VS-INVERT-MENU
 119                   CLEAR-MENU-WINDOW VS-CLEAR-MENU-WINDOW
 120                   SELECT-MENU-WINDOW VS-SELECT-MENU-WINDOW
 121                   BIT-BLT VS-BIT-BLT
 122                   INSERT-LINE VS-INSERT-LINE
 123                   INSERT-CHAR VS-INSERT-CHAR
 124                   ERASE-CHAR VS-ERASE-CHAR
 125                   KILL-CHAR VS-KILL-CHAR
 126                   DEFINE-PATTERN DEFINE-PATTERN
 127                   SET-HIGHLIGHT VS-SET-HIGHLIGHT
 128                   LOAD-KEYMAPS VS-LOAD-KEYMAPS
 129                   MOUSE-MOVE? VS-MOUSE-MOVE?
 130                   WARP-MOUSE VS-WARP-MOUSE
 131                   DRAW VS-DRAW
 132                   DRAW-DASHED VS-DRAW-DASHED
 133                   DRAW-FILLED VS-DRAW-FILLED
 134                   DRAW-LINE VS-DRAW-LINE
 135                   MOUSE-MOVE-WINDOW MOUSE-MOVE-WINDOW
 136                   MOUSE-RESIZE-WINDOW MOUSE-RESIZE-WINDOW
 137                   MOUSE-OPEN-WINDOW MOUSE-OPEN-WINDOW
 138                   MAKE-TEMP-WINDOW MAKE-TEMP-WINDOW
 139                   PAGE-X VS-HOR-POS
 140                   PAGE-X-ABS VS-HOR-POS-ABS
 141                   PAGE-Y VS-VER-POS
 142                   PAGE-Y-ABS VS-VER-POS-ABS
 143                   PAGE-HEIGHT VS-PAGE-HEIGHT
 144                   PAGE-WIDTH VS-PAGE-WIDTH
 145                   PAGE-TOP PAGE-LOC
 146                   PAGE-LEFT PAGE-LOC
 147                   PAGE-HEIGHT-ABS VS-PAGE-HEIGHT-ABS
 148                   PAGE-WIDTH-ABS VS-PAGE-WIDTH-ABS
 149                   RESIZE VS-RESIZE
 150                   MOVE-WINDOW VS-MOVE-WINDOW
 151                   WINDOW-NAME VS-WINDOW-NAME
 152                   CLEAR-REGION VS-CLEAR-REGION
 153                   FILL-REGION VS-FILL-REGION
 154                   FREE-PATTERN FREE-PATTERN
 155                   LINE-HEIGHT VS-LINE-HEIGHT
 156                   CHAR-WIDTH VS-CHAR-WIDTH
 157                   CUT-BUFFER VS-CUT-BUFFER
 158                   WINDOW-PARENT WINDOW-PARENT
 159                   WINDOW-CHILDREN WINDOW-CHILDREN
 160                   TYPE-AHEAD? VS100-TYPE-AHEAD?
 161                   WINDOW-FUNCTION VS-WINDOW-FUNCTION
 162                   DRAW-LEFT VS-SCALE
 163                   DRAW-TOP VS-SCALE
 164                   DRAW-WIDTH VS-SCALE
 165                   DRAW-HEIGHT VS-SCALE
 166                   INTERPRET-LOCATOR INTERPRET-LOCATOR
 167                   DISPLAY-CURSOR VS-DISPLAY-CURSOR
 168                   QUERY-MOUSE VS-QUERY-MOUSE
 169                   RAISE-WINDOW RAISE-WINDOW
 170                   LOWER-WINDOW LOWER-WINDOW
 171                   CIRC-WINDOW CIRC-WINDOW
 172                   SCALED-TO-ABSOLUTE SCALED-TO-ABSOLUTE
 173                   ABSOLUTE-TO-SCALED ABSOLUTE-TO-SCALED
 174                   ICON? ICON?
 175                   ICONIFIED? ICONIFIED?
 176                   ICONIFY ICONIFY
 177                   DE-ICONIFY DE-ICONIFY
 178                   MOUSE-LOWER-WINDOW MOUSE-LOWER-WINDOW
 179                   KILL-SUBWINDOWS KILL-SUBWINDOWS
 180                   REDISPLAY-ICON REDISPLAY-ICON
 181                   INVERT-ICON INVERT-ICON
 182                   SET-RESIZE-HINT SET-RESIZE-HINT
 183                   WINDOW-BITS WINDOW-BITS
 184                   INVERSE-VIDEO INVERSE-VIDEO
 185                   UNDERLINE UNDERLINE>
 186
 187 <GDECL (VS100-LIST)
 188        <LIST [REST VS]>
 189        (INITIAL-FONT)
 190        STRING
 191        (INITIAL-BORDER INITIAL-BACKGROUND)
 192        <OR FIX ATOM>
 193        (INITIAL-TEXT-CURSOR)
 194        <OR ATOM FALSE VECTOR CURSOR>
 195        (VS100-DIRECTORY) <OR STRING FALSE>
 196        (INITIAL-MOUSE-CURSOR)
 197        <OR ATOM FALSE VECTOR CURSOR>>
 198
 199 <SETG INITIAL-BORDER BLACK>
 200
 201 <SETG INITIAL-BACKGROUND WHITE>
 202
 203 <SETG INITIAL-FONT "8X13">
 204
 205 <SETG INITIAL-TEXT-CURSOR T>
 206
 207 <SETG VS100-DIRECTORY <>>
 208
 209 <DEFINE RAISE-WINDOW (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 210         <VSOP <VW-VS100 .VW> X-RAISE-WINDOW <VW-ID .VW>>>
 211
 212 <DEFINE LOWER-WINDOW (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 213         <VSOP <VW-VS100 .VW> X-LOWER-WINDOW <VW-ID .VW>>>
 214
 215 <DEFINE CIRC-WINDOW (CHN:VSCHAN OPER "OPT" (UP? T)
 216                      "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 217    <COND (.UP?
 218           <VSOP <VW-VS100 .VW> X-CIRC-WINDOW-UP <VW-ID .VW>>)
 219          (T
 220           <VSOP <VW-VS100 .VW> X-CIRC-WINDOW-DOWN <VW-ID .VW>>)>>
 221
 222 <DEFINE VS100-TYPE-AHEAD? (CHN:VSCHAN OPER)
 223         <ANY-INPUT? <VW-VS100 <CHANNEL-DATA .CHN>:VSW>>>
 224
 225 <DEFINE SCALED-TO-ABSOLUTE (CHN:VSCHAN OPER:ATOM FIRST:<OR FIX FLOAT VECTOR>
 226                             "OPT" (SECOND:<OR FIX FLOAT FALSE> <>)
 227                             (REL?:<OR ATOM FALSE> <>)
 228                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
 229                                   (SC:<OR SCALE FALSE> <VW-SCALE .VW>))
 230         <COND (<NOT <TYPE? .FIRST VECTOR>>
 231                <SET FIRST
 232                     <VECTOR .FIRST
 233                             <COND (<NOT .SECOND>
 234                                    <CHANNEL-OP .CHN DRAW-TOP>)
 235                                   (T .SECOND)>>>)>
 236         <SCALE-POINT .FIRST .VW .REL?>
 237         .FIRST>
 238
 239 <DEFINE ABSOLUTE-TO-SCALED (CHN:VSCHAN OPER:ATOM FIRST:<OR FIX VECTOR>
 240                             "OPT" (SECOND:<OR FIX FALSE> <>)
 241                             (REL?:<OR ATOM FALSE> <>)
 242                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
 243                                   (SC:<OR SCALE FALSE> <VW-SCALE .VW>)
 244                                   NUM:FLOAT)
 245         <COND (<NOT <TYPE? .FIRST VECTOR>>
 246                <SET FIRST
 247                     <VECTOR .FIRST
 248                             <COND (<ASSIGNED? SECOND> .SECOND) (T 0)>>>)>
 249         <COND (<NOT .SC> .FIRST)
 250               (T
 251                <1 .FIRST
 252                   <+ </ <SET NUM <FLOAT <1 .FIRST>>> <S-WSCALE .SC>>
 253                      <COND (<NOT .REL?> <S-LEFT .SC>) (T 0.0)>>>
 254                <2 .FIRST
 255                   <+ </ <SET NUM <FLOAT <2 .FIRST>>> <S-HSCALE .SC>>
 256                      <COND (.REL? 0.0)(T <S-TOP .SC>)>>>)>
 257         .FIRST>
 258
 259 <DEFINE VS-SCALE (CHN:VSCHAN OPER:ATOM
 260                   "OPT" FROB:<OR FIX FLOAT FALSE>
 261                   "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
 262                         (SC:<OR SCALE FALSE> <VW-SCALE .VW>) (OLD <>)
 263                         TEMP:<OR FLOAT FALSE>)
 264    <COND (.SC
 265           <SET OLD
 266                <COND (<==? .OPER DRAW-LEFT>
 267                       <COND (<==? <SET OLD <S-LEFT .SC>> 0.0> <>) (T .OLD)>)
 268                      (<==? .OPER DRAW-TOP>
 269                       <COND (<==? <SET OLD <S-TOP .SC>> 0.0> <>) (T .OLD)>)
 270                      (<==? .OPER DRAW-HEIGHT> <S-HEIGHT .SC>)
 271                      (<==? .OPER DRAW-WIDTH> <S-WIDTH .SC>)>>)>
 272    <COND (<ASSIGNED? FROB>
 273           <COND (<NOT .SC>
 274                  <SET SC <CHTYPE [0.0 0.0 <> <> 1.0 1.0] SCALE>>
 275                  <VW-SCALE .VW .SC>)>
 276           <COND (<TYPE? .FROB FIX> <SET FROB <FLOAT .FROB>>)>
 277           <COND (<==? .OPER DRAW-LEFT>
 278                  <COND (<NOT .FROB> <S-LEFT .SC 0.0>) (T <S-LEFT .SC .FROB>)>)
 279                 (<==? .OPER DRAW-TOP>
 280                  <COND (<NOT .FROB> <S-TOP .SC 0.0>) (T <S-TOP .SC .FROB>)>)
 281                 (<==? .OPER DRAW-WIDTH> <S-WIDTH .SC .FROB>)
 282                 (<==? .OPER DRAW-HEIGHT> <S-HEIGHT .SC .FROB>)>
 283           <COND (<AND <NOT <S-HEIGHT .SC>>
 284                       <NOT <S-WIDTH .SC>>
 285                       <==? <S-TOP .SC> 0.0>
 286                       <==? <S-LEFT .SC> 0.0>>
 287                  <VW-SCALE .VW <>>)
 288                 (T
 289                  <COND (<NOT <SET TEMP <S-WIDTH .SC>>> <S-WSCALE .SC 1.0>)
 290                        (T <S-WSCALE .SC </ <FLOAT <VW-WIDTH .VW>> .TEMP>>)>
 291                  <COND (<NOT <SET TEMP <S-HEIGHT .SC>>> <S-HSCALE .SC 1.0>)
 292                        (T
 293                         <S-HSCALE .SC </ <FLOAT <VW-HEIGHT .VW>> .TEMP>>)>)>)>
 294    .OLD>
 295
 296 <DEFINE VS-QUERY-MOUSE (CHN:VSCHAN OPER UV:<UVECTOR [2 FIX]>
 297                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P)
 298         <COND (<SET P <VSOP <VW-VS100 .VW> X-QUERY-MOUSE <VW-ID .VW>>>
 299                <1 .UV <I-SPAR2 .P>>
 300                <2 .UV <I-SPAR3 .P>>)>>
 301
 302 <DEFINE INTERPRET-LOCATOR (CHN:VSCHAN OPER LOC:FIX UV:<UVECTOR [2 FIX]>
 303                            "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P)
 304         <COND (<SET P
 305                     <VSOP <VW-VS100 .VW> X-INTERPRET-LOCATOR <VW-ID .VW> .LOC>>
 306                <1 .UV <I-SPAR2 .P>>
 307                <2 .UV <I-SPAR3 .P>>
 308                .UV)>>
 309
 310 <DEFINE VS-WINDOW-FUNCTION (CHN:VSCHAN OPER
 311                             "OPT" FROB:<OR ATOM APPLICABLE FALSE>
 312                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 313         <COND (<NOT <ASSIGNED? FROB>> <VW-FUNCTION .VW>)
 314               (T <VW-FUNCTION .VW .FROB> .FROB)>>
 315
 316 <DEFINE WINDOW-PARENT (CH:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CH>))
 317         <COND (<==? <VW-PARENT .VW> <VS-TOPCHAN <VW-VS100 .VW>>> <>)
 318               (T <VW-PARENT .VW>)>>
 319
 320 <DEFINE WINDOW-CHILDREN (CH:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CH>))
 321         <VW-KIDS .VW>>
 322
 323 <DEFINE PRINT-VSW (VW:VSW
 324                    "OPTIONAL" (OUTCHAN:CHANNEL .OUTCHAN)
 325                               (VS:VS <VW-VS100 .VW>))
 326         <PRINC "#VSW [">
 327         <COND (<VS-HOST .VS> <PRIN1 <VS-HOST .VS>>)>
 328         <PRINT-MANY .OUTCHAN
 329                     PRINC
 330                     !\:
 331                     <VS-WHICH .VS>
 332                     !\
 333                     "ID:"
 334                     <VW-ID .VW>
 335                     !\
 336                     <VW-WIDTH .VW>
 337                     !\x
 338                     <VW-HEIGHT .VW>
 339                     " ("
 340                     <VW-X .VW>
 341                     !\,
 342                     <VW-Y .VW>
 343                     ") "
 344                     !\"
 345                     <COND (<VW-CFONT .VW> <FONT-NAME <VW-CFONT .VW>>)>
 346                     !\">
 347         <COND (<VW-CURSOR .VW> <PRINC " CURSOR">)>
 348         <COND (<==? <VW-BG .VW> <VS-BLACK .VS>> <PRINC " BLACK">)
 349               (<==? <VW-BG .VW> <VS-WHITE .VS>> <PRINC " WHITE">)
 350               (<==? <VW-BG .VW> <VS-GRAY .VS>> <PRINC " GRAY">)
 351               (T <PRINT-MANY .OUTCHAN PRINC " BG:" <VW-BG .VW>>)>
 352         <COND (<VW-OBUF .VW>
 353                <PRINT-MANY .OUTCHAN
 354                            PRINC
 355                            " OBUF:"
 356                            <VW-OCT .VW>
 357                            !\/
 358                            <LENGTH <VW-TOBUF .VW>>>)>
 359         <PRINC !\]>
 360         .VW>
 361
 362 <COND (<GASSIGNED? PRINT-VSW> <PRINTTYPE VSW ,PRINT-VSW>)>
 363
 364 <DEFINE PRINT-VS (VS:VS "OPTIONAL" (OUTCHAN:CHANNEL .OUTCHAN))
 365    <PRINT-MANY
 366     .OUTCHAN
 367     PRINC
 368     "#VS ["
 369     <VS-HOST .VS>
 370     !\:
 371     <VS-WHICH .VS>
 372     !\
 373     <COND (<VS-TOPCHAN .VS> <VW-ID <CHANNEL-DATA <VS-TOPCHAN .VS>>>)>
 374     " KIDS:"
 375     <COND (<VS-TOPCHAN .VS>
 376            <LENGTH <VW-KIDS <CHANNEL-DATA <VS-TOPCHAN .VS>>>>)>
 377     " ALL:"
 378     </ <LENGTH <VS-ALL .VS>> 2>
 379     " FONTS:"
 380     </ <LENGTH <VS-FONTS .VS>> 2>
 381     " REQ:"
 382     <VS-REQ .VS>
 383     " OBUF:"
 384     <COND (<VS-BUFFER .VS>
 385            <- <LENGTH <VS-BUFFER-TOP .VS>:STRING>
 386               <LENGTH <VS-BUFFER .VS>:STRING>>)
 387           (T <>)>
 388     " IBUF:"
 389     <LENGTH <VS-IBUFFER .VS>>
 390     " MAP:"
 391     <VS-MAPNAME .VS>
 392     "]">
 393    T>
 394
 395 <COND (<GASSIGNED? PRINT-VS> <PRINTTYPE VS ,PRINT-VS>)>
 396
 397 <DEFINE PRINT-WE (WE:WINDOW-EVENT "OPT" (OUTCHAN:CHANNEL .OUTCHAN) "AUX" KIND)
 398         <PRINT-MANY .OUTCHAN
 399                     PRINC
 400                     "#WINDOW-EVENT ["
 401                     <CASE ,==?
 402                           <SET KIND <WE-KIND .WE>>
 403                           (,WE-EXPOSE-WINDOW "EXPOSE")
 404                           (,WE-EXPOSE-REGION "EXPOSE-REGION")
 405                           (,WE-EXPOSE-COPY "EXPOSE-COPY")
 406                           (,WE-RESIZE-WINDOW "RESIZE")
 407                           (,WE-UNMAP-WINDOW "UNMAP")>
 408                     !\
 409                     <WE-WINDOW .WE>
 410                     !\
 411                     <WE-SUBWINDOW .WE>>
 412         <COND (<OR <==? .KIND ,WE-EXPOSE-REGION>
 413                    <==? .KIND ,WE-EXPOSE-COPY>
 414                    <==? .KIND ,WE-RESIZE-WINDOW>>
 415                <MAPF <>
 416                      <FUNCTION (R:WE-RECTANGLE)
 417                         <PRINT-MANY .OUTCHAN
 418                            PRINC
 419                            " ("
 420                            <REC-LEFT .R>
 421                            !\,
 422                            <REC-TOP .R>
 423                            ") "
 424                            <REC-WIDTH .R>
 425                            "x"
 426                            <REC-HEIGHT .R>>>
 427                      <WE-CHANGES .WE>>)>
 428         <PRINC !\]>>
 429
 430 <COND (<GASSIGNED? PRINT-WE> <PRINTTYPE WINDOW-EVENT ,PRINT-WE>)>
 431
 432 <DEFINE PRINT-ME (ME:MOUSE-EVENT
 433                   "OPT" (OUTCHAN:CHANNEL .OUTCHAN)
 434                   "AUX" KIND (PREL 0))
 435    <PRINT-MANY
 436     .OUTCHAN
 437     PRINC
 438     "#MOUSE-EVENT ["
 439     <COND (<NOT <0? <ANDB <SET KIND <ME-KIND .ME>> ,ME-PRESSED-MASK>>>
 440            <SET PREL 1>
 441            "PRESSED")
 442           (<NOT <0? <ANDB .KIND ,ME-RELEASED-MASK>>> <SET PREL -1> "RELEASED")
 443           (<==? .KIND ,ME-MOVED> "MOVED")
 444           (<==? .KIND ,ME-ENTER-WINDOW> "ENTER")
 445           (<==? .KIND ,ME-LEAVE-WINDOW> "LEAVE")>
 446     !\
 447     <COND (<NOT <0? .PREL>>
 448            <COND (<NOT <0? <ANDB .KIND
 449                                  <+ ,ME-LEFT-PRESSED ,ME-LEFT-RELEASED>>>>
 450                   "LEFT ")
 451                  (<NOT <0? <ANDB .KIND
 452                                  <+ ,ME-MIDDLE-PRESSED ,ME-MIDDLE-RELEASED>>>>
 453                   "MIDDLE ")
 454                  (T "RIGHT ")>)
 455           (T "")>
 456     <ME-STATE .ME>
 457     " ("
 458     <ME-X .ME>
 459     !\,
 460     <ME-Y .ME>
 461     ") "
 462     <ME-TIME .ME>
 463     !\
 464     <ME-WINDOW .ME>
 465     !\
 466     <ME-SUBWINDOW .ME>
 467     !\]>>
 468
 469 <COND (<GASSIGNED? PRINT-ME> <PRINTTYPE MOUSE-EVENT ,PRINT-ME>)>
 470
 471 <DEFINE VS-READ-IMMEDIATE (CHANNEL:VSCHAN OPER
 472                            "OPT" (NOWAIT?:<OR ATOM FALSE> <>)
 473                            "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
 474                                  (VS:VS <VW-VS100 .VW>))
 475         <GET-EVENT .VS <NOT .NOWAIT?>>>
 476
 477 <DEFINE RECYCLE-EVENTS ("TUPLE" STUFF)
 478         <MAPF <>
 479               <FUNCTION (X:ANY "AUX" L)
 480                       <COND (<TYPE? .X MOUSE-EVENT>
 481                              <1 <SET L <ME-CELL .X>> .X>
 482                              <SETG FREE-MOUSE-EVENTS
 483                                    <PUTREST .L ,FREE-MOUSE-EVENTS>>)
 484                             (<TYPE? .X WINDOW-EVENT>
 485                              <PUTREST <REST <SET L <WE-CHANGES .X>>
 486                                             <- <LENGTH .L> 1>>
 487                                       ,FREE-RECTANGLES>
 488                              <SETG FREE-RECTANGLES .L>
 489                              <WE-CHANGES .X ()>
 490                              <1 <SET L <WE-CELL .X>> .X>
 491                              <SETG FREE-WINDOW-EVENTS
 492                                    <PUTREST .L ,FREE-WINDOW-EVENTS>>)>>
 493               .STUFF>
 494         T>
 495
 496 <DEFINE GET-VS100 (DESC:<OR STRING <PRIMTYPE LIST>>)
 497    <COND
 498     (<OR <NOT .DESC> <TYPE? .DESC STRING>>
 499      <PROG (STR:<OR STRING FALSE> TS (HOST <>) (NUM <>))
 500            <COND
 501             (<SET STR <OR .DESC <GET-ENV-STR "DISPLAY">>>
 502              <COND (<SET TS <MEMQ !\: .STR>>
 503                     <SET NUM <PARSE <REST .TS>>>
 504                     <COND (<N==? .TS .STR>
 505                            <SET HOST
 506                                 <SUBSTRUC .STR
 507                                           0
 508                                           <- <LENGTH .STR> <LENGTH .TS>>>>
 509                            <SET HOST <HOST .HOST>>)>
 510                     <SET DESC (.NUM)>
 511                     <COND (.HOST <SET DESC (.HOST !.DESC)>)>)
 512                    (T <SET DESC '(0)>)>)
 513             (T <SET DESC '(0)>)>>)>
 514    <COND (<==? <LENGTH .DESC:LIST> 1> <VS100-INIT <1 .DESC> <>>)
 515          (T <VS100-INIT <2 .DESC> <1 .DESC>>)>>
 516
 517 <DEFINE VS100-INIT (WHICH:FIX HOST:<OR FIX FALSE>
 518                     "AUX" CH L NVS P:<OR UVECTOR FALSE> BUF:STRING NVW
 519                           BLACK WHITE GRAY ROOT PLANES
 520                           CURRENT-ROOT-ID:<SPECIAL FIX>)
 521         <COND (<NOT <GASSIGNED? VS100-LIST>> <SETG VS100-LIST <SET L ()>>)
 522               (T <SET L ,VS100-LIST>)>
 523         <COND
 524          (<SET NVS <FIND-VS100 .WHICH .HOST>>)
 525          (T
 526           <COND (<NOT .HOST>
 527                  <SET CH
 528                       <CHANNEL-OPEN NETWORK
 529                                     <STRING "VS" <UNPARSE .WHICH>>
 530                                     <+ ,SERV-VS100 .WHICH>>>)
 531                 (T
 532                  <SET CH
 533                       <CHANNEL-OPEN NETWORK
 534                                     <STRING <UNPARSE .HOST>
 535                                             ":VS"
 536                                             <UNPARSE .WHICH>>
 537                                     <+ ,SERV-VS100 .WHICH>
 538                                     .HOST>>)>
 539           <COND (.CH
 540                  <SET NVS
 541                       <CHTYPE [.CH
 542                                .WHICH
 543                                .HOST
 544                                <>
 545                                T
 546                                ()
 547                                ()
 548                                0
 549                                0
 550                                0
 551                                0
 552                                <SET BUF <REQUEST-BUFFER <> STRING <>>>
 553                                0
 554                                .BUF
 555                                ()
 556                                ()
 557                                <>
 558                                <>
 559                                <>]
 560                               VS>>
 561                  <LOAD-KEYMAPS .NVS ,X-DEFAULT-KEYMAP>
 562                  <COND (<SET P <VSOP .NVS X-SETUP 0>>
 563                         <SET ROOT <I-LPAR0 .P>>
 564                         <SET CURRENT-ROOT-ID .ROOT>
 565                         <SET PLANES <I-SPAR4 .P>>
 566                         <COND (<NOT <SET BLACK <VSOP .NVS X-MAKE-PIXMAP 0
 567                                                      0 0 0>>>
 568                                <ERROR CANT-MAKE-BLACK!-ERRORS .BLACK>)>
 569                         <COND (<NOT <SET WHITE <VSOP .NVS X-MAKE-PIXMAP 0
 570                                                      0 1 0>>>
 571                                <ERROR CANT-MAKE-WHITE!-ERRORS .WHITE>)>
 572                         <COND (<NOT <SET GRAY <VSOP .NVS X-STORE-PIXMAP
 573                                                     0 0 <* 16 .PLANES>
 574                                                     <* 16 .PLANES>
 575                                                     <ISTRING <* 32 .PLANES>
 576                                                              <CHTYPE *252*
 577                                                                      CHARACTER>>>>>
 578                                <ERROR CANT-MAKE-GRAY!-ERRORS .GRAY>)>
 579                         <VS-TOPCHAN .NVS
 580                                     <CHTYPE [VS100
 581                                              "Toplevel"
 582                                              <>
 583                                              T
 584                                              <SET NVW
 585                                                   <CHTYPE [.NVS
 586                                                            .ROOT
 587                                                            <>
 588                                                            ()
 589                                                            0
 590                                                            0
 591                                                            0
 592                                                            0
 593                                                            <>
 594                                                            ,GX-XOR
 595                                                            .GRAY
 596                                                            .GRAY
 597                                                            0
 598                                                            <>
 599                                                            <>
 600                                                            0
 601                                                            0
 602                                                            0
 603                                                            0
 604                                                            <>
 605                                                            <>
 606                                                            ()
 607                                                            <>
 608                                                            <>
 609                                                            -1
 610                                                            <>
 611                                                            <>
 612                                                            <>
 613                                                            <>
 614                                                            <>
 615                                                            <>
 616                                                            <>
 617                                                            <>]
 618                                                           VSW>>
 619                                              <>]
 620                                             CHANNEL>>
 621                         <VS-ALL .NVS (<VW-ID .NVW> <VS-TOPCHAN .NVS>)>
 622                         <VS-BLACK .NVS .BLACK>
 623                         <VS-WHITE .NVS .WHITE>
 624                         <VS-GRAY .NVS .GRAY>
 625                         <SET P <VSOP .NVS X-QUERY-WINDOW <VW-ID .NVW>>>
 626                         <VW-WIDTH .NVW <I-SPAR1 .P:UVECTOR>>
 627                         <VW-HEIGHT .NVW <I-SPAR0 .P:UVECTOR>>
 628                         <VW-BWIDTH .NVW <I-SPAR4 .P:UVECTOR>>
 629                         <SET L (.NVS !.L)>
 630                         <SETG VS100-LIST .L>
 631                         .NVS)
 632                        (T <CLOSE .CH> .P)>)>)>>
 633
 634 <DEFINE VS-LOAD-KEYMAPS (CH:VSCHAN OPER STR:STRING "OPT" (FORCE? <>))
 635         <LOAD-KEYMAPS <VW-VS100 <CHANNEL-DATA .CH>:VSW> .STR .FORCE?>>
 636
 637 <DEFINE LOAD-KEYMAPS (VS:VS STR:<OR STRING FALSE> "OPT" (FORCE? <>) "AUX" M1 M2
 638                       (LOADS:<SPECIAL FIX> 0))
 639         <COND (<OR .FORCE? <N=? .STR <VS-MAPNAME .VS>>>
 640                <SET M1 <LOAD-MAP .STR "NORMAL">>
 641                <SET M2 <LOAD-MAP .STR "FUNCTION">>
 642                <COND (<AND .M1 .M2>
 643                       <COND (<==? .LOADS 2>
 644                              <VS-MAPNAME .VS T>)
 645                             (<NOT .STR>
 646                              <VS-MAPNAME .VS "">)
 647                             (T
 648                              <VS-MAPNAME .VS .STR>)>
 649                       <VS-MAPS .VS [.M1 .M2]>)>)
 650               (T)>>
 651
 652 <DEFINE LOAD-MAP (STR:<OR STRING FALSE> NM2:<SPECIAL STRING>
 653                   "AUX" CH:<OR FALSE <CHANNEL 'DISK>> V:VECTOR BASE:FIX
 654                         (BUF <STACK <IUVECTOR 6>>) CT:FIX TEMP)
 655    <COND (<SET CH <GEN-OPEN <COND (,VS100-DIRECTORY
 656                                    <STRING ,VS100-DIRECTORY
 657                                            !\/ .STR>)
 658                                   (.STR)> "READ" "BINARY" DISK>>
 659           <SET LOADS <+ .LOADS:FIX 1>>
 660           <SET V <IVECTOR <CHANNEL-OP .CH READ-BYTE> <>>>
 661           <SET BASE <CHANNEL-OP .CH READ-BYTE>>
 662           <REPEAT ()
 663              <COND (<0? <SET CT <CHANNEL-OP .CH READ-BUFFER .BUF>>>
 664                     <RETURN>)>
 665              <PUT .V
 666                   <- <1 .BUF> .BASE -1>
 667                   <CHTYPE <SUBSTRUC .BUF 1 5> KEY>>>
 668           <CLOSE .CH>
 669           [.BASE .V])
 670          (<COND (<=? .NM2 "NORMAL"> <SET TEMP ,X-NORMAL-KEYMAP>)
 671                 (T <SET TEMP ,X-FUNCTION-KEYMAP>)>
 672           .TEMP)
 673          (T
 674           <ERROR MISSING-KEYMAP!-ERRORS .NM2 LOAD-KEYMAP>)>>
 675
 676 <DEFINE FIND-VS100 (WHICH:FIX HOST:<OR FIX FALSE> "AUX" (L:LIST ,VS100-LIST))
 677         <REPEAT (VS:VS)
 678                 <COND (<EMPTY? .L> <RETURN <>>)>
 679                 <COND (<AND <==? <VS-WHICH <SET VS <1 .L>>> .WHICH>
 680                             <==? <VS-HOST .VS> .HOST>>
 681                        <RETURN .VS>)>
 682                 <SET L <REST .L>>>>
 683
 684 <DEFINE MAKE-TEMP-WINDOW MTW
 685    (DESC:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER
 686     "OPT" (HEIGHT:<OR FIX FALSE> <>)
 687     (WIDTH:<OR FIX FALSE> <>) (LEFT:FIX -1)
 688     (TOP:FIX -1) (BWIDTH:<OR FIX FALSE> <>)
 689     (BPATTERN:<OR ATOM FIX> WHITE)
 690     (BACKGROUND:<OR ATOM FIX> BLACK)
 691     (FONT:STRING ,INITIAL-FONT)
 692     "AUX" PARENT:VSCHAN MX:FIX MY:FIX NVS
 693     VW:VSW VS:VS SAVE-HEIGHT SAVE-WIDTH
 694     (SAVE-RASTER:<SPECIAL <OR FIX FALSE>> <>)
 695     P:UVECTOR)
 696    <COND (<NOT <TYPE? .DESC CHANNEL>>
 697           <COND (<SET NVS <GET-VS100 .DESC>>
 698                  <SET PARENT <VS-TOPCHAN .NVS>>)
 699                 (T
 700                  <RETURN .NVS .MTW>)>)
 701          (T
 702           <SET PARENT .DESC>)>
 703    <SET VW <CHANNEL-DATA .PARENT>>
 704    <SET VS <VW-VS100 .VW>>
 705    <VW-FLUSH-BUFFER .VW>
 706    <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
 707    <COND (<OR <L? .LEFT 0> <L? .TOP 0>>
 708           <SET P <VSOP .VS X-QUERY-MOUSE <VW-ID .VW>>>
 709           <COND (<L? .LEFT 0> <SET LEFT <I-SPAR2 .P>>)>
 710           <COND (<L? .TOP 0> <SET TOP <I-SPAR3 .P>>)>)>
 711    <COND (<NOT .HEIGHT>
 712           <SET HEIGHT <- <VW-HEIGHT .VW> <* 2 .BWIDTH> .TOP>>)>
 713    <COND (<NOT .WIDTH>
 714           <SET WIDTH <- <VW-WIDTH .VW> <* 2 .BWIDTH> .LEFT>>)>
 715    <SET SAVE-WIDTH
 716         <MIN <- <VW-WIDTH .VW> .LEFT> <+ .WIDTH <* 2 .BWIDTH>>>>
 717    <SET SAVE-HEIGHT
 718         <MIN <- <VW-HEIGHT .VW> .TOP> <+ .HEIGHT <* 2 .BWIDTH>>>>
 719    <SET SAVE-RASTER
 720         <VSOP .VS
 721               X-PIXMAP-SAVE
 722               <VW-ID .VW>
 723               .SAVE-HEIGHT
 724               .SAVE-WIDTH
 725               .LEFT
 726               .TOP>>
 727    <CHANNEL-OPEN VS100
 728                  "MENU"
 729                  .PARENT
 730                  .HEIGHT
 731                  .WIDTH
 732                  .LEFT
 733                  .TOP
 734                  .BWIDTH
 735                  .BPATTERN
 736                  .BACKGROUND
 737                  .FONT
 738                  <>>>
 739
 740 <DEFINE KILL-SUBWINDOWS (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
 741                          L)
 742    <MAPF <>
 743          <FUNCTION (CHN:VSCHAN)
 744             <CLOSE .CHN>>
 745          <VW-KIDS .VW>>
 746    <COND (<NOT <EMPTY? <SET L <VW-MENU-WINDS .VW>>>>
 747           <VSOP <VW-VS100 .VW> X-DESTROY-SUBWINDOWS <VW-ID .VW>>
 748           <PUTREST <REST .L <- <LENGTH .L> 1>>
 749                    ,MENU-WINDOW-LIST>
 750           <SETG MENU-WINDOW-LIST .L>
 751           <VW-MENU-WINDS .VW ()>)>
 752    T>
 753
 754 <DEFINE VS-OPEN VO (STYPE OPER NAME DESC:<OR VSCHAN VS <PRIMTYPE LIST> STRING>
 755                     "OPT" (HEIGHT:<OR FIX FALSE> <>) (WIDTH:<OR FIX FALSE> <>)
 756                           (LEFT:FIX 0) (TOP:FIX 0) (BWIDTH:<OR FIX FALSE> <>)
 757                           (BPATTERN:<OR ATOM FIX FALSE> <>)
 758                           (BACKGROUND:<OR ATOM FIX FALSE> <>)
 759                           (FONT:<OR STRING FALSE> <>) (BUF? T)
 760                           (MIN-HEIGHT:FIX 0) (MIN-WIDTH:FIX 0)
 761                     "AUX" NVS WID F INPUTS PATTERN TEMP TPATTERN
 762                           (OBUF <COND (.BUF? <ISTRING 320>)>) NVW:VSW
 763                           P:<OR FALSE UVECTOR> RH:FIX RW:FIX PARENT:VSCHAN
 764                           (CC:CHANNEL .CURRENT-CHANNEL))
 765         <COND (<NOT <TYPE? .DESC CHANNEL>>
 766                <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
 767                <COND (<TYPE? .DESC VS>
 768                       <SET NVS .DESC>)
 769                      (<NOT <SET NVS <GET-VS100 .DESC>>>
 770                       <RETURN .NVS .VO>)>
 771                <SET PARENT <VS-TOPCHAN .NVS>>)
 772               (T <SET PARENT .DESC>)>
 773         <SET NVW <CHANNEL-DATA .PARENT>>
 774         <COND (<VW-REAL .NVW>
 775                <RETURN #FALSE ("ICONS CAN'T HAVE CHILDREN") .VO>)>
 776         <VW-FLUSH-BUFFER .NVW>
 777         <COND (<NOT .BWIDTH> <SET BWIDTH <VW-BWIDTH .NVW>>)>
 778         <COND (<NOT .HEIGHT> <SET HEIGHT <- <VW-HEIGHT .NVW> <* 2 .BWIDTH>>>)>
 779         <COND (<NOT .WIDTH> <SET WIDTH <- <VW-WIDTH .NVW> <* 2 .BWIDTH>>>)>
 780         <SET NVS <VW-VS100 .NVW>>
 781         <COND (.BPATTERN
 782                <SET BPATTERN <TRANSLATE-COLOR .BPATTERN .NVS>>)
 783               (<==? .PARENT .DESC>
 784                ; "Inherit border from parent if there is one"
 785                <SET BPATTERN <VW-BORDER .NVW>>)
 786               (T
 787                ; "Otherwise use initial setting"
 788                <SET BPATTERN <TRANSLATE-COLOR ,INITIAL-BORDER .NVS>>)>
 789         <COND (.BACKGROUND
 790                <SET BACKGROUND <TRANSLATE-COLOR .BACKGROUND .NVS>>)
 791               (<==? .PARENT .DESC>
 792                ; "Same for background"
 793                <SET BACKGROUND <VW-BG .NVW>>)
 794               (T
 795                <SET BACKGROUND <TRANSLATE-COLOR ,INITIAL-BACKGROUND .NVS>>)>
 796         <COND (<NOT .FONT>
 797                ; "And font"
 798                <COND (<N==? .PARENT .DESC>
 799                       <SET FONT ,INITIAL-FONT>)
 800                      (T
 801                       <SET FONT <FONT-NAME <VW-CFONT .NVW>>>)>)>
 802         <COND
 803          (<SET F <GET-FONT .FONT .NVS>>
 804           <SET MIN-WIDTH <* <FONT-WIDTH .F> .MIN-WIDTH>>
 805           <SET MIN-HEIGHT <* <FONT-HEIGHT .F> .MIN-HEIGHT>>
 806           <COND (<SET WID
 807                       <VSOP .NVS
 808                             X-CREATE-WINDOW
 809                             .BWIDTH
 810                             <VW-ID <CHANNEL-DATA .PARENT:VSCHAN>:VSW>
 811                             .HEIGHT
 812                             .WIDTH
 813                             .LEFT
 814                             .TOP
 815                             .BPATTERN
 816                             .BACKGROUND>>
 817                  <SET MIN-HEIGHT <MAX 0 .MIN-HEIGHT>>
 818                  <SET MIN-WIDTH <MAX 0 .MIN-WIDTH>>
 819                  <VSOP .NVS
 820                        X-SET-RESIZE-HINT
 821                        .WID
 822                        .MIN-HEIGHT
 823                        <FONT-HEIGHT .F>
 824                        .MIN-WIDTH
 825                        <FONT-WIDTH .F>>
 826                  <VS-ALL .NVS (.WID .CC !<VS-ALL .NVS>)>
 827                  <VW-KIDS <CHANNEL-DATA .PARENT:VSCHAN>:VSW
 828                           (.CC
 829                            !<VW-KIDS <CHANNEL-DATA .PARENT:VSCHAN>:VSW>)>
 830                  <VSOP .NVS
 831                        X-STORE-NAME
 832                        .WID
 833                        <LENGTH <CHANNEL-NAME .CC>:STRING>
 834                        <CHANNEL-NAME .CC>>
 835                  <COND (<NOT <GASSIGNED? INITIAL-MOUSE-CURSOR>>
 836                         <SET TEMP ,MDL-CURSOR>)
 837                        (T <SET TEMP ,INITIAL-MOUSE-CURSOR>)>
 838                  <COND (<OR <AND <TYPE? .TEMP CURSOR> <SET PATTERN .TEMP>>
 839                             <AND <TYPE? .TEMP VECTOR>
 840                                  <SET PATTERN <MAKE-PATTERN .NVS !.TEMP>>>>
 841                         <VSOP .NVS
 842                               X-DEFINE-CURSOR .WID
 843                               <C-CURSOR .PATTERN>>)
 844                        (.TEMP
 845                         <VSOP .NVS X-DEFINE-CURSOR  .WID 0>
 846                         <SET PATTERN T>)
 847                        (T <SET PATTERN <>>)>
 848                  <COND (<NOT <GASSIGNED? INITIAL-TEXT-CURSOR>> <SET TEMP T>)
 849                        (T <SET TEMP ,INITIAL-TEXT-CURSOR>)>
 850                  <COND (<AND <TYPE? .TEMP VECTOR>
 851                              <SET TPATTERN <MAKE-PATTERN .NVS !.TEMP>>>)
 852                        (.TEMP <SET TPATTERN .TEMP>)
 853                        (T <SET TPATTERN <>>)>
 854                  <VSOP .NVS
 855                        X-SELECT-INPUT
 856                        .WID
 857                        <COND (<==? .PARENT <VS-TOPCHAN .NVS>>
 858                               <SET INPUTS
 859                                    <ORB ,KEY-PRESSED
 860                                         ,BUTTON-PRESSED
 861                                         ,BUTTON-RELEASED
 862                                         ,ENTER-WINDOW
 863                                         ,LEAVE-WINDOW
 864                                         ,EXPOSE-WINDOW
 865                                         ,UNMAP-WINDOW
 866                                         ,EXPOSE-REGION
 867                                         ,EXPOSE-COPY>>)
 868                              (T
 869                               <SET INPUTS
 870                                    <ORB ,ENTER-WINDOW
 871                                         ,LEAVE-WINDOW
 872                                         ,BUTTON-PRESSED
 873                                         ,BUTTON-RELEASED
 874                                         ,UNMAP-WINDOW
 875                                         ,EXPOSE-REGION
 876                                         ,EXPOSE-COPY>>)>>
 877                  <VSOP .NVS X-MAP-WINDOW .WID>
 878                  <CHTYPE [.NVS
 879                           .WID
 880                           .PARENT
 881                           ()
 882                           .WIDTH
 883                           .HEIGHT
 884                           0
 885                           0
 886                           .F
 887                           <COND (<==? .BACKGROUND <VS-BLACK .NVS>> ,GX-COPY)
 888                                 (<==? .BACKGROUND <VS-WHITE .NVS>>
 889                                  ,GX-COPY-INVERTED)
 890                                 (T ,GX-XOR)>
 891                           .BACKGROUND
 892                           .BPATTERN
 893                           .BWIDTH
 894                           .OBUF
 895                           .OBUF
 896                           0
 897                           0
 898                           0
 899                           <+ ,VWM-DEFAULT ,VWM-UNSEEN>
 900                           <>
 901                           T
 902                           ()
 903                           <>
 904                           <>
 905                           .INPUTS
 906                           .TPATTERN
 907                           <AND <ASSIGNED? SAVE-RASTER> .SAVE-RASTER>
 908                           .PATTERN
 909                           <>
 910                           <>
 911                           <>
 912                           <>
 913                           <>
 914                           <>]
 915                          VSW>)>)>>
 916
 917 <DEFINE VS-WARP-MOUSE (CHN:VSCHAN OPER X:FIX Y:FIX
 918                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 919         <VW-FLUSH-BUFFER .VW>
 920         <VSOP <VW-VS100 .VW> X-WARP-MOUSE <VW-ID .VW> .X .Y>
 921         .CHN>
 922
 923 <DEFINE VS-DRAW-LINE (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
 924                       "TUPLE" POINTS
 925                       "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
 926         <VW-FLUSH-BUFFER .VW>
 927         <COND (<OR <NOT <0? <MOD <LENGTH .POINTS> 2>>> <L? <LENGTH .POINTS> 4>>
 928                <ERROR WRONG-NUMBER-OF-ARGS!-ERRORS DRAW-LINE>)>
 929         <SCALE-POINT .POINTS .VW>
 930         <REPEAT ((X1 <1 .POINTS>) (Y1 <2 .POINTS>) (VV <REST .POINTS 2>))
 931                 <SCALE-POINT .VV .VW>
 932                 <VSOP <VW-VS100 .VW>
 933                       X-LINE
 934                       <COND (<NOT .FUNC> ,GX-XOR) (.FUNC)>
 935                       -1               ;"plane mask"
 936                       <VW-ID .VW>
 937                       .X1
 938                       .Y1
 939                       <1 .VV>
 940                       <2 .VV>
 941                       1 1 1>
 942                 <SET X1 <1 .VV>>
 943                 <SET Y1 <2 .VV>>
 944                 <COND (<EMPTY? <SET VV <REST .VV 2>>> <RETURN>)>>
 945         T>
 946
 947 <DEFINE SCALE-POINT (PT:<<PRIMTYPE VECTOR> [2 <OR FIX FLOAT>]> VW:VSW
 948                      "OPT" (RELATIVE?:<OR ATOM FALSE> <>)
 949                      "AUX" (SC:<OR FALSE SCALE> <VW-SCALE .VW>) NUM)
 950         <COND (<NOT .SC>
 951                <COND (<TYPE? <SET NUM <1 .PT>> FLOAT>
 952                       <1 .PT <FIX <+ .NUM 0.5>>>)>
 953                <COND (<TYPE? <SET NUM <2 .PT>> FLOAT>
 954                       <2 .PT <FIX <+ .NUM 0.5>>>)>)
 955               (T
 956                <COND (<TYPE? <SET NUM <1 .PT>> FIX> <SET NUM <FLOAT .NUM>>)>
 957                <1 .PT
 958                   <FIX <+ <* <COND (.RELATIVE? .NUM) (T <- .NUM <S-LEFT .SC>>)>
 959                              <S-WSCALE .SC>>
 960                           0.5>>>
 961                <COND (<TYPE? <SET NUM <2 .PT>> FIX> <SET NUM <FLOAT .NUM>>)>
 962                <2 .PT
 963                   <FIX <+ <* <COND (.RELATIVE? .NUM) (T <- .NUM <S-TOP .SC>>)>
 964                              <S-HSCALE .SC>>
 965                           0.5>>>)>>
 966
 967 <DEFINE VS-DRAW-FILLED
 968         (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
 969          FILL-PATTERN:<SPECIAL <OR ATOM FIX>> BORDER?:<SPECIAL <OR ATOM FALSE>>
 970          X1:FIX Y1:FIX DFLAGS:<OR FIX FALSE>
 971          "TUPLE" STUFF)
 972         <COND (<TYPE? .FILL-PATTERN ATOM>
 973                <SET FILL-PATTERN
 974                     <TRANSLATE-COLOR .FILL-PATTERN
 975                                      <VW-VS100 <CHANNEL-DATA .CHN>:VSW>>>)>
 976         <VS-DRAW .CHN .OPER .FUNC .X1 .Y1 .DFLAGS !.STUFF>>
 977
 978 <DEFINE VS-DRAW-DASHED (CHN:VSCHAN OPER FUNC:<OR FIX FALSE>
 979                         DASHED-PATTERN:<SPECIAL FIX>
 980                         DP-LENGTH:<SPECIAL <OR FIX FALSE>>
 981                         DP-MULT:<SPECIAL <OR FIX FALSE>>
 982                         X1:<OR FIX FLOAT> Y1:<OR FIX FLOAT> DFLAGS:<OR FIX FALSE>
 983                         "TUPLE" STUFF)
 984    <COND (<NOT .DP-LENGTH> <SET DP-LENGTH 16>)>
 985    <COND (<NOT .DP-MULT> <SET DP-MULT 1>)>
 986    <VS-DRAW .CHN .OPER .FUNC .X1 .Y1 .DFLAGS !.STUFF>>
 987
 988 <DEFINE VS-DRAW
 989         (CHN:VSCHAN OPER FUNC:<OR FIX FALSE> X1:<OR FIX FLOAT>
 990          Y1:<OR FIX FLOAT> DFLAGS:<OR FIX FALSE>
 991          "TUPLE" STUFF
 992          "AUX" (VERTS <STACK <ISTRING <* 2 <+ 3 <LENGTH .STUFF>>>>>) (CT 1)
 993                (VW:VSW <CHANNEL-DATA .CHN>) (P1 <STACK <VECTOR .X1 .Y1>>)
 994                (VS:VS <VW-VS100 .VW>))
 995    <VW-FLUSH-BUFFER .VW>
 996    <COND (<NOT .FUNC> <SET FUNC ,GX-XOR>)>
 997    <COND (<NOT .DFLAGS> <SET DFLAGS 0>)>
 998    <SCALE-POINT .P1 .VW>
 999    <PUT-WORD .VERTS .CT <1 .P1>>
1000    <PUT-WORD .VERTS <SET CT <+ .CT 1>> <2 .P1>>
1001    <PUT-WORD .VERTS
1002              <SET CT <+ .CT 1>>
1003              <ANDB .DFLAGS <XORB ,VERTEX-RELATIVE -1>>>
1004    <REPEAT ((VC 1))
1005            <COND
1006             (<EMPTY? .STUFF>
1007              <COND (<ASSIGNED? DASHED-PATTERN>
1008                     <VSOP .VS
1009                           X-DRAW
1010                           .FUNC
1011                           -1
1012                           <VW-ID .VW>
1013                           .VC
1014                           1
1015                           1
1016                           1
1017                           1
1018                           0
1019                           .DASHED-PATTERN
1020                           .DP-LENGTH
1021                           .DP-MULT
1022                           .VERTS>)
1023                    (<ASSIGNED? FILL-PATTERN>
1024                     <VSOP .VS
1025                           X-DRAW-FILLED
1026                           .FUNC
1027                           -1
1028                           <VW-ID .VW>
1029                           .VC
1030                           1
1031                           .FILL-PATTERN
1032                           .VERTS>
1033                     <COND (.BORDER?
1034                            <VSOP .VS
1035                                  X-DRAW
1036                                  <COND (<==? <VW-BG .VW> <VS-WHITE .VS>>
1037                                         ,GX-CLEAR)
1038                                        (T ,GX-SET)>
1039                                  -1
1040                                  <VW-ID .VW>
1041                                  .VC
1042                                  1
1043                                  1
1044                                  1
1045                                  0
1046                                  0
1047                                  0
1048                                  0
1049                                  0
1050                                  .VERTS>)>)
1051                    (T <VSOP .VS X-DRAW .FUNC -1 <VW-ID .VW> .VC
1052                             1 1 1 0 0 0 0 0 .VERTS>)>
1053              <RETURN>)>
1054            <COND (<L? <LENGTH .STUFF> 3>
1055                   <ERROR BAD-VERTICES!-ERRORS .STUFF DRAW>
1056                   <RETURN>)>
1057            <SET VC <+ .VC 1>>
1058            <SCALE-POINT .STUFF
1059                         .VW
1060                         <NOT <0? <ANDB <OR <3 .STUFF> .DFLAGS>
1061                                        ,VERTEX-RELATIVE>>>>
1062            <PUT-WORD .VERTS <SET CT <+ .CT 1>> <1 .STUFF>>
1063            <PUT-WORD .VERTS <SET CT <+ .CT 1>> <2 .STUFF>>
1064            <PUT-WORD .VERTS <SET CT <+ .CT 1>> <COND (<3 .STUFF>) (T .DFLAGS)>>
1065            <SET STUFF <REST .STUFF 3>>>>
1066
1067 <DEFINE PUT-WORD (BYTES:STRING OFFS:FIX WD:FIX "AUX" (TOFFS <* .OFFS 2>))
1068         <PUT .BYTES .TOFFS <CHTYPE <LSH .WD -8> CHARACTER>>
1069         <PUT .BYTES <- .TOFFS 1> <CHTYPE <ANDB .WD 255> CHARACTER>>>
1070
1071 <DEFINE VS-MOUSE-MOVE? (CHN:VSCHAN OPER
1072                         "OPT" ON?:<OR ATOM FALSE FIX>
1073                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
1074                               (VS:VS <VW-VS100 .VW>) OLD IP)
1075         <SET OLD <ANDB <SET IP <VW-INPUTS .VW>> ,MOTION-BITS>>
1076         <COND (<TYPE? .ON? ATOM> <SET ON? ,MOUSE-MOVED>)
1077               (<NOT .ON?> <SET ON? 0>)
1078               (<==? .ON? ,MOUSE-LEFT> <SET ON? ,LEFT-DOWN-MOTION>)
1079               (<==? .ON? ,MOUSE-RIGHT> <SET ON? ,RIGHT-DOWN-MOTION>)
1080               (<==? .ON? ,MOUSE-CENTER> <SET ON? ,MIDDLE-DOWN-MOTION>)
1081               (T
1082                <ERROR UNKNOWN-BIT-PATTERN!-ERRORS .ON? MOUSE-MOVE?>
1083                <SET ON? .OLD>)>
1084         <COND (<AND <ASSIGNED? ON?> <N==? .ON? .OLD>>
1085                <SET IP <ORB <ANDB .IP <XORB ,MOTION-BITS -1>> .ON?>>
1086                <VW-INPUTS .VW .IP>
1087                <VSOP .VS X-SELECT-INPUT <VW-ID .VW> .IP>)>
1088         <COND (<==? .OLD ,MOUSE-MOVED> T)
1089               (<==? .OLD ,LEFT-DOWN-MOTION> ,MOUSE-LEFT)
1090               (<==? .OLD ,RIGHT-DOWN-MOTION> ,MOUSE-RIGHT)
1091               (<==? .OLD ,MIDDLE-DOWN-MOTION> ,MOUSE-CENTER)
1092               (<0? .OLD> <>)>>
1093
1094 <DEFINE DEFINE-PATTERN
1095         (CHN:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER
1096          BITS:<OR <UVECTOR [8 FIX]> <BYTES [32 FIX]>>
1097          "AUX" VW:VSW VS:<OR VS FALSE>)
1098         <COND (<TYPE? .CHN CHANNEL>
1099                <SET VS <VW-VS100 <SET VW <CHANNEL-DATA .CHN>>>>)
1100               (T
1101                <SET VS <GET-VS100 .CHN>>)>
1102         <COND (.VS
1103                <VSOP .VS X-STORE-PIXMAP 0 0 16 16 .BITS>)>>
1104
1105 <DEFINE FREE-PATTERN (CHN:<OR VSCHAN <PRIMTYPE LIST> STRING> OPER PAT:FIX
1106                          "AUX" VW:VSW VS:<OR VS FALSE>)
1107    <COND (<TYPE? .CHN CHANNEL>
1108           <SET VS <VW-VS100 <SET VW <CHANNEL-DATA .CHN>>>>)
1109          (T
1110           <SET VS <GET-VS100 .CHN>>)>
1111    <COND (.VS
1112           <VSOP <VW-VS100 .VW> X-FREE-PIXMAP 0 .PAT>)>>
1113
1114 <DEFINE VS-CLEAR-REGION
1115         (CHN:VSCHAN OPER HEIGHT:<OR FIX FLOAT> WIDTH:<OR FIX FLOAT>
1116          LEFT:<OR FIX FLOAT> TOP:<OR FIX FLOAT>
1117          "OPT" FUNC:FIX
1118          "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
1119                (CC <STACK <VECTOR .WIDTH .HEIGHT .LEFT .TOP>>))
1120         <COND (<NOT <ASSIGNED? FUNC>>
1121                <COND (<==? <VW-BG .VW> <VS-WHITE .VS>> <SET FUNC ,GX-SET>)
1122                      (T <SET FUNC ,GX-CLEAR>)>)>
1123         <VW-FLUSH-BUFFER .VW>
1124         <SCALE-POINT .CC .VW T>
1125         <SCALE-POINT <REST .CC 2> .VW>
1126         <VSOP .VS
1127               X-PIX-FILL
1128               .FUNC
1129               -1
1130               <VW-ID .VW>
1131               <2 .CC>
1132               <1 .CC>
1133               <3 .CC>
1134               <4 .CC>
1135               1
1136               0>>
1137
1138 <DEFINE VS-FILL-REGION
1139         (CHN:VSCHAN OPER PAT:<OR ATOM FIX> HEIGHT:<OR FIX FLOAT>
1140          WIDTH:<OR FIX FLOAT> LEFT:<OR FIX FLOAT> TOP:<OR FIX FLOAT> FUNC:FIX
1141          "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
1142                (CC <STACK <VECTOR .WIDTH .HEIGHT .LEFT .TOP>>))
1143         <COND (<TYPE? .PAT ATOM> <SET PAT <TRANSLATE-COLOR .PAT .VS>>)>
1144         <VW-FLUSH-BUFFER .VW>
1145         <SCALE-POINT .CC .VW T>
1146         <SCALE-POINT <REST .CC 2> .VW>
1147         <VSOP .VS
1148               X-TILE-FILL
1149               .FUNC
1150               -1
1151               <VW-ID .VW>
1152               <2 .CC>
1153               <1 .CC>
1154               <3 .CC>
1155               <4 .CC>
1156               .PAT
1157               0>>
1158
1159 <DEFINE INVERSE-VIDEO (CHN:<OR VSCHAN VSW> OPER "OPT" ON?:<OR ATOM FALSE>
1160                        (CURSOFF? <>)
1161                        "AUX" (VW:VSW <COND (<TYPE? .CHN VSW> .CHN)
1162                                            (T <CHANNEL-DATA .CHN>)>) OLD)
1163    <SET OLD <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>>
1164    <COND (<ASSIGNED? ON?>
1165           <VW-FLUSH-BUFFER .VW .CURSOFF?>
1166           <COND (.ON?
1167                  <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-INVERT>>)
1168                 (T
1169                  <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW> <XORB ,VWM-INVERT -1>>>)>)>
1170    .OLD>
1171
1172 <DEFINE UNDERLINE (CHN:<OR VSCHAN VSW> OPER "OPT" ON?:<OR ATOM FALSE>
1173                    (CURSOFF? <>)
1174                    "AUX" (VW:VSW <COND (<TYPE? .CHN VSW> .CHN)
1175                                        (T <CHANNEL-DATA .CHN>)>) OLD)
1176    <SET OLD <TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>>
1177    <COND (<ASSIGNED? ON?>
1178           <VW-FLUSH-BUFFER .VW .CURSOFF?>
1179           <COND (.ON?
1180                  <COND (<NOT <VW-HIGHX .VW>>
1181                         <VW-HIGHX .VW <VW-X .VW>>)>
1182                  <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNDER>>)
1183                 (T
1184                  <COND (<NOT <VW-HIGHLIGHT .VW>>
1185                         <VW-HIGHX .VW <>>)>
1186                  <VW-OUTMODE .VW <ANDB <VW-OUTMODE .VW> <XORB ,VWM-UNDER -1>>>)>)>
1187    .OLD>
1188
1189 <DEFINE VS-SET-HIGHLIGHT (CHN:<OR VSCHAN VSW> OPER
1190                           "OPT" PAT:<OR FIX FALSE>
1191                                 (CURSOFF?:<OR ATOM FALSE> <>)
1192                           "AUX" (VW:VSW
1193                                  <COND (<TYPE? .CHN VSW> .CHN)
1194                                        (T <CHANNEL-DATA .CHN>)>))
1195         <COND (<NOT <ASSIGNED? PAT>> <VW-HIGHLIGHT .VW>)
1196               (T
1197                <VW-FLUSH-BUFFER .VW <NOT .CURSOFF?>>
1198                <VW-HIGHLIGHT .VW .PAT>
1199                <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>)
1200                      (<AND .PAT <NOT <0? .PAT>>>
1201                       <VW-HIGHX .VW <VW-X .VW>>)
1202                      (T
1203                       <VW-HIGHX .VW <>>)>)>>
1204
1205 <DEFINE TRANSLATE-COLOR (CLR:<OR ATOM FIX> VS:VS)
1206         <COND (<TYPE? .CLR FIX> .CLR)
1207               (<==? .CLR BLACK> <VS-BLACK .VS>)
1208               (<==? .CLR WHITE> <VS-WHITE .VS>)
1209               (<==? .CLR GRAY> <VS-GRAY .VS>)
1210               (T <ERROR BAD-COLOR-NAME!-ERRORS .CLR TRANSLATE-COLOR>)>>
1211
1212 <DEFINE VS-CHANGE-COLOR (CHANNEL:VSCHAN OPER BG:<OR ATOM FIX>
1213                          "OPT" BORDER:<OR ATOM FIX>
1214                          "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
1215                                (VS <VW-VS100 .VW>))
1216         <VW-FLUSH-BUFFER .VW>
1217         <SET BG <TRANSLATE-COLOR .BG .VS>>
1218         <COND (<NOT <ASSIGNED? BORDER>> <SET BORDER <VW-BORDER .VW>>)
1219               (T <SET BORDER <TRANSLATE-COLOR .BORDER .VS>>)>
1220         <COND (<N==? .BG <VW-BG .VW>>
1221                <VW-BG .VW .BG>
1222                <COND (<==? .BG <VS-BLACK .VS>>
1223                       <VW-TEXT-OP .VW ,GX-COPY>)
1224                      (<==? .BG <VS-WHITE .VS>>
1225                       <VW-TEXT-OP .VW ,GX-COPY-INVERTED>)
1226                      (T
1227                       <VW-TEXT-OP .VW ,GX-XOR>)>
1228                <VSOP .VS X-CHANGE-BACKGROUND .VW .BG>)>
1229         <COND (<N==? .BORDER <VW-BORDER .VW>>
1230                <VW-BORDER .VW .BORDER>
1231                <VSOP .VS X-CHANGE-BORDER .VW .BORDER>)>
1232         T>
1233
1234 <DEFINE VS-MAP MW (CHN:VSCHAN OPER
1235                    "AUX" (VW:VSW <CHANNEL-DATA .CHN>) P TOP:FIX LEFT:FIX
1236                          WIDTH:FIX HEIGHT:FIX (VS:VS <VW-VS100 .VW>) BWIDTH
1237                          NVW:VSW SAVE-RASTER)
1238         <VW-FLUSH-BUFFER .VW>
1239         <COND (<SET SAVE-RASTER <VW-SAVE .VW>>
1240                <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
1241                       <COND (<NOT <0? <I-BPAR10 .P>>> <RETURN .CHN .MW>)>
1242                       <COND (<NOT <0? .SAVE-RASTER>>
1243                              <VSOP .VS X-FREE-PIXMAP 0 .SAVE-RASTER>)>
1244                       <SET HEIGHT <I-SPAR0 .P>>
1245                       <SET WIDTH <I-SPAR1 .P>>
1246                       <SET TOP <I-SPAR3 .P>>
1247                       <SET LEFT <I-SPAR2 .P>>
1248                       <SET BWIDTH <I-SPAR4 .P>>
1249                       <SET NVW <CHANNEL-DATA <VW-PARENT .VW>:VSCHAN>>
1250                       <SET WIDTH
1251                            <MIN <- <VW-WIDTH .NVW> .LEFT>
1252                                 <+ .WIDTH <* 2 .BWIDTH>>>>
1253                       <SET HEIGHT
1254                            <MIN <- <VW-HEIGHT .NVW> .TOP>
1255                                 <+ .HEIGHT <* 2 .BWIDTH>>>>
1256                       <COND (<SET SAVE-RASTER
1257                                   <VSOP .VS
1258                                         X-PIXMAP-SAVE
1259                                         <VW-ID .NVW>
1260                                         .HEIGHT
1261                                         .WIDTH
1262                                         .LEFT
1263                                         .TOP>>
1264                              <VW-SAVE .VW .SAVE-RASTER>)>)>)>
1265         <VSOP <VW-VS100 .VW> X-MAP-WINDOW <VW-ID .VW>>>
1266
1267 <DEFINE VS-UNMAP (CHN:VSCHAN OPER "OPT" (QUIET? <>)
1268                   "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1269         <VW-FLUSH-BUFFER .VW>
1270         <COND (<OR .QUIET?
1271                    <AND <VW-PARENT .VW> <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>>
1272                ; "Inhibit redisplay events in this case"
1273                <VSOP <VW-VS100 .VW> X-UNMAP-TRANSPARENT <VW-ID .VW>>
1274                <RESTORE-WIND .VW>)
1275               (T
1276                <VSOP <VW-VS100 .VW> X-UNMAP-WINDOW <VW-ID .VW>>)>>
1277
1278 <DEFINE RESTORE-WIND RW (VW:VSW
1279                          "AUX" (RAST <VW-SAVE .VW>) P CM
1280                                (PCH:<OR FALSE VSCHAN> <VW-PARENT .VW>) NVW:VSW
1281                                (VS:VS <VW-VS100 .VW>) TOP:FIX LEFT:FIX)
1282         <COND (<AND .PCH .RAST <NOT <0? .RAST>>>
1283                <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
1284                       <SET TOP <I-SPAR3 .P>>
1285                       <SET LEFT <I-SPAR2 .P>>)
1286                      (T
1287                       <SET TOP 0>
1288                       <SET LEFT 0>)>
1289                <SET NVW <CHANNEL-DATA .PCH>>
1290                <COND (<AND <> <SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .NVW>>>>
1291                       ; "Doesn't seem to be any way to get clipmode"
1292                       <COND (<0? <I-BPAR10 .P>> <RETURN .VW .RW>)>
1293                       <SET CM <I-SPAR6 .P>>)
1294                      (T <SET CM 0>)>
1295                <VSOP .VS X-CLIPMODE 1 <VW-ID .NVW>>
1296                <VSOP .VS
1297                      X-PIXMAP-PUT
1298                      ,GX-COPY
1299                      -1
1300                      <VW-ID .NVW>
1301                      <MIN <- <VW-HEIGHT .NVW> .TOP>
1302                           <+ <* 2 <VW-BWIDTH .VW>> <VW-HEIGHT .VW>>>
1303                      <MIN <- <VW-WIDTH .NVW> .LEFT>
1304                           <+ <* 2 <VW-BWIDTH .VW>> <VW-WIDTH .VW>>>
1305                      0
1306                      0
1307                      .RAST
1308                      .LEFT
1309                      .TOP>
1310                <VSOP .VS X-CLIPMODE .CM <VW-ID .NVW>>
1311                <VSOP .VS X-FREE-PIXMAP 0 .RAST>
1312                <VW-SAVE .VW 0>
1313                <VSB-DUMP .VS>)>>
1314
1315 <DEFINE VS-CLOSE (CHN:VSCHAN OPER
1316                   "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
1317                         (OC <AND <ASSIGNED? CLOSING?> .CLOSING?>)
1318                         (CLOSING?:<SPECIAL ATOM> T) (VS:VS <VW-VS100 .VW>)
1319                         PC:CHANNEL NVW:VSW CD RAST P CM TC)
1320    <COND (<SET TC <VW-REAL .VW>>
1321           <VW-ICON <CHANNEL-DATA .TC>:VSW <>>
1322           <CLOSE .TC>)
1323          (<SET TC <VW-ICON .VW>>
1324           <VW-REAL <CHANNEL-DATA .TC>:VSW <>>
1325           <CLOSE .TC>)>
1326    <MAPF <> <FUNCTION (C:VSCHAN) <CLOSE .C>> <VW-KIDS .VW>>
1327    <COND (<AND <SET CD <VW-CURS-DESC .VW>> <NOT <TYPE? .CD ATOM>>>
1328           <DESTROY-CURSOR .CD .VS>)>
1329    <COND (<NOT <EMPTY? <VW-MENU-WINDS .VW>>>
1330           <PUTREST <REST <VW-MENU-WINDS .VW>
1331                          <- <LENGTH <VW-MENU-WINDS .VW>> 1>>
1332                    ,MENU-WINDOW-LIST>
1333           <SETG MENU-WINDOW-LIST <VW-MENU-WINDS .VW>>
1334           <VW-MENU-WINDS .VW ()>)>
1335    <COND (<NOT .OC>
1336           <VW-KIDS <SET NVW <CHANNEL-DATA <SET PC <VW-PARENT .VW>>>>
1337                    <SPLICE-OUT .CHN <VW-KIDS .NVW>>>
1338           <VS-ALL .VS <SPLICE-OUT <VW-ID .VW> <VS-ALL .VS> 2>>
1339           <COND (<AND <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>
1340                  ; "There's something underneath this"
1341                  <CHANNEL-OP .CHN UNMAP T>
1342                  ; "So unmap it quietly, which will restore the window")>
1343           <VSOP .VS X-DESTROY-WINDOW <VW-ID .VW>>)
1344          (<AND <VW-SAVE .VW> <NOT <0? <VW-SAVE .VW>>>>
1345           <VSOP .VS X-FREE-PIXMAP 0 <VW-SAVE .VW>>)>
1346    .CHN>
1347
1348 <DEFINE SPLICE-OUT (FROB:ANY L:LIST "OPT" (N:FIX 1) "AUX" TL:<OR LIST FALSE>)
1349         <COND (<SET TL <MEMQ .FROB .L>>
1350                <COND (<==? .TL .L> <REST .TL .N>)
1351                      (T
1352                       <SET TL <REST .L <- <LENGTH .L> <LENGTH .TL> 1>>>
1353                       <PUTREST .TL <REST .TL <+ .N 1>>>
1354                       .L)>)
1355               (T .L)>>
1356
1357 <SETG MENU-WINDOW-LIST ()>
1358
1359 <GDECL (MENU-WINDOW-LIST) <LIST [REST MENU-WINDOW]>>
1360
1361 <DEFINE VS-MENU-WINDOW
1362         (CHN:VSCHAN OPER HEIGHT:<OR FIX FALSE> WIDTH:FIX LEFT:FIX TOP:FIX
1363          "OPT" (OBJ:ANY <>) TXT:<OR STRING FALSE>
1364          "AUX" WID (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
1365                (MWL:LIST ,MENU-WINDOW-LIST) MW:MENU-WINDOW)
1366    <COND (<NOT .HEIGHT> <SET HEIGHT <FONT-HEIGHT <VW-CFONT .VW>>>)>
1367    <VW-FLUSH-BUFFER .VW>
1368    <COND
1369     (<SET WID
1370           <VSOP .VS
1371                 X-CREATE-WINDOW
1372                 0
1373                 <VW-ID .VW>
1374                 .HEIGHT
1375                 .WIDTH
1376                 .LEFT
1377                 .TOP
1378                 <VW-BORDER .VW>
1379                 <VW-BG .VW>>>
1380      <VSOP .VS X-DEFINE-CURSOR .WID 0>
1381      <VSOP .VS X-MAP-WINDOW .WID>
1382      <COND (<EMPTY? .MWL>
1383             <VW-MENU-WINDS .VW
1384                            (<SET MW
1385                                  <CHTYPE <VECTOR .WID
1386                                                  .HEIGHT
1387                                                  .WIDTH
1388                                                  .OBJ
1389                                                  ,VWM-UNSEEN>
1390                                          MENU-WINDOW>>
1391                             !<VW-MENU-WINDS .VW>)>)
1392            (T
1393             <SET MW <1 .MWL>>
1394             <MW-ID .MW .WID>
1395             <MW-HEIGHT .MW .HEIGHT>
1396             <MW-WIDTH .MW .WIDTH>
1397             <MW-OBJ .MW .OBJ>
1398             <MW-BITS .MW ,VWM-UNSEEN>
1399             <SETG MENU-WINDOW-LIST <REST .MWL>>
1400             <VW-MENU-WINDS .VW <PUTREST .MWL <VW-MENU-WINDS .VW>>>)>
1401      <COND (<NOT <ASSIGNED? TXT>>
1402             <COND (<TYPE? .OBJ STRING> <SET TXT .OBJ>) (T <SET TXT <>>)>)>
1403      <COND (.TXT <CHANNEL-OP .CHN WRITE-TO-MENU-WINDOW .MW .TXT>)>
1404      .MW)>>
1405
1406 <DEFINE VS-CLEAR-MENU-WINDOW (CHN:VSCHAN OPER MW:MENU-WINDOW
1407                               "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
1408                                     (VS:VS <VW-VS100 .VW>))
1409         <VSOP .VS X-CLEAR <MW-ID .MW>>
1410         <MW-OBJ .MW <>>>
1411
1412 <DEFINE VS-SELECT-MENU-WINDOW (CHN:VSCHAN OPER
1413                                "OPT" (MW:<OR MENU-WINDOW FALSE> <>)
1414                                "AUX" (VW:VSW <CHANNEL-DATA .CHN>) L)
1415         <COND (<NOT .MW>
1416                <COND (<NOT <EMPTY? <SET L <VW-MENU-WINDS .VW>>>>
1417                       <SET MW <NTH .L <LENGTH .L>>>)>)>
1418         <COND (.MW
1419                <VSOP <VW-VS100 .VW>
1420                      X-WARP-MOUSE
1421                      <MW-ID .MW>
1422                      </ <MW-WIDTH .MW> 2>
1423                      </ <MW-HEIGHT .MW> 2>>)>>
1424
1425 <DEFINE VS-WRITE-TO-MENU (CHN:VSCHAN OPER MW:MENU-WINDOW TXT:STRING
1426                           "OPT" (X:FIX 0) (Y:FIX 0) FONT:STRING
1427                           "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
1428                                 (CFONT:<OR FONT FALSE> <VW-CFONT .VW>)
1429                                 (VS:VS <VW-VS100 .VW>))
1430         <COND (<ASSIGNED? FONT> <SET CFONT <GET-FONT .FONT .VS>>)>
1431         <COND (.CFONT
1432                <MW-OBJ .MW .TXT>
1433                <VSOP .VS
1434                      X-TEXT
1435                      <VW-TEXT-OP .VW>
1436                      -1
1437                      <MW-ID .MW>
1438                      0
1439                      0
1440                      <FONT-ID .CFONT>
1441                      1 0
1442                      <LENGTH .TXT>
1443                      0 0               ;"PADDING BETWEEN CHARS"
1444                      .TXT>)>>
1445
1446 <DEFINE VS-INVERT-MENU (CHN:VSCHAN OPER MW:MENU-WINDOW)
1447         <VSOP <VW-VS100 <CHANNEL-DATA .CHN>:VSW>
1448               X-PIX-FILL
1449               ,GX-INVERT
1450               -1
1451               <MW-ID .MW>
1452               <MW-HEIGHT .MW>
1453               <MW-WIDTH .MW>
1454               0
1455               0
1456               1
1457               0>
1458         T>
1459
1460 <DEFINE VS-SET-FONT (CHN:VSCHAN OPER
1461                      "OPT" FONT:STRING
1462                      "AUX" (VW:VSW <CHANNEL-DATA .CHN>) TF
1463                            (VS:VS <VW-VS100 .VW>) P (MH 0) (MW 0))
1464         <COND (<NOT <ASSIGNED? FONT>>
1465                <COND (<SET TF <VW-CFONT .VW>> <FONT-NAME .TF>)>)
1466               (<SET TF <GET-FONT .FONT <VW-VS100 .VW>>>
1467                <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
1468                       <SET MH <I-SPAR0 .P>>
1469                       <SET MW <I-SPAR2 .P>>)>
1470                <VSOP .VS
1471                      X-SET-RESIZE-HINT
1472                      <VW-ID .VW>
1473                      .MH
1474                      <FONT-HEIGHT .TF>
1475                      .MW
1476                      <FONT-WIDTH .TF>>
1477                <CURSOR-OFF .VW>
1478                <VW-CFONT .VW .TF>
1479                <CURSOR-ON .VW>
1480                .FONT)>>
1481
1482 <SETG BUF1 <ISTRING 1>>
1483
1484 <GDECL (BUF1) STRING>
1485
1486 <DEFINE VS-IMAGE-OUT (CHANNEL:VSCHAN OPER CHRS:<OR STRING CHARACTER>
1487                       "OPT" (LENGTH:<OR FIX FALSE> <>)
1488                             (X:<OR FIX FLOAT FALSE> <>)
1489                             (Y:<OR FIX FLOAT FALSE> <>)
1490                             (FONT:<OR FONT STRING FALSE> <>)
1491                             (DOP:<OR FIX FALSE> <>)
1492                       "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>)
1493                             (PP <STACK <VECTOR .X .Y>>) (CFONT <VW-CFONT .VW>)
1494                             (VS:VS <VW-VS100 .VW>))
1495         <VW-FLUSH-BUFFER .VW>
1496         <COND (.FONT
1497                <COND (<TYPE? .FONT FONT> <SET CFONT .FONT>)
1498                      (T <SET CFONT <GET-FONT .FONT .VS>>)>)>
1499         <GET-COORDS .VW .PP>
1500         <COND (<NOT .DOP> <SET DOP <VW-TEXT-OP .VW>>)>
1501         <COND (<TYPE? .CHRS CHARACTER> <SET CHRS <1 ,BUF1 .CHRS>>)>
1502         <COND (<NOT .LENGTH> <SET LENGTH <LENGTH .CHRS>>)
1503               (T <SET LENGTH <MIN .LENGTH <LENGTH .CHRS>>>)>
1504         <VSOP .VS
1505               X-TEXT
1506               .DOP
1507               -1
1508               <VW-ID .VW>
1509               <1 .PP>
1510               <2 .PP>
1511               <FONT-ID .CFONT>
1512               1
1513               0
1514               .LENGTH
1515               0 0
1516               .CHRS>
1517         .LENGTH>
1518
1519 <DEFINE GET-COORDS (VW:VSW PP:<<PRIMTYPE VECTOR> [2 <OR FIX FLOAT FALSE>]>
1520                     "AUX" (SC <VW-SCALE .VW>) (OX <VW-X .VW>) (OY <VW-Y .VW>)
1521                           (X <1 .PP>) (Y <2 .PP>))
1522         <COND (<NOT .SC>
1523                <COND (<TYPE? .X FLOAT> <SET X <FIX <+ .X 0.5>>>)>
1524                <1 .PP <OR .X .OX>>
1525                <COND (<TYPE? .Y FLOAT> <SET Y <FIX <+ .Y 0.5>>>)>
1526                <2 .PP <OR .Y .OY>>)
1527               (<AND <NOT .X> <NOT .Y>> <1 .PP .OX> <2 .PP .OY>)
1528               (T
1529                <COND (<NOT .X>
1530                       <1 .PP <S-LEFT .SC>>
1531                       <SCALE-POINT .PP .VW>
1532                       <1 .PP .OX>)
1533                      (<NOT .Y>
1534                       <1 .PP <S-TOP .SC>>
1535                       <SCALE-POINT .PP .VW>
1536                       <2 .PP .OY>)
1537                      (T <SCALE-POINT .PP .VW>)>)>>
1538
1539 <DEFINE VS-NORMAL-OUT (CHANNEL:VSCHAN OPER CHRS:<OR STRING CHARACTER>
1540                        "OPT" (LENGTH:<OR FIX FALSE> <>)
1541                              (X:<OR FIX FLOAT FALSE> <>)
1542                              (Y:<OR FIX FLOAT FALSE> <>)
1543                              (FONT:<OR FONT STRING FALSE> <>)
1544                              (DOP:<OR FIX FALSE> <>)
1545                        "AUX" (VW:VSW <CHANNEL-DATA .CHANNEL>) ODOP
1546                              (CFONT <VW-CFONT .VW>) (RFONT .CFONT) HIGH
1547                              (PP <STACK <VECTOR .X .Y>>))
1548    <COND (<TYPE? .CHRS CHARACTER> <SET CHRS <1 ,BUF1 .CHRS>> <SET LENGTH 1>)
1549          (<NOT .LENGTH> <SET LENGTH <LENGTH .CHRS>>)
1550          (T <SET LENGTH <MIN .LENGTH <LENGTH .CHRS>>>)>
1551    <COND
1552     (<G? .LENGTH 0>
1553      <COND
1554       (<COND (<NOT .FONT> T)
1555              (<TYPE? .FONT FONT> <SET RFONT .FONT>)
1556              (T <SET RFONT <GET-FONT .FONT <VW-VS100 .VW>>>)>
1557        <GET-COORDS .VW .PP>
1558        <SET X <1 .PP>>
1559        <SET Y <2 .PP>>
1560        <COND (<==? .DOP <SET ODOP <VW-TEXT-OP .VW>>> <SET DOP <>>)>
1561        <COND (<OR <N==? .RFONT .CFONT>
1562                   <N==? .Y:FIX <VW-Y .VW>>
1563                   <N==? .X:FIX <VW-X .VW>>
1564                   .DOP>
1565               <CURSOR-OFF .VW>
1566               <COND (<G? <VW-OCT .VW> 0> <VW-FLUSH-BUFFER .VW T>)>
1567               <CHANNEL-OP .CHANNEL MOVE-CURSOR-ABS .X .Y <> <>>
1568               <VW-CFONT .VW .RFONT>)>
1569        <COND (.DOP <VW-TEXT-OP .VW .DOP>)>
1570        <REPEAT ((CT:FIX 0) CHR:CHARACTER (LAST <CHTYPE -1 CHARACTER>))
1571          <SET CHR <CHTYPE <ANDB <1 .CHRS> 127> CHARACTER>>
1572          <SET CHRS <REST .CHRS>>
1573          <SET CT <+ .CT 1>>
1574          <COND (<AND <G=? <ASCII .CHR> 33> <L=? <ASCII .CHR> 126>>
1575                 <VS-CHAR .CHANNEL .VW .CHR>)
1576                (<==? .CHR <ASCII 27>> <VS-CHAR .CHANNEL .VW !\$>)
1577                (<==? .CHR <ASCII 32>>
1578                 <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
1579                        <VW-FLUSH-BUFFER .VW <>>
1580                        <CHANNEL-OP .CHANNEL UNDERLINE <>>
1581                        <VS-CHAR .CHANNEL .VW .CHR>
1582                        <CHANNEL-OP .CHANNEL UNDERLINE T>)
1583                       (T
1584                        <VS-CHAR .CHANNEL .VW .CHR>)>)
1585                (<AND <==? .CHR <ASCII 10>> <==? .LAST <ASCII 13>>>)
1586                (<OR <==? .CHR <ASCII 13>> <==? .CHR <ASCII 10>>>
1587                 <DO-LF .CHANNEL .VW>)
1588                (<==? .CHR <ASCII 9>>
1589                 <CURSOR-OFF .VW>
1590                 <VW-FLUSH-BUFFER .VW <>>
1591                 <SET HIGH <>>
1592                 <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
1593                        <SET HIGH <CHANNEL-OP .CHANNEL UNDERLINE <>>>
1594                        <CURSOR-OFF .VW>)>
1595                 <PROG ((X <VW-X .VW>) (AW <FONT-WIDTH <VW-CFONT .VW>>)
1596                        (LEN <- <* 8 .AW> <MOD .X <* 8 .AW>>>) OH)
1597                       <COND (<G? <SET X <+ .X .LEN>> <VW-WIDTH .VW>>
1598                              <COND (<SET OH <VW-HIGHLIGHT .VW>>
1599                                     <CHANNEL-OP .CHANNEL SET-HIGHLIGHT <>>)>
1600                              <VW-X .VW 0>
1601                              <CHANNEL-OP .CHANNEL DOWN-CURSOR>
1602                              <CHANNEL-OP .CHANNEL CLEAR-EOL>
1603                              <COND (.OH
1604                                     <CHANNEL-OP .CHANNEL SET-HIGHLIGHT .OH>)>
1605                              <VW-X .VW <- .X <VW-WIDTH .VW>>>)
1606                             (T <VW-X .VW .X>)>
1607                       <VW-OX .VW .X>>
1608                 <COND (.HIGH
1609                        <CHANNEL-OP .CHANNEL UNDERLINE T>)>
1610                 <CURSOR-ON .VW>)
1611                (<==? .CHR <ASCII 7>>
1612                 <VW-FLUSH-BUFFER .VW>
1613                 <VSOP <VW-VS100 .VW> X-FEEP 0 <VW-ID .VW>>)
1614                (<N==? .CHR <ASCII 127>>
1615                 <VS-CHAR .CHANNEL
1616                          .VW
1617                          !\^
1618                          <ASCII <ANDB <+ <ASCII .CHR> 64> 127>>>)>
1619          <SET LAST .CHR>
1620          <COND (<G=? .CT .LENGTH> <RETURN .CT>)>>
1621        <COND (<OR .DOP <N==? .CFONT .RFONT>>
1622               <VW-FLUSH-BUFFER .VW T>
1623               <VW-TEXT-OP .VW .DOP>
1624               <VW-CFONT .VW .CFONT>)>
1625        .LENGTH)>)>>
1626
1627 <DEFINE DO-LF (CHN:VSCHAN VW:VSW
1628                "AUX" (Y <VW-Y .VW>) (X <VW-X .VW>) (HEIGHT <VW-HEIGHT .VW>)
1629                      (LH <FONT-HEIGHT <VW-CFONT .VW>>)
1630                      (MODE <VW-OUTMODE .VW>))
1631         <CURSOR-OFF .VW>
1632         <VW-FLUSH-BUFFER .VW <>>
1633         <COND (<G? <SET Y <+ .Y .LH>> <- .HEIGHT .LH>> <SET Y 0>)>
1634         <VW-Y .VW .Y>
1635         <VW-X .VW 0>
1636         <VW-OY .VW .Y>
1637         <VW-OX .VW 0>
1638         <VS-CLEAR-EOL .CHN CLEAR-EOL>>
1639
1640 <DEFINE VS-CLEAR-EOL (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1641         <VW-CURSOR .VW <>>
1642         <VW-FLUSH-BUFFER .VW <>>
1643         <VSOP <VW-VS100 .VW>
1644               X-TILE-FILL
1645               ,GX-COPY
1646               -1
1647               <VW-ID .VW>
1648               <FONT-HEIGHT <VW-CFONT .VW>>
1649               <- <VW-WIDTH .VW> <VW-X .VW>>
1650               <VW-X .VW>
1651               <VW-Y .VW>
1652               <VW-BG .VW>
1653               0>
1654         <CURSOR-ON .VW>>
1655
1656 <DEFINE VS-CLEAR-SCREEN (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1657         <VW-HIGHLIGHT .VW <>>
1658         <VW-HIGHX .VW <>>
1659         <VW-OUTMODE .VW
1660                     <ANDB <VW-OUTMODE .VW> <XORB -1 <ORB ,VWM-UNDER ,VWM-INVERT>>>>
1661         <VW-CURSOR .VW <>>
1662         <VW-OCT .VW 0>
1663         <VW-OBUF .VW <VW-TOBUF .VW>>
1664         <VW-X .VW 0>
1665         <VW-Y .VW 0>
1666         <VW-OX .VW 0>
1667         <VW-OY .VW 0>
1668         <VSOP <VW-VS100 .VW> X-CLEAR <VW-ID .VW>>
1669         <CURSOR-ON .VW>
1670         <UPDATE-MC .CHN 0 0>>
1671
1672 <DEFINE VS-CLEAR-EOS (CHN:VSCHAN OPER
1673                       "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>))
1674         <VW-CURSOR .VW <>>
1675         <VW-FLUSH-BUFFER .VW <>>
1676         <COND (<NOT <0? <VW-X .VW>>>
1677                <CHANNEL-OP .CHN CLEAR-EOL>
1678                <SET Y <+ .Y <FONT-HEIGHT <VW-CFONT .VW>>>>)>
1679         <VSOP <VW-VS100 .VW>
1680               X-TILE-FILL
1681               ,GX-COPY
1682               -1
1683               <VW-ID .VW>
1684               <- <VW-HEIGHT .VW> .Y>
1685               <VW-WIDTH .VW>
1686               0
1687               .Y
1688               <VW-BG .VW>
1689               0>
1690         <CURSOR-ON .VW>>
1691
1692 <SETG CRLF-STRING <STRING <ASCII 13> <ASCII 10>>>
1693
1694 <DEFINE VS-CHAR (CHN:VSCHAN VW:VSW
1695                  "TUPLE" CHARS:<<PRIMTYPE VECTOR> [REST CHARACTER]>
1696                  "AUX" (X:FIX <VW-X .VW>) (FONT:FONT <VW-CFONT .VW>)
1697                        (WIDTH:FIX <COND (<TYPE? <CHANNEL-USER .CHN> MUD-CHAN>
1698                                          <* <M-HLEN .CHN> <FONT-WIDTH .FONT>>)
1699                                         (T
1700                                          <VW-WIDTH .VW>)>)
1701                        HIGH UNDER)
1702         <MAPF <>
1703               <FUNCTION (CHR:CHARACTER "AUX" WID)
1704                       <COND (<G? <SET X
1705                                       <+ .X <SET WID <CHAR-WIDTH .CHR .FONT>>>>
1706                                  .WIDTH>
1707                              <OUTPUT-STRING .CHN !\!>
1708                              <SET HIGH <VW-HIGHLIGHT .VW>>
1709                              <SET UNDER <CHANNEL-OP .CHN UNDERLINE <>>>
1710                              <CHANNEL-OP .CHN SET-HIGHLIGHT <>>
1711                              <VS-NORMAL-OUT .CHN NORMAL-OUT ,CRLF-STRING>
1712                              <CHANNEL-OP .CHN SET-HIGHLIGHT .HIGH>
1713                              <CHANNEL-OP .CHN UNDERLINE .UNDER>
1714                              <SET X .WID>)>
1715                       <VW-X .VW .X>
1716                       <OUTPUT-STRING .CHN .CHR>>
1717               .CHARS>>
1718
1719 <DEFINE OUTPUT-STRING (CHN:VSCHAN CHR:<OR CHARACTER STRING>
1720                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (OBUF <VW-OBUF .VW>)
1721                              (OCT <VW-OCT .VW>) LEN:FIX)
1722    <COND (<TYPE? .CHR CHARACTER> <SET LEN 1> <SET CHR <1 ,BUF1 .CHR>>)
1723          (T <SET LEN <LENGTH .CHR>>)>
1724    <COND
1725     (<NOT .OBUF>
1726      <CURSOR-OFF .VW>
1727      <VSOP <VW-VS100 .VW>
1728            X-TEXT
1729            <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
1730                   <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY> ,GX-COPY-INVERTED)
1731                         (<==? <VW-TEXT-OP .VW> ,GX-COPY-INVERTED> ,GX-COPY)
1732                         (T ,GX-EQUIV)>)
1733                  (T <VW-TEXT-OP .VW>)>
1734            -1
1735            <VW-ID .VW>
1736            <VW-OX .VW>
1737            <VW-OY .VW>
1738            <FONT-ID <VW-CFONT .VW>>
1739            1 0
1740            .LEN
1741            0 0
1742            .CHR>
1743      <VW-OX .VW <VW-X .VW>>
1744      <VW-OY .VW <VW-Y .VW>>
1745      <CURSOR-ON .VW>)
1746     (T
1747      <PROG ((TRANS 0) (CURSOR-IS-OFF <>))
1748        <COND (<G? .LEN <SET TRANS <LENGTH .OBUF>>>
1749               <COND (<0? .OCT>
1750                      <CURSOR-OFF .VW>
1751                      <SET CURSOR-IS-OFF T>
1752                      <VSOP <VW-VS100 .VW>
1753                            X-TEXT
1754                            <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
1755                                   <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY>
1756                                          ,GX-COPY-INVERTED)
1757                                         (<==? <VW-TEXT-OP .VW>
1758                                               ,GX-COPY-INVERTED>
1759                                          ,GX-COPY)
1760                                         (T ,GX-EQUIV)>)
1761                                  (T <VW-TEXT-OP .VW>)>
1762                            -1
1763                            <VW-ID .VW>
1764                            <VW-OX .VW>
1765                            <VW-OY .VW>
1766                            <FONT-ID <VW-CFONT .VW>>
1767                            1 0
1768                            .LEN
1769                            0 0
1770                            .CHR>
1771                      <VW-OX .VW <VW-X .VW>>
1772                      <VW-OY .VW <VW-Y .VW>>)
1773                     (T
1774                      <COND (<NOT <EMPTY? .OBUF>>
1775                             <SUBSTRUC .CHR 0 .TRANS .OBUF>
1776                             <VW-OCT .VW <+ .OCT .TRANS>>)>
1777                      <CURSOR-OFF .VW>
1778                      <VW-FLUSH-BUFFER .VW <>>
1779                      <SET CURSOR-IS-OFF T>
1780                      <SET OCT 0>
1781                      <SET OBUF <VW-TOBUF .VW>:STRING>
1782                      <SET CHR <REST .CHR .TRANS>>
1783                      <SET LEN <- .LEN .TRANS>>
1784                      <AGAIN>)>)
1785              (T
1786               <SUBSTRUC .CHR 0 .LEN .OBUF>
1787               <VW-OCT .VW <+ .OCT .LEN>>
1788               <VW-OBUF .VW <REST .OBUF .LEN>>)>
1789        <COND (.CURSOR-IS-OFF <CURSOR-ON .VW>)>>)>>
1790
1791 <DEFINE CURSOR-OFF (VW:VSW)
1792         <COND (<VW-CURSOR .VW> <SHOW-CURSOR .VW> <VW-CURSOR .VW <>>)>>
1793
1794 <DEFINE CURSOR-ON (VW:VSW)
1795         <COND (<NOT <VW-CURSOR .VW>> <SHOW-CURSOR .VW> <VW-CURSOR .VW T>)>>
1796
1797 <DEFINE SHOW-CURSOR (VW:VSW "AUX" F:FONT (CD <VW-CURS-DESC .VW>))
1798         <COND (<TYPE? .CD ATOM>
1799                <SET F <VW-CFONT .VW>>
1800                <VSOP <VW-VS100 .VW>
1801                      X-TILE-FILL
1802                      ,GX-XOR
1803                      -1
1804                      <VW-ID .VW>
1805                      <FONT-HEIGHT .F>
1806                      <FONT-WIDTH .F>
1807                      <VW-OX .VW>
1808                      <VW-OY .VW>
1809                      <VS-WHITE <VW-VS100 .VW>>
1810                      0>)
1811               (<NOT .CD>)
1812               (T
1813                <VSOP <VW-VS100 .VW>
1814                      X-TILE-FILL
1815                      ,GX-XOR
1816                      -1
1817                      <VW-ID .VW>
1818                      <C-HEIGHT .CD>
1819                      <C-WIDTH .CD>
1820                      <+ <VW-OX .VW> <C-LEFT .CD>>
1821                      <+ <VW-OY .VW> <C-TOP .CD>>
1822                      <VS-WHITE <VW-VS100 .VW>>
1823                      <C-RASTER .CD>>)>
1824         T>
1825
1826 <DEFINE VW-FLUSH-BUFFER (VW:VSW
1827                          "OPT" (CURS:<OR ATOM FALSE> T)
1828                          "AUX" (VS:VS <VW-VS100 .VW>) (W:FIX <VW-ID .VW>)
1829                                F:FONT Y)
1830         <COND (<G? <VW-OCT .VW> 0>
1831                <SET F <VW-CFONT .VW>>
1832                <VSOP <VW-VS100 .VW>
1833                      X-TEXT
1834                      <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-INVERT>
1835                             <COND (<==? <VW-TEXT-OP .VW> ,GX-COPY>
1836                                    ,GX-COPY-INVERTED)
1837                                   (<==? <VW-TEXT-OP .VW> ,GX-COPY-INVERTED>
1838                                    ,GX-COPY)
1839                                   (T ,GX-EQUIV)>)
1840                            (T <VW-TEXT-OP .VW>)>
1841                      -1
1842                      <VW-ID .VW>
1843                      <VW-OX .VW>
1844                      <VW-OY .VW>
1845                      <FONT-ID <VW-CFONT .VW>>
1846                      1 0
1847                      <VW-OCT .VW>
1848                      0 0
1849                      <VW-TOBUF .VW>:STRING>
1850                <VW-OX .VW <VW-X .VW>>
1851                <VW-OY .VW <VW-Y .VW>>
1852                <VW-OCT .VW 0>
1853                <VW-OBUF .VW <VW-TOBUF .VW>>)>
1854         <COND (<VW-HIGHX .VW>
1855                <COND (<TEST-VW-MODE <VW-OUTMODE .VW> ,VWM-UNDER>
1856                       <VSOP <VW-VS100 .VW> X-LINE ,GX-XOR -1
1857                             <VW-ID .VW>
1858                             <MIN <VW-X .VW> <VW-HIGHX .VW>>
1859                             <SET Y <- <+ <VW-Y .VW> <FONT-HEIGHT <VW-CFONT .VW>>>
1860                                       1>>
1861                             <MAX <VW-X .VW> <VW-HIGHX .VW>>
1862                             .Y 1 1 1>)>
1863                <COND (<VW-HIGHLIGHT .VW>
1864                       <VSOP <VW-VS100 .VW>
1865                             X-TILE-FILL
1866                             ,GX-XOR
1867                             -1
1868                             <VW-ID .VW>
1869                             <FONT-HEIGHT <VW-CFONT .VW>>
1870                             <ABS <- <VW-X .VW> <VW-HIGHX .VW>>>
1871                             <MIN <VW-X .VW> <VW-HIGHX .VW>>
1872                             <VW-Y .VW>
1873                             <VW-HIGHLIGHT .VW>
1874                             0>)>
1875                <VW-HIGHX .VW <VW-X .VW>>)>
1876         <COND (.CURS <CURSOR-ON .VW>)>>
1877
1878 <DEFINE VS-BUFOUT (CHN:VSCHAN OPER
1879                    "OPT" (FORCE? <>)
1880                    "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (CDONE? <>))
1881         <COND (<G? <VW-OCT .VW> 0>
1882                <SET CDONE? T>
1883                <CURSOR-OFF .VW>
1884                <VW-FLUSH-BUFFER .VW T>)>
1885         <COND (.FORCE?
1886                <COND (<NOT .CDONE?>
1887                       <CURSOR-OFF .VW>
1888                       <CURSOR-ON .VW>)>
1889                <VSB-DUMP <VW-VS100 .VW>>)>
1890         T>
1891
1892 <DEFINE VS-BUFTREE (CHN:VSCHAN OPER
1893                     "OPT" (FORCE? <>)
1894                     "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1895         <COND (<G? <VW-OCT .VW> 0> <CURSOR-OFF .VW> <VW-FLUSH-BUFFER .VW T>)>
1896         <MAPF <>
1897               <FUNCTION (KID:VSCHAN) <CHANNEL-OP .KID BUFTREE <>>>
1898               <VW-KIDS .VW>>
1899         <COND (.FORCE? <VSB-DUMP <VW-VS100 .VW>>)>
1900         T>
1901
1902 <DEFINE VS-DOWN-CURSOR (CHN:VSCHAN OPER
1903                         "OPT" (CT:FIX 1)
1904                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>)
1905                               (CH <FONT-HEIGHT <VW-CFONT .VW>>))
1906         <SET Y <+ .Y <* .CT .CH>>>
1907         <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y T>>
1908
1909 <DEFINE VS-UP-CURSOR (CHN:VSCHAN OPER
1910                       "OPT" (CT:FIX 1)
1911                       "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (Y <VW-Y .VW>))
1912         <SET Y <- .Y <* .CT <FONT-HEIGHT <VW-CFONT .VW>>>>>
1913         <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y T>>
1914
1915 <DEFINE VS-HOME-CURSOR (CHN:VSCHAN OPER)
1916         <CHANNEL-OP .CHN MOVE-CURSOR-ABS 0 0 <> <>>>
1917
1918 <DEFINE VS-BOTTOM-CURSOR (CHN:VSCHAN OPER
1919                           "AUX" (VW:VSW <CHANNEL-DATA .CHN>) H CH)
1920         <CHANNEL-OP .CHN
1921                     MOVE-CURSOR-ABS
1922                     0
1923                     <* <- </ <SET H <VW-HEIGHT .VW>>
1924                              <SET CH <FONT-HEIGHT <VW-CFONT .VW>>>>
1925                           1>
1926                        .CH>
1927                     <>
1928                     <>>>
1929
1930 <DEFINE VS-HOR-POS (CHN:VSCHAN OPER
1931                     "OPT" X:FIX
1932                     "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1933         <COND (<ASSIGNED? X>
1934                <CHANNEL-OP .CHN
1935                            MOVE-CURSOR-ABS
1936                            <* .X <FONT-WIDTH <VW-CFONT .VW>>>
1937                            <VW-Y .VW>
1938                            <>
1939                            <>>
1940                .X)
1941               (T </ <VW-X .VW> <FONT-WIDTH <VW-CFONT .VW>>>)>>
1942
1943 <DEFINE VS-VER-POS (CHN:VSCHAN OPER
1944                     "OPT" Y:<OR FIX FLOAT>
1945                     "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1946         <COND (<ASSIGNED? Y>
1947                <CHANNEL-OP .CHN
1948                            MOVE-CURSOR-ABS
1949                            <VW-X .VW>
1950                            <* .Y <FONT-HEIGHT <VW-CFONT .VW>>>
1951                            <>
1952                            <>>
1953                .Y)
1954               (T </ <VW-Y .VW> <FONT-HEIGHT <VW-CFONT .VW>>>)>>
1955
1956 <DEFINE VS-HOR-POS-ABS (CHN:VSCHAN OPER
1957                         "OPT" X:<OR FIX FLOAT>
1958                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1959         <COND (<ASSIGNED? X>
1960                <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW>>
1961                <VW-X .VW>)
1962               (T <VW-X .VW>)>>
1963
1964 <DEFINE VS-VER-POS-ABS (CHN:VSCHAN OPER
1965                         "OPT" Y:FIX
1966                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
1967         <COND (<ASSIGNED? Y> <CHANNEL-OP .CHN MOVE-CURSOR-ABS <VW-X .VW> .Y>)
1968               (T <VW-Y .VW>)>>
1969
1970 <DEFINE VS-MOVE-CURSOR (CHN:VSCHAN OPER X:FIX Y:FIX
1971                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>) F)
1972         <CHANNEL-OP .CHN
1973                     MOVE-CURSOR-ABS
1974                     <* .X <FONT-WIDTH <SET F <VW-CFONT .VW>>>>
1975                     <* .Y <FONT-HEIGHT .F>>
1976                     T>>
1977
1978 <DEFINE VS-MOVE-CURSOR-ABS (CHN:VSCHAN OPER NX:<OR FIX FLOAT> NY:<OR FIX FLOAT>
1979                             "OPT" (CHAR?:<OR ATOM FALSE> <>)
1980                                   (SCALE?:<OR ATOM FALSE> <NOT .CHAR?>)
1981                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>) BOT RIGHT
1982                                   (CH <FONT-HEIGHT <VW-CFONT .VW>>)
1983                                   (CW <FONT-WIDTH <VW-CFONT .VW>>) (RCH .CH)
1984                                   (RCW .CW) (PP <STACK <VECTOR .NX .NY>>) X:FIX
1985                                   Y:FIX)
1986         <COND (.SCALE? <SCALE-POINT .PP .VW> <SET X <1 .PP>> <SET Y <2 .PP>>)
1987               (T
1988                <COND (<TYPE? .NX FLOAT> <SET X <FIX <+ .NX 0.5>>>)
1989                      (T <SET X .NX>)>
1990                <COND (<TYPE? .NY FLOAT> <SET Y <FIX <+ .NY 0.5>>>)
1991                      (T <SET Y .NY>)>)>
1992         <COND (<OR <N==? .X <VW-X .VW>> <N==? .Y <VW-Y .VW>>>
1993                <CURSOR-OFF .VW>
1994                <PROG (YC)
1995                      <SET YC <>>
1996                      <COND (.CHAR?
1997                             <SET BOT </ <VW-HEIGHT .VW> .CH>>
1998                             <SET RIGHT </ <VW-WIDTH .VW> .CW>>
1999                             <SET Y </ .Y .CH>>
2000                             <SET X </ .X .CW>>)
2001                            (T
2002                             <SET BOT <VW-HEIGHT .VW>>
2003                             <SET RIGHT <VW-WIDTH .VW>>
2004                             <SET CH 1>
2005                             <SET CW 1>)>
2006                      <COND (<L? .Y 0>
2007                             <REPEAT ()
2008                                     <SET Y <+ .Y .BOT>>
2009                                     <COND (<G? .Y 0> <RETURN>)>>)>
2010                      <COND (<G=? .Y .BOT> <SET Y <MOD .Y .BOT>>)>
2011                      <COND (.CHAR? <SET Y <* .Y .CH>>)>
2012                      <COND (<L? .X 0>
2013                             <REPEAT ()
2014                                     <SET X <+ .X .RIGHT>>
2015                                     <SET Y <+ .Y .CH>>
2016                                     <SET YC T>
2017                                     <COND (<G? .X 0> <RETURN>)>>)>
2018                      <COND (<G=? .X .RIGHT>
2019                             <SET Y <+ .Y <* .CH </ .X .RIGHT>>>>
2020                             <SET YC T>
2021                             <SET X <MOD .X .RIGHT>>)>
2022                      <COND (.CHAR? <SET X <* .X .CW>>)>
2023                      <COND (.YC <AGAIN>)>>
2024                <COND (<G? <VW-OCT .VW> 0> <VW-FLUSH-BUFFER .VW <>>)>
2025                <VW-X .VW .X>
2026                <VW-OX .VW .X>
2027                <VW-Y .VW .Y>
2028                <VW-OY .VW .Y>
2029                <CURSOR-ON .VW>)>
2030         <UPDATE-MC .CHN </ .X .RCW> </ .Y .RCH>>
2031         .CHN>
2032
2033 <DEFINE VS-FORWARD-CURSOR (CHN:VSCHAN OPER
2034                            "OPT" (CT:FIX 1)
2035                            "AUX" (VW:VSW <CHANNEL-DATA .CHN>) X)
2036         <SET X <+ <VW-X .VW> <* .CT <FONT-WIDTH <VW-CFONT .VW>>>>>
2037         <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW> T>>
2038
2039 <DEFINE VS-BACK-CURSOR (CHN:VSCHAN OPER
2040                         "OPT" (CT:FIX 1)
2041                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>) X)
2042         <SET X <- <VW-X .VW> <* .CT <FONT-WIDTH <VW-CFONT .VW>>>>>
2043         <CHANNEL-OP .CHN MOVE-CURSOR-ABS .X <VW-Y .VW> T>>
2044
2045 <DEFINE DESTROY-CURSOR (CD:<OR CURSOR ATOM> VS:VS)
2046         <COND (<TYPE? .CD ATOM>)
2047               (T
2048                <C-REF .CD <- <C-REF .CD> 1>>
2049                <COND (<L=? <C-REF .CD> 0>
2050                       <VSOP .VS X-FREE-CURSOR 0 <C-CURSOR .CD>>
2051                       <COND (<NOT <0? <C-MASK .CD>>>
2052                              <VSOP .VS X-FREE-BITMAP 0 <C-MASK .CD>>)>
2053                       <VSOP .VS X-FREE-BITMAP 0 <C-RASTER .CD>>)>)>
2054         T>
2055
2056 <DEFINE VS-MOUSE-CURSOR (CHN:VSCHAN OPER
2057                          "OPT" PATTERN:<OR STRING BYTES FALSE CURSOR ATOM>
2058                                WIDTH:FIX HEIGHT:FIX (TOP:FIX 0) (LEFT:FIX 0)
2059                                (MASK:<OR FALSE STRING BYTES> <>)
2060                                (DISPLAY:FIX ,GX-XOR)
2061                                (PRESERVE?:<OR ATOM FALSE> T)
2062                          "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2063                                (VS:VS <VW-VS100 .VW>) (OLD <VW-MOUSE-DESC .VW>)
2064                                R CURSOR)
2065         <COND (<AND <ASSIGNED? PATTERN> <N=? .PATTERN .OLD>>
2066                <VW-FLUSH-BUFFER .VW>
2067                <COND (<TYPE? .PATTERN CURSOR>
2068                       <COND (<G? <C-REF .PATTERN> 0>
2069                              <C-REF .PATTERN <+ <C-REF .PATTERN> 1>>
2070                              <VW-MOUSE-DESC .VW .PATTERN>)
2071                             (T
2072                              <ERROR DEAD-CURSOR!-ERRORS
2073                                     .PATTERN
2074                                     MOUSE-CURSOR>)>)
2075                      (<OR <NOT .PATTERN> <TYPE? .PATTERN ATOM>>
2076                       <COND (<TYPE? .OLD CURSOR> <DESTROY-CURSOR .OLD .VS>)>
2077                       <VW-MOUSE-DESC .VW .PATTERN>)
2078                      (<SET PATTERN
2079                            <MAKE-PATTERN .VS
2080                                          .PATTERN
2081                                          .WIDTH
2082                                          .HEIGHT
2083                                          .TOP
2084                                          .LEFT
2085                                          .MASK
2086                                          .DISPLAY>>
2087                       <COND (<AND <TYPE? .OLD CURSOR> <NOT .PRESERVE?>>
2088                              <DESTROY-CURSOR .OLD .VS>)>
2089                       <VW-MOUSE-DESC .VW .PATTERN>)>
2090                <COND (<NOT <VW-MOUSE-DESC .VW>>
2091                       <VSOP .VS X-DEFINE-CURSOR <VW-ID .VW> 0>)
2092                      (<TYPE? <VW-MOUSE-DESC .VW> ATOM>
2093                       <VSOP .VS
2094                             X-DEFINE-CURSOR <VW-ID .VW> 0>)
2095                      (T
2096                       <VSOP .VS
2097                             X-DEFINE-CURSOR
2098                             <VW-ID .VW>
2099                             <C-CURSOR <SET CURSOR <VW-MOUSE-DESC .VW>>>>)>)>
2100         .OLD>
2101
2102 <DEFINE MAKE-PATTERN
2103         (VS:VS PATTERN:<OR STRING BYTES> WIDTH:FIX HEIGHT:FIX TOP:FIX LEFT:FIX
2104          "OPT" (MASK:<OR STRING BYTES FALSE> <>) (DISPLAY:FIX ,GX-XOR)
2105          "AUX" R (NR 0) CURSOR)
2106         <COND (<N==? <LENGTH .PATTERN> <* 2 .HEIGHT </ <+ .WIDTH 15> 16>>>
2107                <ERROR CURSOR-PATTERN-WRONG-LENGTH!-ERRORS
2108                       .PATTERN
2109                       .WIDTH
2110                       .HEIGHT
2111                       MAKE-PATTERN>)
2112               (<AND .MASK <N==? <LENGTH .PATTERN> <LENGTH .MASK>>>
2113                <ERROR MASK-IS-WRONG-LENGTH!-ERRORS
2114                       .MASK
2115                       .PATTERN
2116                       MAKE-PATTERN>)
2117               (<SET R <VSOP .VS X-STORE-BITMAP 0 .HEIGHT .WIDTH .PATTERN>>
2118                <COND (<OR <NOT .MASK>
2119                           <SET NR
2120                                <VSOP .VS
2121                                      X-STORE-BITMAP
2122                                      0
2123                                      .HEIGHT
2124                                      .WIDTH
2125                                      .MASK>>>
2126                       <COND
2127                        (<SET CURSOR <VSOP .VS X-STORE-CURSOR
2128                                           .DISPLAY 0 .R 1 0 .NR .TOP .LEFT>>
2129                         <CHTYPE [.R .NR .HEIGHT .WIDTH .TOP .LEFT 1 .DISPLAY
2130                                  .CURSOR]
2131                                 CURSOR>)
2132                        (T
2133                         <VSOP .VS X-FREE-BITMAP 0 .R>
2134                         <COND (.MASK
2135                                <VSOP .VS X-FREE-BITMAP 0 .NR>)>
2136                         .CURSOR)>)
2137                      (T <VSOP .VS X-FREE-BITMAP 0 .R> .NR)>)>>
2138
2139 <DEFINE VS-TEXT-CURSOR (CHN:VSCHAN OPER
2140                         "OPT" PATTERN:<OR STRING BYTES FALSE CURSOR ATOM>
2141                               WIDTH:FIX HEIGHT:FIX (TOP:FIX 0) (LEFT:FIX 0)
2142                               (PRESERVE?:<OR ATOM FALSE> T)
2143                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2144                               (VS:VS <VW-VS100 .VW>) (OLD <VW-CURS-DESC .VW>)
2145                               R)
2146         <COND (<ASSIGNED? PATTERN>
2147                <VW-FLUSH-BUFFER .VW>
2148                <CURSOR-OFF .VW>
2149                <COND (<TYPE? .PATTERN CURSOR>
2150                       <COND (<L=? <C-REF .PATTERN> 0>
2151                              <ERROR DEAD-CURSOR!-ERRORS .PATTERN TEXT-CURSOR>)
2152                             (T
2153                              <C-REF .PATTERN <+ <C-REF .PATTERN> 1>>
2154                              <VW-CURS-DESC .VW .PATTERN>)>)
2155                      (<OR <NOT .PATTERN> <TYPE? .PATTERN ATOM>>
2156                       <COND (<AND .OLD
2157                                   <NOT <TYPE? .OLD ATOM>>
2158                                   <NOT .PRESERVE?>>
2159                              <DESTROY-CURSOR .OLD .VS>)>
2160                       <VW-CURS-DESC .VW .PATTERN>)
2161                      (T
2162                       <COND (<SET PATTERN
2163                                   <MAKE-PATTERN .VS
2164                                                 .PATTERN
2165                                                 .WIDTH
2166                                                 .HEIGHT
2167                                                 .TOP
2168                                                 .LEFT>>
2169                              <COND (.OLD <DESTROY-CURSOR .OLD .VS>)>
2170                              <VW-CURS-DESC .VW .PATTERN>)>)>
2171                <CURSOR-ON .VW>)>
2172         .OLD>
2173
2174 <DEFINE VS-DISPLAY-CURSOR (CHN:VSCHAN OPER PAT:<OR CURSOR ATOM FALSE>
2175                            "OPT" (X:<OR FIX FLOAT FALSE> <>)
2176                                  (Y:<OR FIX FLOAT FALSE> <>)
2177                            "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2178                                  (PP <STACK <VECTOR .X .Y>>) F)
2179         <VW-FLUSH-BUFFER .VW>
2180         <GET-COORDS .VW .PP>
2181         <COND (<==? .PAT TEXT-CURSOR> <SET PAT <VW-CURS-DESC .VW>>)
2182               (<TYPE? .PAT ATOM> <SET PAT <VW-MOUSE-DESC .VW>>)>
2183         <COND (<NOT .PAT>)
2184               (<NOT <TYPE? .PAT CURSOR>>
2185                <VSOP <VW-VS100 .VW>
2186                      X-TILE-FILL
2187                      ,GX-XOR
2188                      -1
2189                      <VW-ID .VW>
2190                      <FONT-HEIGHT <SET F <VW-CFONT .VW>>>
2191                      <FONT-WIDTH .F>
2192                      <1 .PP>
2193                      <2 .PP>
2194                      <VS-WHITE <VW-VS100 .VW>>
2195                      0>)
2196               (T
2197                <VSOP <VW-VS100 .VW>
2198                      X-TILE-FILL
2199                      ,GX-XOR
2200                      -1
2201                      <VW-ID .VW>
2202                      <C-HEIGHT .PAT>
2203                      <C-WIDTH .PAT>
2204                      <+ <1 .PP>:FIX <C-LEFT .PAT>>
2205                      <+ <2 .PP>:FIX <C-TOP .PAT>>
2206                      <VS-WHITE <VW-VS100 .VW>>
2207                      <C-RASTER .PAT>>)>>
2208
2209 <DEFINE VS-FRESH-LINE (CHN:VSCHAN OPER
2210                        "OPT" (N:FIX 1)
2211                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2212                              (H <FONT-HEIGHT <VW-CFONT .VW>>))
2213         <COND (<NOT <0? <VW-X .VW>>>
2214                <CHANNEL-OP .CHN MOVE-CURSOR-ABS 0 <+ <VW-Y .VW> .H> <> T>
2215                <CHANNEL-OP .CHN CLEAR-EOL>
2216                <SET N <- .N 1>>)>
2217         <COND (<G? .N 0>
2218                <REPEAT ()
2219                        <CHANNEL-OP .CHN
2220                                    MOVE-CURSOR-ABS
2221                                    0
2222                                    <+ <VW-Y .VW> .H>
2223                                    <>
2224                                    T>
2225                        <COND (<L=? <SET N <- .N 1>> 0> <RETURN>)>>)>
2226         .CHN>
2227
2228 <DEFINE VS-BIT-BLT
2229         (CHN:VSCHAN OPER HEIGHT:FIX WIDTH:FIX SLEFT:FIX STOP:FIX DLEFT:FIX
2230          DTOP:FIX
2231          "OPT" (FCN:FIX ,GX-COPY) (DOCURS?:<OR ATOM FALSE> T)
2232          "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>))
2233         <COND (.DOCURS? <CURSOR-OFF .VW>)>
2234         <VW-FLUSH-BUFFER .VW <>>
2235         <VSOP .VS
2236               X-COPY-AREA
2237               .FCN
2238               -1
2239               <VW-ID .VW>
2240               .HEIGHT
2241               .WIDTH
2242               .SLEFT
2243               .STOP
2244               .DLEFT
2245               .DTOP>
2246         <COND (.DOCURS? <CURSOR-ON .VW>)>
2247         .CHN>
2248
2249 <DEFINE VS-INSERT-LINE (CHN:VSCHAN OPER
2250                         "OPT" (N:FIX 1) (TOP:<OR FALSE FIX> <>)
2251                               (BOT:<OR FALSE FIX> <>)
2252                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2253                               (FONT <VW-CFONT .VW>) (H:FIX <FONT-HEIGHT .FONT>)
2254                               TEMP (RBOT <- <VW-HEIGHT .VW> 1>))
2255         <COND (<NOT .TOP> <SET TOP <VW-Y .VW>>) (T <SET TOP <* .TOP .H>>)>
2256         <COND (<NOT .BOT> <SET BOT .RBOT>) (T <SET BOT <* .BOT .H>>)>
2257         <COND (<G? .TOP .BOT> <SET TEMP .BOT> <SET BOT .TOP> <SET TOP .TEMP>)>
2258         <COND (<AND <L=? .TOP .RBOT> <NOT <0? .N>>>
2259                <SET BOT <MIN .BOT .RBOT>>
2260                <CURSOR-OFF .VW>
2261                <CHANNEL-OP .CHN
2262                            BIT-BLT
2263                            <- .BOT .TOP <* <ABS .N> .H>>
2264                            <VW-WIDTH .VW>
2265                            0
2266                            <COND (<G? .N 0> .TOP) (T <+ .TOP <* <- .N> .H>>)>
2267                            0
2268                            <COND (<G? .N 0> <+ .TOP <* .N .H>>) (T .TOP)>
2269                            ,GX-COPY
2270                            <>>
2271                <VSOP <VW-VS100 .VW>
2272                      X-TILE-FILL
2273                      ,GX-COPY
2274                      -1
2275                      <VW-ID .VW>
2276                      <* <ABS .N> .H>
2277                      <VW-WIDTH .VW>
2278                      0
2279                      <COND (<G? .N 0> .TOP) (T <+ .BOT <* .N .H>>)>
2280                      <VW-BG .VW>
2281                      0>
2282                <CURSOR-ON .VW>
2283                .CHN)>>
2284
2285 <DEFINE VS-INSERT-CHAR (CHN:VSCHAN OPER
2286                         "OPT" (N:FIX 1) (LEFT:<OR FALSE FIX> <>)
2287                               (RIGHT:<OR FALSE FIX> <>)
2288                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2289                               (FONT <VW-CFONT .VW>) (W:FIX <FONT-WIDTH .FONT>)
2290                               TEMP (RRIGHT <- <VW-WIDTH .VW> 1>))
2291         <COND (<NOT .LEFT> <SET LEFT <VW-X .VW>>) (T <SET LEFT <* .LEFT .W>>)>
2292         <COND (<NOT .RIGHT> <SET RIGHT .RRIGHT>) (T <SET RIGHT <* .RIGHT .W>>)>
2293         <COND (<G? .LEFT .RIGHT>
2294                <SET TEMP .LEFT>
2295                <SET LEFT .RIGHT>
2296                <SET RIGHT .TEMP>)>
2297         <COND (<AND <L=? .LEFT .RRIGHT> <NOT <0? .N>>>
2298                <CURSOR-OFF .VW>
2299                <CHANNEL-OP .CHN
2300                            BIT-BLT
2301                            <FONT-HEIGHT .FONT>
2302                            <- .RIGHT .LEFT <* <ABS .N> .W>>
2303                            <COND (<G? .N 0> .LEFT) (T <+ .LEFT <* <- .N> .W>>)>
2304                            <VW-Y .VW>
2305                            <COND (<G? .N 0> <+ .LEFT <* .N .W>>) (T .LEFT)>
2306                            <VW-Y .VW>
2307                            ,GX-COPY
2308                            <>>
2309                <VSOP <VW-VS100 .VW>
2310                      X-TILE-FILL
2311                      ,GX-COPY
2312                      -1
2313                      <VW-ID .VW>
2314                      <FONT-HEIGHT .FONT>
2315                      <* <ABS .N> .W>
2316                      <COND (<G? .N 0> .LEFT) (T <+ .RIGHT <* .N .W>>)>
2317                      <VW-Y .VW>
2318                      <VW-BG .VW>
2319                      0>
2320                <CURSOR-ON .VW>
2321                .CHN)>>
2322
2323 <DEFINE VS-ERASE-CHAR (CHN:VSCHAN OPER
2324                        "OPTIONAL" (N:FIX 1)
2325                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (X <VW-X .VW>)
2326                              (FONT <VW-CFONT .VW>) (W <FONT-WIDTH .FONT>)
2327                              (H <FONT-HEIGHT .FONT>) (VS:VS <VW-VS100 .VW>))
2328    <COND
2329     (<G? .N 0>
2330      <VW-FLUSH-BUFFER .VW>
2331      <REPEAT (NX (NY <VW-Y .VW>) (DIST <* .N .W>))
2332              <COND
2333               (<G=? .X .W>
2334                <COND (<G? .DIST .X> <SET NX 0> <SET DIST <- .DIST .X>>)
2335                      (T <SET NX <- .X .DIST>> <SET DIST 0>)>
2336                <VSOP .VS
2337                      X-TILE-FILL
2338                      ,GX-COPY
2339                      -1
2340                      <VW-ID .VW>
2341                      .H
2342                      <- .X .NX>
2343                      .NX
2344                      .NY
2345                      <VW-BG .VW>
2346                      0>
2347                <COND (<G? .DIST 0>
2348                       <COND (<L? <SET NY <- .NY .H>> 0>
2349                              <SET NY <- <* </ <VW-HEIGHT .VW> .H> .H> .H>>)>
2350                       <SET X <- <VW-WIDTH .VW> .W>>)
2351                      (T
2352                       <CHANNEL-OP .CHN MOVE-CURSOR-ABS .NX .NY <> <>>
2353                       <RETURN>)>)>>)>>
2354
2355 <DEFINE VS-KILL-CHAR (CHN:VSCHAN OPER
2356                       "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2357                             (FONT <VW-CFONT .VW>))
2358         <CHANNEL-OP .CHN BACK-CURSOR>
2359         <CURSOR-OFF .VW>
2360         <VSOP <VW-VS100 .VW>
2361               X-TILE-FILL
2362               ,GX-COPY
2363               -1
2364               <VW-ID .VW>
2365               <FONT-HEIGHT .FONT>
2366               <FONT-WIDTH .FONT>
2367               <VW-X .VW>
2368               <VW-Y .VW>
2369               <VW-BG .VW>
2370               0>
2371         <CHANNEL-OP .CHN FORWARD-CURSOR>>
2372
2373 \f
2374
2375 <DEFINE ICON? (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
2376    <VW-REAL .VW>>
2377
2378 <DEFINE ICONIFIED? (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
2379    <VW-ICON .VW>>
2380
2381 <DEFINE INVERT-ICON (CHN:<OR VSCHAN FALSE> OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2382                      (VS:VS <VW-VS100 .VW>))
2383    <COND (<NOT <VW-REAL .VW>>
2384           <SET CHN <VW-ICON .VW>>)>
2385    <COND (.CHN
2386           <SET VW <CHANNEL-DATA .CHN>>
2387           <CHANNEL-OP .CHN
2388                       CHANGE-COLOR
2389                       <COND (<==? <VW-BG .VW> <VS-BLACK .VS>>
2390                              <VS-WHITE .VS>)
2391                             (T
2392                              <VS-BLACK .VS>)>
2393                       <COND (<==? <VW-BORDER .VW> <VS-BLACK .VS>>
2394                              <VS-WHITE .VS>)
2395                             (T
2396                              <VS-WHITE .VS>)>>
2397           <CHANNEL-OP .CHN REDISPLAY-ICON>
2398           T)>>
2399
2400 <DEFINE ICONIFY (CHN:VSCHAN OPER X:FIX Y:FIX
2401                  "OPT" (IN?:<OR VSCHAN FALSE> <>)
2402                  "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2403                  (VS:VS <VW-VS100 .VW>) FONT NCH NAME:STRING
2404                  WID:FIX HIGH:FIX)
2405    <COND (<VW-REAL .VW> #FALSE ("CAN'T ICONIFY AN ICON"))
2406          (<VW-ICON .VW>)
2407          (<SET FONT <GET-FONT ,INITIAL-FONT .VS>>
2408           <SET NAME <CHANNEL-NAME .CHN>>
2409           <SET HIGH <+ 8 <FONT-HEIGHT .FONT>>>
2410           <SET WID <+ 8 <* <FONT-WIDTH .FONT> <LENGTH .NAME>>>>
2411           <COND (<SET NCH <CHANNEL-OPEN VS100 <STRING "ICON-" .NAME>
2412                                         <OR .IN? .VS>
2413                                         .HIGH .WID .X .Y
2414                                         1 BLACK WHITE
2415                                         ,INITIAL-FONT
2416                                         <>>>
2417                  <VW-ICON .VW .NCH>
2418                  <CHANNEL-OP .NCH MOUSE-CURSOR !,CROSS-CURSOR
2419                              ,GX-COPY-INVERTED <>>
2420                  <CHANNEL-OP .NCH TEXT-CURSOR <>>
2421                  <SET VW <CHANNEL-DATA .NCH>>
2422                  <VW-REAL .VW .CHN>
2423                  <CHANNEL-OP .CHN UNMAP>
2424                  <CHANNEL-OP .NCH REDISPLAY-ICON>
2425                  .NCH)>)>>
2426
2427 <DEFINE REDISPLAY-ICON (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2428                         REAL:<OR VSCHAN FALSE> (VS:VS <VW-VS100 .VW>)
2429                         NAME:STRING)
2430    <COND (<NOT <SET REAL <VW-REAL .VW>>>
2431           <COND (<SET REAL <VW-ICON .VW>>
2432                  <SET REAL .CHN>
2433                  <SET CHN <VW-ICON .VW>>
2434                  <SET VW <CHANNEL-DATA .CHN>>)>)>
2435    <COND (.REAL
2436           <VSOP .VS X-CLEAR <VW-ID .VW>>
2437           <VSOP .VS X-TILE-FILL ,GX-COPY -1 <VW-ID .VW>
2438                 <VW-HEIGHT .VW> <VW-WIDTH .VW> 0 0 <VS-GRAY .VS> 0>
2439           <VSOP .VS X-TEXT <COND (<==? <VW-BG .VW> <VS-WHITE .VS>>
2440                                   ,GX-COPY-INVERTED)
2441                                  (T
2442                                   ,GX-COPY)>
2443                 -1
2444                 <VW-ID .VW> 4 4
2445                 <FONT-ID <VW-CFONT .VW>>
2446                 1 0
2447                 <LENGTH <SET NAME <CHANNEL-NAME .REAL>>>
2448                 0 0
2449                 .NAME>
2450           <VSB-DUMP .VS>)>>
2451
2452 <DEFINE DE-ICONIFY (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2453                     REAL)
2454    <COND (<SET REAL <VW-REAL .VW>>
2455           ; "We were given the icon"
2456           <VW-REAL .VW <>>
2457           ; "Break the link, so close won't kill the real thing"
2458           <CLOSE .CHN>
2459           <CHANNEL-OP .REAL MAP>
2460           <VW-ICON <CHANNEL-DATA .REAL>:VSW <>>
2461           .REAL)
2462          (<SET REAL <VW-ICON .VW>>
2463           ; "Well, there is an icon"
2464           <CHANNEL-OP .REAL DE-ICONIFY>)>>
2465
2466 <DEFINE MOUSE-LOWER-WINDOW (CHN:VSCHAN OPER EVENT:MOUSE-EVENT "OPT" (SLOP:FIX 20)
2467                             (ICON-PARENT:<OR VSCHAN FALSE> <>)
2468                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
2469                             (VS:VS <VW-VS100 .VW>)
2470                             OLD-X:FIX OLD-Y:FIX
2471                             (OLD-EVENT <ME-KIND .EVENT>) OLD
2472                             EXEVENT VAL P (UV <STACK <IUVECTOR 2>>))
2473    <COND
2474     (<VW-REAL .VW>
2475      <CHANNEL-OP .CHN LOWER-WINDOW>)
2476     (T
2477      <CHANNEL-OP .CHN INTERPRET-LOCATOR <ME-LOCATOR .EVENT> .UV>
2478      ; "Get coordinates relative to this window"
2479      <SET OLD-X <1 .UV>>
2480      <SET OLD-Y <2 .UV>>
2481      <COND (<==? .OLD-EVENT ,ME-LEFT-PRESSED> <SET EXEVENT ,ME-LEFT-RELEASED>)
2482            (<==? .OLD-EVENT ,ME-MIDDLE-PRESSED> <SET EXEVENT ,ME-MIDDLE-RELEASED>)
2483            (<==? .OLD-EVENT ,ME-RIGHT-PRESSED> <SET EXEVENT ,ME-RIGHT-RELEASED>)
2484            (T <SET EXEVENT ,ME-LEFT-RELEASED>)>
2485      <SET OLD <CHANNEL-OP .CHN MOUSE-MOVE? T>>
2486      <SET SLOP <* .SLOP .SLOP>>
2487      <SET VAL
2488       <GRAB-MOUSE-AND-DO
2489        <BIND (VAL)
2490         <REPEAT (EV (ICON? <>) KIND TFIX:FIX NEW-CURS)
2491           <COND
2492            (<SET EV <CHANNEL-OP .CHN READ-BYTE-IMMEDIATE>>
2493             <COND
2494              (<TYPE? .EV MOUSE-EVENT>
2495               <COND (<==? <SET KIND <ME-KIND .EV>> .EXEVENT>
2496                      <COND (.ICON?
2497                             <DESTROY-CURSOR .NEW-CURS .VS>
2498                             <SET P <VSOP .VS X-INTERPRET-LOCATOR
2499                                          <VW-ID
2500                                           <CHANNEL-DATA
2501                                            <OR .ICON-PARENT
2502                                                <VS-TOPCHAN .VS>>:VSCHAN>:VSW>
2503                                          <ME-LOCATOR .EV>>>
2504                             <SET VAL
2505                                  <CHANNEL-OP .CHN ICONIFY <I-SPAR2 .P:UVECTOR>
2506                                              <I-SPAR3 .P:UVECTOR> .ICON-PARENT>>)
2507                            (T
2508                             <CHANNEL-OP .CHN LOWER-WINDOW>
2509                             <SET VAL .CHN>)>
2510                      <RECYCLE-EVENTS .EV>
2511                      <RETURN .VAL>)
2512                     (<NOT <0? <ANDB .KIND ,ME-PRESSED-MASK>>>
2513                      <RETURN <>>)
2514                     (<==? .KIND ,MOUSE-MOVED>
2515                      <COND (<AND <NOT .ICON?>
2516                                  <G? <+ <* <SET TFIX <- <ME-X .EV> .OLD-X>> .TFIX>
2517                                         <* <SET TFIX <- <ME-Y .EV> .OLD-Y>> .TFIX>>
2518                                      .SLOP>>
2519                             <SET ICON? T>
2520                             <SET NEW-CURS
2521                                  <MAKE-PATTERN .VS !,ICONIFY-CURSOR ,GX-COPY>>
2522                             <VSOP .VS X-UNGRAB-MOUSE 0>
2523                             <VSOP .VS X-GRAB-MOUSE
2524                                   <VW-ID .VW> <C-CURSOR .NEW-CURS>
2525                                   <VW-INPUTS .VW>>)>)>)>
2526             <RECYCLE-EVENTS .EV>)
2527            (T
2528             <RETURN .EV>)>>
2529         <CHANNEL-OP .CHN MOUSE-MOVE? .OLD>>
2530        .CHN
2531        !,CROSS-CURSOR>>
2532      .VAL)>>
2533
2534 <DEFMAC GRAB-MOUSE-AND-DO ('GM-THING 'GM-W GM-PATTERN GM-WIDTH GM-HEIGHT
2535                            "OPT" (GM-TOP 0) (GM-LEFT 0) (GM-MASK <>)
2536                            (GM-DISPLAY ,GX-COPY-INVERTED))
2537    <FORM BIND (('GM-VW:VSW <FORM CHANNEL-DATA .GM-W>)
2538                'GM-CURS:CURSOR GM-VAL GM-OCM ('GM-VS:VS <FORM VW-VS100 '.GM-VW>)
2539                (GM-ID <FORM VW-ID '.GM-VW>))
2540       <FORM UNWIND
2541        <FORM BIND (P ('MOUSE-GRABBED?:<SPECIAL ATOM> T))
2542          <FORM COND (<FORM NOT
2543                            <FORM SET GM-CURS <FORM MAKE-PATTERN '.GM-VS
2544                                                    .GM-PATTERN .GM-WIDTH
2545                                                    .GM-HEIGHT .GM-TOP .GM-LEFT
2546                                                    .GM-MASK .GM-DISPLAY>>>
2547                      <FORM ERROR CANT-MAKE-CURSOR!-ERRORS '.GM-CURS GRAB-MOUSE>)>
2548          <FORM
2549           COND
2550           (<FORM SET P <FORM VSOP '.GM-VS X-QUERY-WINDOW '.GM-ID>>
2551            <FORM SET GM-OCM 0 ;<FORM I-SPAR6 '.P>>
2552            <FORM VSOP '.GM-VS X-CLIPMODE 1 '.GM-ID>
2553            <FORM
2554             COND
2555             (<FORM VSOP '.GM-VS
2556                    X-GRAB-MOUSE '.GM-ID
2557                    <FORM C-CURSOR '.GM-CURS>
2558                    <FORM VW-INPUTS '.GM-VW>>
2559              <FORM SET GM-VAL .GM-THING>
2560              <FORM VSOP '.GM-VS X-CLIPMODE '.GM-OCM '.GM-ID>
2561              <FORM VSOP '.GM-VS X-UNGRAB-MOUSE 0>
2562              <FORM DESTROY-CURSOR '.GM-CURS '.GM-VS>
2563              '.GM-VAL)>)>>
2564        <FORM COND (<FORM ASSIGNED? GM-CURS>
2565                    <FORM VSOP '.GM-VS X-CLIPMODE '.GM-OCM '.GM-ID>
2566                    <FORM VSOP '.GM-VS X-UNGRAB-MOUSE 0>
2567                    <FORM DESTROY-CURSOR '.GM-CURS '.GM-VS>)>>>>
2568
2569 <DEFINE MOUSE-OPEN-WINDOW MOW
2570         (DESC:<OR FALSE <PRIMTYPE LIST> VSCHAN> OPER NAME:STRING
2571          "OPT" (BWIDTH:<OR FIX FALSE> <>) (BPATTERN:<OR ATOM FIX FALSE> <>)
2572                (BACKGROUND:<OR ATOM FIX FALSE> <>) (FONT:<OR STRING FALSE> <>)
2573                (BUF? T) (DEFAULT-HEIGHT:FIX 24) (DEFAULT-WIDTH:FIX 80)
2574                (MIN-HEIGHT:FIX 2) (MIN-WIDTH:FIX 2)
2575          "AUX" VW:VSW (SPEC? <>) VS:VS OLD PID NVS:<OR FALSE VS>
2576                RFONT:<OR FALSE FONT>
2577                MH:FIX MW:FIX DH:FIX DW:FIX PARENT:VSCHAN P OLD-CURSOR TOP:FIX
2578                LEFT:FIX WIDTH:FIX HEIGHT:FIX MY-FONT:FONT MY-WIND MY-WIDTH
2579                VAL)
2580    <COND (<NOT .BWIDTH> <SET BWIDTH 2>)>
2581    <COND (<NOT <TYPE? .DESC CHANNEL>>
2582           <COND (<SET NVS <GET-VS100 .DESC>> <SET PARENT <VS-TOPCHAN .NVS>>)
2583                 (<RETURN .NVS .MOW>)>)
2584          (T <SET PARENT .DESC>)>
2585    <SET VW <CHANNEL-DATA .PARENT>>
2586    <SET VS <VW-VS100 .VW>>
2587    <SET PID <VW-ID .VW>>
2588    <VW-FLUSH-BUFFER .VW>
2589    <SET MY-FONT <GET-FONT ,INITIAL-FONT .VS>>
2590    <COND (<NOT .FONT>
2591           <COND (<N==? .PARENT .DESC>
2592                  <SET FONT ,INITIAL-FONT>)
2593                 (T
2594                  <SET FONT <FONT-NAME <VW-CFONT .VW>>>)>)>
2595    <COND (<NOT <SET RFONT <GET-FONT .FONT .VS>>>
2596           <RETURN .RFONT .MOW>)>
2597    <SET MH <+ <* .BWIDTH 2> <* .MIN-HEIGHT <SET DH <FONT-HEIGHT .RFONT>>>>>
2598    <SET MW <+ <* .BWIDTH 2> <* .MIN-WIDTH <SET DW <FONT-WIDTH .RFONT>>>>>
2599    <SET OLD <CHANNEL-OP .PARENT MOUSE-MOVE? T>>
2600    <COND (<TYPE? .DESC CHANNEL>
2601           <CHANNEL-OP .PARENT RAISE-WINDOW>)>
2602    <SET MY-WIND
2603         <VSOP .VS
2604               X-CREATE-WINDOW
2605               2
2606               <VW-ID <CHANNEL-DATA <VS-TOPCHAN .VS>:CHANNEL>:VSW>
2607               <FONT-HEIGHT .MY-FONT>
2608               <SET MY-WIDTH <* <FONT-WIDTH .MY-FONT> <+ 10 <LENGTH .NAME>>>>
2609               0
2610               0
2611               <VS-WHITE .VS>
2612               <VS-BLACK .VS>>>
2613    <VSOP .VS X-MAP-WINDOW .MY-WIND>
2614    <SETG DRAW-CHANGED? T>
2615    <SETG DRAW-ODD? -1>
2616    <GRAB-MOUSE-AND-DO
2617     <COND
2618      (<SET P <VSOP .VS X-QUERY-MOUSE .PID>>
2619       <SET TOP <I-SPAR3 .P:UVECTOR>>
2620       <SET LEFT <I-SPAR2 .P:UVECTOR>>
2621       <SET WIDTH .MW>
2622       <SET HEIGHT .MH>
2623       <REPEAT ((DRAW? T) E (LOC? <>) KIND (NEW-SIZE? T)
2624                (TV <STACK <UVECTOR 0 15000>>)
2625                (FH:FIX <CHANNEL-OP <VS-CHANNEL .VS> FILE-HANDLE>)
2626                (RD:FIX <LSH 1 .FH>) (MX:FIX <+ .FH 1>)
2627                (VV <STACK <IUVECTOR 1>>) CT:<OR FIX FALSE>)
2628          <COND (.DRAW? <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>)>
2629          <COND (.NEW-SIZE?
2630                 <UPDATE-SIZE .VS
2631                              .MY-WIND
2632                              .MY-FONT
2633                              .NAME
2634                              .BWIDTH
2635                              .WIDTH
2636                              .HEIGHT
2637                              .DW
2638                              .DH>)>
2639          <CHANNEL-OP .PARENT BUFOUT>
2640          <SET NEW-SIZE? <>>
2641          <SET DRAW? <>>
2642          <COND
2643           (<OR <NOT <SET CT <CALL SYSCALL SELECT .MX <1 .VV .RD> 0 0 .TV>>>
2644                <0? .CT>>
2645            <SET E <>>
2646            <SET DRAW? T>
2647            <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2648            <CHANNEL-OP .PARENT BUFOUT>
2649            <CALL SYSCALL SELECT 0 0 0 0 .TV>)
2650           (<TYPE? <SET E <CHANNEL-OP .PARENT READ-BYTE-IMMEDIATE T>>
2651                   MOUSE-EVENT>
2652            <COND (<==? <SET KIND <ME-KIND .E>> ,ME-MOVED>
2653                   <SET DRAW? T>
2654                   <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2655                   <CHANNEL-OP .PARENT BUFOUT>
2656                   <COND (.LOC?
2657                          <SET NEW-SIZE? T>
2658                          <SETG DRAW-CHANGED? T>
2659                          <SET HEIGHT <- <ME-Y .E> .TOP>>
2660                          <COND (<L? <ABS .HEIGHT> .MH>
2661                                 <COND (<L? .HEIGHT 0> <SET HEIGHT <- .MH>>)
2662                                       (T <SET HEIGHT .MH>)>)>
2663                          <SET WIDTH <- <ME-X .E> .LEFT>>
2664                          <COND (<L? <ABS .WIDTH> .MW>
2665                                 <COND (<L? .WIDTH 0> <SET WIDTH <- .MW>>)
2666                                       (T <SET WIDTH .MW>)>)>)
2667                         (T
2668                          <SETG DRAW-CHANGED? T>
2669                          <SET TOP <ME-Y .E>>
2670                          <SET LEFT <ME-X .E>>)>)
2671                  (.LOC?
2672                   <COND (<==? .KIND ,ME-MIDDLE-RELEASED>
2673                          <RECYCLE-EVENTS .E>
2674                          <RETURN>)>)
2675                  (<==? .KIND ,ME-LEFT-PRESSED>
2676                   <SET SPEC? 1>
2677                   <RECYCLE-EVENTS .E>
2678                   <RETURN>)
2679                  (<==? .KIND ,ME-RIGHT-PRESSED>
2680                   <SET SPEC? 2>
2681                   <RECYCLE-EVENTS .E>
2682                   <RETURN>)
2683                  (<==? .KIND ,ME-MIDDLE-PRESSED>
2684                   <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2685                   <CHANNEL-OP .PARENT MOUSE-MOVE? ,MOUSE-CENTER>
2686                   <SET LOC? T>
2687                   <SET DRAW? T>)>)>
2688          <RECYCLE-EVENTS .E>>
2689       <VSOP .VS X-DESTROY-WINDOW .MY-WIND>
2690       <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2691       <CHANNEL-OP .PARENT MOUSE-MOVE? .OLD>
2692       <COND (.SPEC?
2693              <PROG ((RFONT <GET-FONT .FONT .VS>))
2694                 <SET WIDTH <* .DEFAULT-WIDTH <FONT-WIDTH .RFONT>>>
2695                 <COND (<==? .SPEC? 1>
2696                        <SET HEIGHT <* .DEFAULT-HEIGHT <FONT-HEIGHT .RFONT>>>)
2697                       (T <SET HEIGHT <- <VW-HEIGHT .VW> .TOP <* 2 .BWIDTH>>>)>>)
2698             (T
2699              <COND (<L? .HEIGHT 0>
2700                     <SET TOP <+ .TOP .HEIGHT>>
2701                     <SET HEIGHT <- .HEIGHT>>)>
2702              <COND (<L? .WIDTH 0>
2703                     <SET LEFT <+ .LEFT .WIDTH>>
2704                     <SET WIDTH <- .WIDTH>>)>)>
2705       <SET VAL
2706            <CHANNEL-OPEN VS100
2707                          .NAME
2708                          .DESC
2709                          .HEIGHT
2710                          .WIDTH
2711                          .LEFT
2712                          .TOP
2713                          .BWIDTH
2714                          .BPATTERN
2715                          .BACKGROUND
2716                          .FONT
2717                          .BUF?
2718                          .MIN-HEIGHT
2719                          .MIN-WIDTH>>
2720       .VAL)>
2721     .PARENT
2722     !,CROSS-CURSOR>>
2723
2724 <DEFINE UPDATE-SIZE
2725         (VS:VS MY-WIND:FIX MY-FONT:FONT NAME:STRING BWIDTH:FIX WIDTH:FIX
2726          HEIGHT:FIX DW:FIX DH:FIX
2727          "AUX" (ST <STACK <ISTRING <+ 10 <LENGTH .NAME>>>>)
2728                (SS <REST .ST <LENGTH .NAME>>))
2729         <SUBSTRUC .NAME 0 <LENGTH .NAME> .ST>
2730         <1 .SS !\:>
2731         <SET SS <REST .SS>>
2732         <SET HEIGHT <ABS .HEIGHT>>
2733         <SET WIDTH <ABS .WIDTH>>
2734         <SET SS <DUMP-NUMBER .SS <MAX 1 </ <- .HEIGHT <* 2 .BWIDTH>> .DH>>>>
2735         <1 .SS !\x>
2736         <SET SS <REST .SS>>
2737         <DUMP-NUMBER .SS <MAX 1 </ <- .WIDTH <* 2 .BWIDTH>> .DW>>>
2738         <VSOP .VS X-CLEAR .MY-WIND>
2739         <VSOP .VS
2740               X-TEXT
2741               ,GX-COPY
2742               -1
2743               .MY-WIND
2744               0
2745               0
2746               <FONT-ID .MY-FONT>
2747               1 0
2748               <LENGTH .ST>
2749               0 0
2750               .ST>>
2751
2752 <DEFINE DUMP-NUMBER (SS:STRING NUM:FIX "AUX" (BASE:FIX 1000))
2753         <REPEAT ((ANY? <>) DIG)
2754                 <SET DIG </ .NUM .BASE>>
2755                 <SET NUM <MOD .NUM .BASE>>
2756                 <COND (<OR .ANY? <NOT <0? .DIG>>>
2757                        <SET ANY? T>
2758                        <1 .SS <ASCII <+ .DIG <ASCII !\0>>>>
2759                        <SET SS <REST .SS>>)
2760                       (T <1 .SS !\ > <SET SS <REST .SS>>)>
2761                 <COND (<0? <SET BASE </ .BASE 10>>> <RETURN .SS>)>>>
2762
2763 <GDECL (TEMP-VERTS) STRING
2764        (DRAW-CHANGED?) <OR ATOM FALSE>
2765        (DRAW-ODD?) FIX>
2766
2767 <DEFINE FDRAW (CH:VSCHAN LEFT:FIX TOP:FIX WIDTH:FIX HEIGHT:FIX
2768                "AUX" (VW:VSW <CHANNEL-DATA .CH>) (VS:VS <VW-VS100 .VW>)
2769                VERTS:STRING)
2770    <COND (<NOT <GASSIGNED? TEMP-VERTS>>
2771           <SETG TEMP-VERTS <ISTRING 30>>
2772           <SETG DRAW-ODD? -1>
2773           <SETG DRAW-CHANGED? T>)>
2774    <SET VERTS ,TEMP-VERTS>
2775    <COND (,DRAW-CHANGED?
2776           <COND (<L? .WIDTH 0>
2777                  <SET LEFT <+ .LEFT .WIDTH>>
2778                  <SET WIDTH <- .WIDTH>>)>
2779           <COND (<L? .HEIGHT 0>
2780                  <SET TOP <+ .TOP .HEIGHT>>
2781                  <SET HEIGHT <- .HEIGHT>>)>
2782           <PUT-WORD .VERTS 1 .LEFT>
2783           <PUT-WORD .VERTS 2 .TOP>
2784           <PUT-WORD .VERTS 3 0>
2785           <PUT-WORD .VERTS 4 .WIDTH>
2786           <PUT-WORD .VERTS 5 0>
2787           <PUT-WORD .VERTS 6 ,VERTEX-RELATIVE>
2788           <PUT-WORD .VERTS 7 0>
2789           <PUT-WORD .VERTS 8 .HEIGHT>
2790           <PUT-WORD .VERTS 9 ,VERTEX-RELATIVE>
2791           <PUT-WORD .VERTS 10 <- .WIDTH>>
2792           <PUT-WORD .VERTS 11 0>
2793           <PUT-WORD .VERTS 12 ,VERTEX-RELATIVE>
2794           <PUT-WORD .VERTS 13 0>
2795           <PUT-WORD .VERTS 14 <- .HEIGHT>>
2796           <PUT-WORD .VERTS 15 ,VERTEX-RELATIVE>
2797           <SETG DRAW-CHANGED? <>>)>
2798         <VSOP .VS X-DRAW ,GX-XOR -1 <VW-ID .VW> 5
2799               1 1 1 1 0
2800               <LSH *25252525252*
2801                    <MOD <LSH <SETG DRAW-ODD? <MOD <+ ,DRAW-ODD? 1> 4>> -1> 2>>
2802               16 1
2803               .VERTS>>
2804
2805 <DEFINE MOUSE-RESIZE-WINDOW (CH:VSCHAN OPER WHICH:FIX)
2806    <COND (<NOT <CHANNEL-OP .CH ICON?>>
2807           <MOUSE-MOVE-WINDOW .CH .OPER .WHICH T>)>>
2808
2809 <DEFINE MOUSE-MOVE-WINDOW (CH:VSCHAN OPER WHICH:FIX
2810                            "OPT" (RESIZE? <>)
2811                            "AUX" (VW:VSW <CHANNEL-DATA .CH>)
2812                                  (VS:VS <VW-VS100 .VW>)
2813                                  (PARENT:VSCHAN <VW-PARENT .VW>) TOP:FIX LEFT:FIX
2814                                  BOT:FIX RIGHT:FIX
2815                                  WEVENT:FIX
2816                                  (HEIGHT:FIX
2817                                   <+ <* 2 <VW-BWIDTH .VW>> <VW-HEIGHT .VW> -1>)
2818                                  (WIDTH
2819                                   <+ <* 2 <VW-BWIDTH .VW>> <VW-WIDTH .VW> -1>)
2820                                  P:<OR FALSE UVECTOR> MX:FIX MY:FIX
2821                                  PID:FIX OLD (CDIST:FIX <MIN>)
2822                                  TMP MINW:FIX MINH:FIX FH:FIX FW:FIX
2823                                  (MOVE-RIGHT? <>) (MOVE-LEFT? <>)
2824                                  (MOVE-TOP? <>) (MOVE-BOTTOM? <>))
2825    <COND (<==? .WHICH ,MOUSE-LEFT> <SET WEVENT ,ME-LEFT-RELEASED>)
2826          (<==? .WHICH ,MOUSE-RIGHT> <SET WEVENT ,ME-RIGHT-RELEASED>)
2827          (<==? .WHICH ,MOUSE-CENTER> <SET WEVENT ,ME-MIDDLE-RELEASED>)
2828          (T <SET WEVENT ,ME-RELEASED-MASK>)>
2829    <VW-FLUSH-BUFFER .VW>
2830    <COND (<==? .PARENT <VS-TOPCHAN .VS>>
2831           <CHANNEL-OP .CH RAISE-WINDOW>)
2832          (T
2833           <CHANNEL-OP .PARENT RAISE-WINDOW>)>
2834    <SET PID <VW-ID <CHANNEL-DATA .PARENT>:VSW>>
2835    <SET OLD <CHANNEL-OP .PARENT MOUSE-MOVE? .WHICH>>
2836    <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
2837           <SET LEFT <I-SPAR2 .P>>
2838           <SET TOP <I-SPAR3 .P>>)>
2839    <SET RIGHT <+ .LEFT .WIDTH>>
2840    <SET BOT <+ .TOP .HEIGHT>>
2841    <COND (.RESIZE?
2842           <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
2843                  <SET FH <I-SPAR1 .P>>
2844                  <SET FW <I-SPAR3 .P>>
2845                  <SET MINW <MIN <+ 1 <* <VW-BWIDTH .VW> 2>> <I-SPAR2 .P>>>
2846                  <SET MINH <MIN <+ 1 <* <VW-BWIDTH .VW> 2>> <I-SPAR0 .P>>>)
2847                 (T
2848                  <SET FH 1>
2849                  <SET FW 1>
2850                  <SET MINW <+ 1 <* 2 <VW-BWIDTH .VW>>>>
2851                  <SET MINH .MINW>)>)>
2852    <GRAB-MOUSE-AND-DO
2853     <COND
2854      (<SET P <VSOP .VS X-QUERY-MOUSE .PID>>
2855       <SET MX <I-SPAR2 .P:UVECTOR>>
2856       <SET MY <I-SPAR3 .P:UVECTOR>>
2857       <COND (.RESIZE?
2858              <BIND ((FT <* <+ .TOP <VW-BWIDTH .VW>> 3>)
2859                     (FL <* <+ .LEFT <VW-BWIDTH .VW>> 3>)
2860                     (FW <* .WIDTH 3>)
2861                     (FH <* .HEIGHT 3>)
2862                     (FMX <* .MX 3>)
2863                     (FMY <* .MY 3>))
2864                 <COND (<L? .FMY <+ .FT .HEIGHT>>
2865                        <SET MOVE-TOP? T>)
2866                       (<G? .FMY <+ .FT <* 2 .HEIGHT>>>
2867                        <SET MOVE-BOTTOM? T>)>
2868                 <COND (<L? .FMX <+ .FL .WIDTH>>
2869                        <SET MOVE-LEFT? T>)
2870                       (<G? .FMX <+ .FL <* 2 .WIDTH>>>
2871                        <SET MOVE-RIGHT? T>)>
2872                 <COND (<AND <NOT .MOVE-TOP?> <NOT .MOVE-BOTTOM?>
2873                             <NOT .MOVE-LEFT?> <NOT .MOVE-RIGHT?>>
2874                        <COND (<L? <- .FMY .FT> <- <+ .FT .FH> .FMY>>
2875                               <SET MOVE-TOP? T>)
2876                              (T
2877                               <SET MOVE-BOTTOM? T>)>
2878                        <COND (<L? <- .FMX .FL> <- <+ .FL .FW> .FMX>>
2879                               <SET MOVE-LEFT? T>)
2880                              (T
2881                               <SET MOVE-RIGHT? T>)>)>>)>
2882       <SETG DRAW-CHANGED? T>
2883       <SETG DRAW-ODD? -1>
2884       <REPEAT (E DX:FIX DY:FIX (DRAW? T) (FLUSH? <>)
2885                (FH:FIX <CHANNEL-OP <VS-CHANNEL .VS> FILE-HANDLE>)
2886                (TV <STACK <UVECTOR 0 15000>>) (MXD:FIX <+ .FH 1>)
2887                (VV <STACK <IUVECTOR 1>>) (RD:FIX <LSH 1 .FH>)
2888                CT:<OR FIX FALSE>)
2889          <COND (.DRAW?
2890                 <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2891                 <SET DRAW? <>>
2892                 <CHANNEL-OP .PARENT BUFOUT>)>
2893          <COND
2894           (<OR <NOT <SET CT <CALL SYSCALL SELECT .MXD <1 .VV .RD> 0 0 .TV>>>
2895                <0? .CT>>
2896            <SET E <>>
2897            <SET DRAW? T>
2898            <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2899            <CHANNEL-OP .PARENT BUFOUT>
2900            <CALL SYSCALL SELECT 0 0 0 0 .TV>)
2901           (<TYPE? <SET E <GET-EVENT .VS <>>> MOUSE-EVENT>
2902            <COND
2903             (<OR <NOT <0? <ANDB <ME-KIND .E> .WEVENT>>>
2904                  <SET FLUSH? <NOT <0? <ANDB <ME-KIND .E> ,ME-PRESSED-MASK>>>>>
2905              <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2906              <CHANNEL-OP .PARENT BUFOUT>
2907              <CHANNEL-OP .PARENT MOUSE-MOVE? .OLD>
2908              <CHANNEL-OP .CH BUFOUT>
2909              <COND (.FLUSH?)
2910                    (.RESIZE?
2911                     <SET HEIGHT <- .HEIGHT -1 <* 2 <VW-BWIDTH .VW>>>>
2912                     <SET WIDTH <- .WIDTH -1 <* 2 <VW-BWIDTH .VW>>>>
2913                     <VW-HEIGHT .VW .HEIGHT>
2914                     <VW-WIDTH .VW .WIDTH>
2915                     <COND (<VW-SCALE .VW>
2916                            <CHANNEL-OP .CH DRAW-LEFT <S-LEFT <VW-SCALE .VW>>>)>
2917                     <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNSEEN>>
2918                     <VSOP .VS
2919                           X-CONFIGURE-WINDOW
2920                           <VW-ID .VW>
2921                           .HEIGHT
2922                           .WIDTH
2923                           .LEFT
2924                           .TOP>)
2925                    (T
2926                     <VSOP .VS X-MOVE-WINDOW <VW-ID .VW> .LEFT .TOP>)>
2927              <RECYCLE-EVENTS .E>
2928              <RETURN <NOT .FLUSH?>>)
2929             (<==? <ME-KIND .E> ,ME-MOVED>
2930              <FDRAW .PARENT .LEFT .TOP .WIDTH .HEIGHT>
2931              <CHANNEL-OP .PARENT BUFOUT>
2932              <SETG DRAW-CHANGED? T>
2933              <SET DRAW? T>
2934              <SET DX <- <ME-X .E> .MX>>
2935              <SET DY <- <ME-Y .E> .MY>>
2936              <SET MX <ME-X .E>>
2937              <SET MY <ME-Y .E>>
2938              <COND (.RESIZE?
2939                     <COND (.MOVE-LEFT?
2940                            <COND (<L? <- .RIGHT .MX> .MINW>
2941                                   <SET LEFT <- .RIGHT .MINW>>)
2942                                  (T
2943                                   <SET LEFT .MX>)>)
2944                           (.MOVE-RIGHT?
2945                            <COND (<L? <- .MX .LEFT> .MINW>
2946                                   <SET RIGHT <+ .LEFT .MINW>>)
2947                                  (T
2948                                   <SET RIGHT .MX>)>)>
2949                     <COND (.MOVE-TOP?
2950                            <COND (<L? <- .BOT .MY> .MINH>
2951                                   <SET TOP <- .BOT .MINH>>)
2952                                  (T
2953                                   <SET TOP .MY>)>)
2954                           (.MOVE-BOTTOM?
2955                            <COND (<L? <- .MY .TOP> .MINH>
2956                                   <SET BOT <+ .TOP .MINH>>)
2957                                  (T
2958                                   <SET BOT .MY>)>)>
2959                     <SET WIDTH <- .RIGHT .LEFT>>
2960                     <SET HEIGHT <- .BOT .TOP>>
2961                     <COND (<NOT <0? <MOD <SET TMP <- .WIDTH .MINW>> .FW>>>
2962                            <SET WIDTH <+ .MINW
2963                                          <* .FW
2964                                             </ <FIX <+ .TMP </ .FW 2.0>>>
2965                                                .FW>>>>
2966                            <COND (.MOVE-LEFT?
2967                                   <SET LEFT <- .RIGHT .WIDTH>>)
2968                                  (.MOVE-RIGHT?
2969                                   <SET RIGHT <+ .LEFT .WIDTH>>)>)>
2970                     <COND (<NOT <0? <MOD <SET TMP <- .HEIGHT .MINH>> .FH>>>
2971                            <SET HEIGHT <+ .MINH
2972                                           <* .FH
2973                                              </ <FIX <+ .TMP </ .FH 2.0>>>
2974                                                 .FH>>>>
2975                            <COND (.MOVE-TOP?
2976                                   <SET TOP <- .BOT .HEIGHT>>)
2977                                  (.MOVE-BOTTOM?
2978                                   <SET BOT <+ .TOP .HEIGHT>>)>)>)
2979                    (T <SET LEFT <+ .DX .LEFT>> <SET TOP <+ .DY .TOP>>)>)>)>
2980          <RECYCLE-EVENTS .E>>)>
2981     .PARENT
2982     !,CROSS-CURSOR>>
2983
2984 <DEFINE PAGE-LOC (CHN:VSCHAN OPER
2985                   "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>) P)
2986         <COND (<SET P <VSOP .VS X-QUERY-WINDOW <VW-ID .VW>>>
2987                <COND (<==? .OPER PAGE-TOP> <I-SPAR3 .P>) (T <I-SPAR2 .P>)>)>>
2988
2989 <DEFINE VS-PAGE-HEIGHT (CHN:VSCHAN OPER
2990                         "OPT" NEW:FIX
2991                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD
2992                               (CFONT <VW-CFONT .VW>))
2993         <SET OLD </ <VW-HEIGHT .VW> <FONT-HEIGHT .CFONT>>>
2994         <COND (<ASSIGNED? NEW>
2995                <SET NEW <* <FONT-HEIGHT .CFONT> .NEW>>
2996                <COND (<L=? .NEW 0>)
2997                      (T <CHANNEL-OP .CHN RESIZE .NEW <VW-WIDTH .VW>>)>)>
2998         .OLD>
2999
3000 <DEFINE VS-PAGE-WIDTH (CHN:VSCHAN OPER
3001                        "OPT" NEW:FIX
3002                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD
3003                              (CFONT <VW-CFONT .VW>))
3004         <SET OLD </ <VW-WIDTH .VW> <FONT-WIDTH .CFONT>>>
3005         <COND (<ASSIGNED? NEW>
3006                <SET NEW <* <FONT-WIDTH .CFONT> .NEW>>
3007                <COND (<L=? .NEW 0>)
3008                      (T <CHANNEL-OP .CHN RESIZE <VW-HEIGHT .VW> .NEW>)>)>
3009         .OLD>
3010
3011 <DEFINE VS-PAGE-WIDTH-ABS (CHN:VSCHAN OPER
3012                            "OPT" NEW:FIX
3013                            "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD)
3014         <SET OLD <VW-WIDTH .VW>>
3015         <COND (<ASSIGNED? NEW> <CHANNEL-OP .CHN RESIZE <VW-HEIGHT .VW> .NEW>)>
3016         .OLD>
3017
3018 <DEFINE VS-PAGE-HEIGHT-ABS (CHN:VSCHAN OPER
3019                             "OPT" NEW:FIX
3020                             "AUX" (VW:VSW <CHANNEL-DATA .CHN>) OLD)
3021         <SET OLD <VW-HEIGHT .VW>>
3022         <COND (<ASSIGNED? NEW> <CHANNEL-OP .CHN RESIZE .NEW <VW-WIDTH .VW>>)>
3023         .OLD>
3024
3025 <DEFINE VS-RESIZE (CHN:VSCHAN OPER HEIGHT:<OR FIX FALSE> WIDTH:<OR FIX FALSE>
3026                    "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>))
3027         <VW-FLUSH-BUFFER .VW>
3028         <COND (.HEIGHT <VW-HEIGHT .VW .HEIGHT>)
3029               (T <SET HEIGHT <VW-HEIGHT .VW>>)>
3030         <COND (.WIDTH <VW-WIDTH .VW .WIDTH>) (T <SET WIDTH <VW-WIDTH .VW>>)>
3031         <COND (<VW-SCALE .VW>
3032                <CHANNEL-OP .CHN DRAW-LEFT <S-LEFT <VW-SCALE .VW>>>)>
3033         <VSOP .VS X-CHANGE-WINDOW <VW-ID .VW> .HEIGHT .WIDTH>
3034         <VW-OUTMODE .VW <ORB <VW-OUTMODE .VW> ,VWM-UNSEEN>>
3035         .CHN>
3036
3037 <DEFINE VS-MOVE-WINDOW (CHN:VSCHAN OPER LEFT:FIX TOP:FIX
3038                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
3039                               (VS:VS <VW-VS100 .VW>))
3040         <VW-FLUSH-BUFFER .VW>
3041         <VSOP .VS X-MOVE-WINDOW <VW-ID .VW> .LEFT .TOP>>
3042
3043 <DEFINE SET-RESIZE-HINT (CHN:VSCHAN OPER "OPT" (MIN-HEIGHT:FIX -1)
3044                          (HINCR:FIX -1) (MIN-WIDTH:FIX -1) (WINCR:FIX -1)
3045                          "AUX" (VW:VSW <CHANNEL-DATA .CHN>) (VS:VS <VW-VS100 .VW>)
3046                          P)
3047    <COND (<SET P <VSOP .VS X-GET-RESIZE-HINT <VW-ID .VW>>>
3048           <COND (<L? .MIN-HEIGHT 0> <SET MIN-HEIGHT <I-SPAR0 .P>>)>
3049           <COND (<L? .HINCR 0> <SET HINCR <I-SPAR1 .P>>)>
3050           <COND (<L? .MIN-WIDTH 0> <SET MIN-WIDTH <I-SPAR2 .P>>)>
3051           <COND (<L? .WINCR 0> <SET WINCR <I-SPAR3 .P>>)>)>
3052    <VSOP .VS X-SET-RESIZE-HINT <VW-ID .VW> .MIN-HEIGHT .HINCR .MIN-WIDTH .WINCR>>
3053
3054 <DEFINE VS-WINDOW-NAME (CHN:VSCHAN OPER
3055                         "OPT" NAME:STRING
3056                         "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
3057                               (VS:VS <VW-VS100 .VW>) TS)
3058         <COND (<ASSIGNED? NAME>
3059                <VSOP .VS X-STORE-NAME <VW-ID .VW> <LENGTH .NAME> .NAME>
3060                .NAME)
3061               (<SET TS <VSOP .VS X-FETCH-NAME <VW-ID .VW>>>
3062                <STRING .TS>)>>
3063
3064 <DEFINE VS-CUT-BUFFER (CHN:VSCHAN OPER
3065                        "OPT" STUFF:STRING (ID:FIX 0)
3066                        "AUX" (VW:VSW <CHANNEL-DATA .CHN>)
3067                              (VS:VS <VW-VS100 .VW>) TS)
3068         <COND (<ASSIGNED? STUFF>
3069                <VSOP .VS X-STORE-BYTES .ID 0 <LENGTH .STUFF> .STUFF>
3070                .STUFF)
3071               (<SET TS <VSOP .VS X-FETCH-BYTES .ID 0>>
3072                <STRING .TS>)>>
3073
3074 <DEFINE GET-FONT (NAME:STRING VS:VS)
3075         <REPEAT ((L:<LIST [REST FIX FONT]> <VS-FONTS .VS>))
3076                 <COND (<NOT <EMPTY? .L>>
3077                        <COND (<=? .NAME <FONT-NAME <2 .L>>> <RETURN <2 .L>>)>
3078                        <SET L <REST .L 2>>)
3079                       (T <RETURN <LOAD-FONT .NAME .VS>>)>>>
3080
3081 <DEFINE LOAD-FONT LF (NAME:STRING VS:VS
3082                       "AUX" (NS <STANDARD-NAME .NAME>) F P FS:FONT FIRST LAST
3083                       ST)
3084    <SUBSTRUC .NS 0 <- <LENGTH .NS> 1> <REST .NS>>
3085    <COND
3086     (<SET F <VSOP .VS X-GET-FONT 0 <- <LENGTH .NS> 1> <REST .NS>>>
3087      <SET FS <CHTYPE [.NAME .F 0 0 0 <> 0 <>] FONT>>
3088      <COND
3089       (<SET P <VSOP .VS X-QUERY-FONT 0 .F>>
3090        <FONT-HEIGHT .FS <I-SPAR0 .P>>
3091        <FONT-WIDTH .FS <I-SPAR1 .P>>
3092        <FONT-BASE .FS <I-SPAR4 .P>>
3093        <COND
3094         (<NOT <0? <I-SPAR5 .P>>> <FONT-FIXED? .FS T>)
3095         (T
3096          <SET FIRST <I-SPAR2 .P>>
3097          <SET LAST <I-SPAR3 .P>>
3098          <COND
3099           (<SET ST <VSOP .VS X-CHAR-WIDTHS 0 .F 2 "W1">>
3100            <COND (<AND <==? <1 .ST> <3 .ST>>
3101                        <==? <2 .ST> <4 .ST>>>
3102                   <FONT-WIDTH .FS <I-SPAR2 .P>>
3103                   <FONT-FIXED? .FS T>)
3104                  (T
3105                   <COND
3106                    (<SET ST <VSOP .VS X-FONT-WIDTHS 0 .F>>
3107                     <REPEAT ((C .FIRST)
3108                              (UV:<UVECTOR [REST FIX]>
3109                               <IUVECTOR <+ 1 <- .LAST .FIRST>>>))
3110                        <COND (<EMPTY? .ST>
3111                               <FONT-CHARS .FS .UV>
3112                               <RETURN>)>
3113                        <PUT .UV <+ 1 <- .C .FIRST>>
3114                             <+ <ASCII <1 .ST>>
3115                                <LSH <ASCII <2 .ST>> 8>>>
3116                        <SET C <+ .C 1>>
3117                        <SET ST <REST .ST 2>>>)>)>
3118            <FONT-FIRST .FS .FIRST>)
3119           (T <RETURN .P .LF>)>)>
3120        <VS-FONTS .VS (.F .FS !<VS-FONTS .VS>)>
3121        .FS)>)>>
3122
3123 <DEFINE CHAR-WIDTH (CHAR:CHARACTER FONT:FONT "AUX" FF:FIX)
3124         <COND (<FONT-FIXED? .FONT> <FONT-WIDTH .FONT>)
3125               (<OR <L? <ASCII .CHAR> <SET FF <FONT-FIRST .FONT>>>
3126                    <G=? <ASCII .CHAR>
3127                         <+ .FF <LENGTH <FONT-CHARS .FONT>:UVECTOR>>>>
3128                0)
3129               (T
3130                <NTH <FONT-CHARS .FONT>:UVECTOR <+ <- <ASCII .CHAR> .FF> 1>>)>>
3131
3132 <DEFINE STRING-WIDTH (STR:STRING FONT:FONT VS:VS)
3133         <VSOP .VS X-STRING-WIDTH 0 <FONT-ID .FONT> <LENGTH .STR> .STR>>
3134
3135 <DEFINE VS-LINE-HEIGHT (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
3136         <FONT-HEIGHT <VW-CFONT .VW>>>
3137
3138 <DEFINE VS-CHAR-WIDTH (CHN:VSCHAN OPER "AUX" (VW:VSW <CHANNEL-DATA .CHN>))
3139         <FONT-WIDTH <VW-CFONT .VW>>>
3140
3141 <ENDPACKAGE>