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