(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "ROOMS" (USE "LISP" "XCL") (SHADOW CLROOM))
)

(IL:FILECREATED " 5-Dec-2020 16:35:05" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>ROOMS-BUTTONS.;3|
 58830  

      IL:|previous| IL:|date:| "17-Aug-90 12:33:51" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>ROOMS-BUTTONS.;2|)


; Copyright (c) 1987, 1988, 1990, 2020 by Venue & Xerox Corporation.  All rights reserved.

(IL:PRETTYCOMPRINT IL:ROOMS-BUTTONSCOMS)

(IL:RPAQQ IL:ROOMS-BUTTONSCOMS

          ((FILE-ENVIRONMENTS IL:ROOMS-BUTTONS)
           (IL:FILES (IL:SYSLOAD)
                  IL:ROOMS-D IL:ROOMS-TEXT IL:ROOMS-BIOS)
           (IL:P (EXPORT '(BUTTON *DEFAULT-BUTTON-TYPE* DEF-BUTTON-TYPE MAKE-BUTTON BUTTON-PROP 
                                 *BUTTON-HELP-DELAY* *BUTTON-SELECTION-SHADE* MAKE-BUTTON-WINDOW 
                                 SET-BUTTON-WINDOW-TEXT-STRING WITH-BUTTON *DEFAULT-BUTTON-SHADOWS* 
                                 MAKE-EAST-WEST-BITMAP MAKE-NORTH-SOUTH-BITMAP MAKE-NSEW-BITMAP)
                        "ROOMS"))
           (IL:COMS                                          (IL:* IL:\; "button types")

                  (IL:DEFINE-TYPES IL:BUTTON-TYPES)
                  (IL:STRUCTURES BUTTON-TYPE)
                  (IL:VARIABLES *BUTTON-TYPES* *DEFAULT-BUTTON-TYPE*)
                  (IL:FUNCTIONS DEF-BUTTON-TYPE BUTTON-TYPE-PROP SELECT-BUTTON-TYPE BUTTON-TYPE-NAMED
                         )
                  (IL:SEDIT-FORMATS DEF-BUTTON-TYPE))
           (IL:COMS                                          (IL:* IL:\; "the button object")

                  (IL:STRUCTURES BUTTON UPDATED-BUTTON MARGINS)
                  (IL:VARIABLES *DEFAULT-BUTTON-SHADOWS*)
                  (IL:FUNCTIONS                              (IL:* IL:\; "core code")

                         MAKE-BUTTON COPY-BUTTON DISPLAY-BUTTON UPDATE-BUTTON SET-BUTTON-TEXT-STRING
                         BUTTON-PROP)
                  (IL:FUNCTIONS                              (IL:* IL:\; "text")

                         SET-BUTTON-TEXT-STRING COMPUTE-BUTTON-TEXT-POSITION BUTTON-TEXT-X-COORD 
                         BUTTON-TEXT-Y-COORD TEXT-FROM-TEXT-FORM)
                  (IL:FUNCTIONS                              (IL:* IL:\; "mouse code")

                         BUTTON-TRACK-MOUSE PERFORM-BUTTON-ACTION EDIT-BUTTON BUTTON-COPY-SELECTED 
                         SHADE-BUTTON PRINT-BUTTON-HELP))
           (IL:COMS                                          (IL:* IL:\; "button windows")

                  (IL:VARIABLES *BUTTON-HELP-DELAY* *BUTTON-SELECTION-SHADE*)
                  (IL:FUNCTIONS MAKE-BUTTON-WINDOW BW-REPAINTFN BW-TOTOPFN BW-BUTTONEVENTFN 
                         BW-BUTTONEVENTFN-INTERNAL SET-BUTTON-WINDOW-TEXT-STRING 
                         MAYBE-RESIZE-BUTTON-WINDOW BW-SCREEN-CHANGED-FUNCTION)
                  (IL:VARIABLES 

                         (IL:* IL:|;;| 

          "this variable also on ROOMS-CORE, but here so we can be loaded w/o loading all of rooms")


                         *SCREEN-CHANGED-FUNCTIONS*)
                  (IL:P (PUSHNEW 'BW-SCREEN-CHANGED-FUNCTION *SCREEN-CHANGED-FUNCTIONS*)))
           (IL:COMS                                          (IL:* IL:\; "button bitmaps")

                  (IL:STRUCTURES NORTH-SOUTH-BITMAP EAST-WEST-BITMAP NSEW-BITMAP)
                  (IL:FUNCTIONS DISPLAY-BUTTON-IMAGE DISPLAY-BUTTON-MASK BUTTON-WIDTH BUTTON-HEIGHT 
                         BUTTON-BITMAP-BITBLT EW-BITBLT NS-BITBLT NSEW-BITBLT PAINT-REGION))
                                                             (IL:* IL:\; "externalization")

           (IL:FUNCTIONS EDIT-BUTTON-WINDOW EXTERNALIZE-BUTTON EXTERNALIZE-FONT)
           (IL:FUNCTIONS WITH-BUTTON)
           (IL:BUTTON-TYPES :DOOR :SHADOWED :TRANSPARENT :PORTHOLE :ARK :ROUND-ARK :STRETCHY-ARK 
                  :STRETCHY-ROUND-ARK)
           (IL:GLOBALVARS IL:MENUHELDWAIT)))

(DEFINE-FILE-ENVIRONMENT IL:ROOMS-BUTTONS
 :COMPILER :COMPILE-FILE
   :PACKAGE (DEFPACKAGE "ROOMS" (:USE "LISP" "XCL")
                   (:SHADOW CL:ROOM))
   :READTABLE "XCL")

(IL:FILESLOAD (IL:SYSLOAD)
       IL:ROOMS-D IL:ROOMS-TEXT IL:ROOMS-BIOS)

(EXPORT '(BUTTON *DEFAULT-BUTTON-TYPE* DEF-BUTTON-TYPE MAKE-BUTTON BUTTON-PROP *BUTTON-HELP-DELAY* 
                *BUTTON-SELECTION-SHADE* MAKE-BUTTON-WINDOW SET-BUTTON-WINDOW-TEXT-STRING WITH-BUTTON
                *DEFAULT-BUTTON-SHADOWS* MAKE-EAST-WEST-BITMAP MAKE-NORTH-SOUTH-BITMAP 
                MAKE-NSEW-BITMAP)
       "ROOMS")



(IL:* IL:\; "button types")



(DEF-DEFINE-TYPE IL:BUTTON-TYPES
 "Button types"
   :UNDEFINER (LAMBDA (NAME)
                     (REMHASH NAME *BUTTON-TYPES*)))

(DEFSTRUCT BUTTON-TYPE

   NAME

   (IL:* IL:|;;| "name of the type")


   IMAGE-BITMAP

   (IL:* IL:|;;| "the background for the text")


   MASK-BITMAP

   (IL:* IL:|;;| "to allow non-rectangular buttons.  should be a bitmap the same size as IMAGE-BITMAP.  designates the set of bits of IMAGE-BITMAP which are the region to be displayed. ")


   (MARGINS (MAKE-MARGINS))

   (IL:* IL:|;;| "a MARGINS record.")


   PROPS)

(DEFGLOBALVAR *BUTTON-TYPES*
 (MAKE-HASH-TABLE :TEST 'EQ))

(DEFPARAMETER *DEFAULT-BUTTON-TYPE*
 :SHADOWED)

(DEFDEFINER DEF-BUTTON-TYPE
 IL:BUTTON-TYPES (NAME &REST REST-KEYS &KEY IMAGE MASK (MARGINS (
                                                                                         MAKE-MARGINS
                                                                                                ))
                                                      &ALLOW-OTHER-KEYS)
   `(SETF (GETHASH ',NAME *BUTTON-TYPES*)
          (MAKE-BUTTON-TYPE :NAME ',NAME :IMAGE-BITMAP ',IMAGE :MASK-BITMAP ',MASK :MARGINS
                 ',MARGINS :PROPS ',(LET ((PROPS (COPY-LIST REST-KEYS)))
                                         (DOLIST (KEYWORD '(:IMAGE :MASK :MARGINS))
                                             (REMF PROPS KEYWORD))
                                         PROPS))))

(DEFMACRO BUTTON-TYPE-PROP
 (BUTTON-TYPE PROP &OPTIONAL (NEW-VALUE NIL NEW-VALUE-SUPPLIED))
   (IF NEW-VALUE-SUPPLIED
       `(SETF (GETF (BUTTON-TYPE-PROPS ,BUTTON-TYPE)
                    ,PROP)
              ,NEW-VALUE)
       `(GETF (BUTTON-TYPE-PROPS ,BUTTON-TYPE)
              ,PROP)))

(DEFUN SELECT-BUTTON-TYPE
 (&OPTIONAL (REASON "Select Button Type"))

   (IL:* IL:|;;| "returns the name of a button type or NIL")


   (MENU
    (WITH-COLLECTION
     (DOLIST (TYPE (SORT (WITH-COLLECTION (MAPHASH #'(LAMBDA (NAME TYPE)
                                                            (COLLECT TYPE))
                                                 *BUTTON-TYPES*))
                         #'STRING-LESSP :KEY #'BUTTON-TYPE-NAME))
         (LET ((NAME (BUTTON-TYPE-NAME TYPE)))
              (COLLECT `(,(OR (BUTTON-TYPE-PROP
 TYPE :SAMPLE-IMAGE)

                              (IL:* IL:|;;| "cache sample images on button type")


                              (LET* ((BUTTON (MAKE-BUTTON
 :TYPE NAME :TEXT
                                                    (LET ((*PRINT-CASE* :CAPITALIZE)
                                                          (*READTABLE* (IL:FIND-READTABLE "XCL")))
                                                         (PRINC-TO-STRING NAME))))
                                     (IMAGE (IL:BITMAPCREATE (BUTTON-WIDTH
 BUTTON)
                                                   (BUTTON-HEIGHT
 BUTTON))))
                                    (DISPLAY-BUTTON
 BUTTON IMAGE)
                                    (BUTTON-TYPE-PROP
 TYPE :SAMPLE-IMAGE IMAGE)
                                    IMAGE))
                         ',NAME)))))
    REASON))

(DEFMACRO BUTTON-TYPE-NAMED
 (TYPE-NAME)
   `(GETHASH ,TYPE-NAME *BUTTON-TYPES*))

(SEDIT:DEF-LIST-FORMAT DEF-BUTTON-TYPE
 :ARGS (NIL :KEYWORD NIL)
   :INDENT (1))



(IL:* IL:\; "the button object")



(DEFSTRUCT (BUTTON
 (:CONSTRUCTOR MAKE-BUTTON-INTERNAL)
                       (:PRINT-FUNCTION (LAMBDA (BUTTON STREAM DEPTH)
                                               (LET ((TYPE (BUTTON-TYPE BUTTON))
                                                     (TEXT (BUTTON-TEXT BUTTON)))
                                                    (FORMAT STREAM "#<~A button ~S>"
                                                           (TYPECASE TYPE
                                                               (BUTTON-TYPE (BUTTON-TYPE-NAME TYPE))
                                                               (T TYPE))
                                                           (TYPECASE (BUTTON-TEXT BUTTON)
                                                               (TEXT (TEXT-STRING TEXT))
                                                               (T TEXT))))))
                       (:COPIER COPY-BUTTON-INTERNAL))
   (TYPE *DEFAULT-BUTTON-TYPE* :TYPE BUTTON-TYPE)

   (IL:* IL:|;;| "a BUTTON-TYPE structure")


   (TEXT NIL :TYPE TEXT)

   (IL:* IL:|;;| "a TEXT structure")


   (ACTION NIL :TYPE LIST)

   (IL:* IL:|;;| "form to EVAL when this button is pressed")


   (HELP-STRING NIL :TYPE STRING)

   (IL:* IL:|;;| "printed when button is held")


   (INVERTED? NIL :TYPE (MEMBER T NIL))

   (IL:* IL:|;;| "if true, button image will be inverted")


   (%SELECTED? NIL :TYPE (MEMBER T NIL))

   (IL:* IL:|;;| "non-nil when button appears selected")


   %MASK %IMAGE 

   (IL:* IL:|;;| "caches used by redisplay")


   (PROPS NIL :TYPE LIST))

(DEFSTRUCT (UPDATED-BUTTON
 (:INCLUDE BUTTON)
                               (:PRINT-FUNCTION (LAMBDA (BUTTON STREAM DEPTH)
                                                       (FORMAT STREAM "#<Updated ~A button ~S>"
                                                              (LET ((TYPE (BUTTON-TYPE BUTTON)))
                                                                   (TYPECASE TYPE
                                                                       (BUTTON-TYPE (BUTTON-TYPE-NAME
                                                                                     TYPE))
                                                                       (T TYPE)))
                                                              (UPDATED-BUTTON-TEXT-FORM BUTTON)))))
   (TEXT-FORM NIL :TYPE T))

(DEFSTRUCT (MARGINS
 (:TYPE LIST))

(IL:* IL:|;;;| "defines the region within a button intended for the text.  We cannot use a region, as buttons may be strechable.")


   (LEFT 0 :TYPE INTEGER)
   (BOTTOM 0 :TYPE INTEGER)
   (RIGHT 0 :TYPE INTEGER)
   (TOP 0 :TYPE INTEGER))

(DEFVAR *DEFAULT-BUTTON-SHADOWS*
 NIL
   "Default for :SHADOWS arg to MAKE-BUTTON.\
Overridden when button type has default shadows.")

(DEFUN MAKE-BUTTON
 (&REST REST-KEYS &KEY (TYPE *DEFAULT-BUTTON-TYPE*)
                              (TEXT NIL TEXT-PROVIDED)
                              (TEXT-FORM NIL TEXT-FORM-PROVIDED)
                              (SHADOWS NIL SHADOWS-PROVIDED)
                              ACTION HELP FONT INVERTED? &ALLOW-OTHER-KEYS)

(IL:* IL:|;;;| "make & return a button.  use MAKE-BUTTON-WINDOW to put this button in a window.")


   (LET* ((BUTTON-TYPE (OR (IF (BUTTON-TYPE-P TYPE)
                               TYPE)
                           (BUTTON-TYPE-NAMED
 TYPE)
                           (ERROR "No button type named ~S exists." TYPE)))
          (TEXT (MAKE-TEXT :STRING (IF (AND (NOT TEXT-PROVIDED)
                                            TEXT-FORM-PROVIDED)
                                       (TEXT-FROM-TEXT-FORM
 TEXT-FORM)
                                       TEXT)
                       :ALIGNMENT :CENTER :FONT (IF FONT
                                                    (IL:FONTCREATE FONT)
                                                    *DEFAULT-TEXT-FONT*)
                       :SHADOWS
                       (IF SHADOWS-PROVIDED
                           SHADOWS

                           (IL:* IL:|;;| "default shadows per button type")


                           (GETF (BUTTON-TYPE-PROPS BUTTON-TYPE)
                                 :DEFAULT-SHADOWS *DEFAULT-BUTTON-SHADOWS*))))
          (BUTTON (APPLY (IF TEXT-FORM-PROVIDED
                             #'MAKE-UPDATED-BUTTON
                             #'MAKE-BUTTON-INTERNAL)
                         :TYPE BUTTON-TYPE :TEXT TEXT :ACTION ACTION :HELP-STRING HELP :INVERTED? 
                         INVERTED? :PROPS
                         (LET ((PROPS (COPY-LIST REST-KEYS)))
                              (DOLIST (KEYWORD '(:TYPE :TEXT :ACTION :HELP :FONT :SHADOWS :TEXT-FORM
                                                       :INVERTED?))
                                  (REMF PROPS KEYWORD))
                              PROPS)
                         (WHEN TEXT-FORM-PROVIDED
                             `(:TEXT-FORM ,TEXT-FORM)))))
         (COMPUTE-BUTTON-TEXT-POSITION
 BUTTON)
         BUTTON))

(DEFUN COPY-BUTTON
 (OLD)
   (LET ((NEW (ETYPECASE OLD
                  (UPDATED-BUTTON (COPY-UPDATED-BUTTON OLD))
                  (BUTTON (COPY-BUTTON-INTERNAL OLD)))))
        (SETF (BUTTON-TEXT NEW)
              (COPY-TEXT (BUTTON-TEXT OLD)))
        NEW))

(DEFUN DISPLAY-BUTTON
 (BUTTON DSP &KEY NO-UPDATE WIDTH HEIGHT)
   (WHEN (AND (NULL NO-UPDATE)
              (OR WIDTH HEIGHT))
         (ERROR "Illegal to pass WIDTH & HEIGHT unless NO-UPDATE specified"))
   (UNLESS NO-UPDATE (UPDATE-BUTTON
 BUTTON))
   (LET* ((WIDTH (OR WIDTH (BUTTON-WIDTH
 BUTTON)))
          (HEIGHT (OR HEIGHT (BUTTON-HEIGHT
 BUTTON)))
          (TYPE (BUTTON-TYPE BUTTON)))
         (WHEN (OR (BUTTON-TYPE-MASK-BITMAP TYPE)
                   (NOT (BUTTON-TYPE-IMAGE-BITMAP TYPE)))

             (IL:* IL:|;;| "erase what's in the mask (or if button is transparent)")


             (DISPLAY-BUTTON-MASK
 BUTTON DSP WIDTH HEIGHT))

         (IL:* IL:|;;| "paint the image on")


         (DISPLAY-BUTTON-IMAGE
 BUTTON DSP WIDTH HEIGHT)
         (WHEN (BUTTON-%SELECTED? BUTTON)

             (IL:* IL:|;;| "rationalize the selection")


             (SETF (BUTTON-%SELECTED? BUTTON)
                   NIL)
             (SHADE-BUTTON
 BUTTON DSP))))

(DEFUN UPDATE-BUTTON
 (BUTTON DSP)

(IL:* IL:|;;;| "should really be called BUTTON-NEEDS-REDISPLAY?")


   (WHEN (UPDATED-BUTTON-P BUTTON)

       (IL:* IL:|;;| "set the text string of WINDOW's BUTTON to the value of its TEXT-FORM.")


       (LET ((NEW-TEXT-STRING (TEXT-FROM-TEXT-FORM
 (UPDATED-BUTTON-TEXT-FORM BUTTON)
                                     DSP BUTTON)))
            (UNLESS (EQUAL NEW-TEXT-STRING (TEXT-STRING (BUTTON-TEXT BUTTON)))

                (IL:* IL:|;;| "optimization: don't bother if string is same")


                (SET-BUTTON-TEXT-STRING
 BUTTON NEW-TEXT-STRING)

                (IL:* IL:|;;| "return T if things have changed")


                (RETURN-FROM UPDATE-BUTTON T))))

   (IL:* IL:|;;| "a null image cache means button needs redisplay")


   (NULL (BUTTON-%IMAGE BUTTON)))

(DEFUN SET-BUTTON-TEXT-STRING
 (BUTTON STRING)

(IL:* IL:|;;;| "does everything but redisplay")


   (SET-TEXT-STRING (BUTTON-TEXT BUTTON)
          STRING)
   (COMPUTE-BUTTON-TEXT-POSITION
 BUTTON)

   (IL:* IL:|;;| "clear caches")


   (SETF (BUTTON-%MASK BUTTON)
         NIL)
   (SETF (BUTTON-%IMAGE BUTTON)
         NIL))

(DEFMACRO BUTTON-PROP
 (BUTTON PROP &OPTIONAL (NEW-VALUE NIL NEW-VALUE-SUPPLIED))
   (IF NEW-VALUE-SUPPLIED
       `(SETF (GETF (BUTTON-PROPS ,BUTTON)
                    ,PROP)
              ,NEW-VALUE)
       `(GETF (BUTTON-PROPS ,BUTTON)
              ,PROP)))

(DEFUN SET-BUTTON-TEXT-STRING
 (BUTTON STRING)

(IL:* IL:|;;;| "does everything but redisplay")


   (SET-TEXT-STRING (BUTTON-TEXT BUTTON)
          STRING)
   (COMPUTE-BUTTON-TEXT-POSITION
 BUTTON)

   (IL:* IL:|;;| "clear caches")


   (SETF (BUTTON-%MASK BUTTON)
         NIL)
   (SETF (BUTTON-%IMAGE BUTTON)
         NIL))

(DEFUN COMPUTE-BUTTON-TEXT-POSITION
 (BUTTON)
   (SETF (TEXT-POSITION (BUTTON-TEXT BUTTON))
         (MAKE-POSITION (BUTTON-TEXT-X-COORD
 BUTTON)
                (BUTTON-TEXT-Y-COORD
 BUTTON))))

(DEFUN BUTTON-TEXT-X-COORD
 (BUTTON)
   (LET ((TEXT (BUTTON-TEXT BUTTON))
         (MARGINS (BUTTON-TYPE-MARGINS (BUTTON-TYPE BUTTON))))
        (ECASE (TEXT-ALIGNMENT TEXT)
            (:CENTER (+ (MARGINS-LEFT MARGINS)
                        (FLOOR (MAX (TEXT-%WIDTH TEXT)
                                    (- (BUTTON-WIDTH
 BUTTON)
                                       (MARGINS-LEFT MARGINS)
                                       (MARGINS-RIGHT MARGINS)))
                               2)))
            ((:LEFT-BOTTOM :LEFT-TOP) (MARGINS-LEFT MARGINS))
            ((:RIGHT-BOTTOM :RIGHT-TOP) (MARGINS-RIGHT MARGINS)))))

(DEFUN BUTTON-TEXT-Y-COORD
 (BUTTON)
   (LET ((TEXT (BUTTON-TEXT BUTTON))
         (MARGINS (BUTTON-TYPE-MARGINS (BUTTON-TYPE BUTTON))))
        (ECASE (TEXT-ALIGNMENT TEXT)
            (:CENTER (+ (MARGINS-BOTTOM MARGINS)
                        (FLOOR (MAX (TEXT-%HEIGHT TEXT)
                                    (- (BUTTON-HEIGHT
 BUTTON)
                                       (MARGINS-BOTTOM MARGINS)
                                       (MARGINS-TOP MARGINS)))
                               2)))
            ((:LEFT-BOTTOM :RIGHT-BOTTOM) (MARGINS-BOTTOM MARGINS))
            ((:LEFT-TOP :RIGHT-TOP) (MARGINS-TOP MARGINS)))))

(DEFUN TEXT-FROM-TEXT-FORM
 (TEXT-FORM &OPTIONAL DSP BUTTON)

(IL:* IL:|;;;| "return the text string for an updated button in WINDOW.")


   (TYPECASE TEXT-FORM
       (LIST (EVAL TEXT-FORM))

       (IL:* IL:|;;| "note: when an updated button is first created this is called with WINDOW=NIL.  text form functions are required to handle this condition gracefully. ")


       (T (FUNCALL TEXT-FORM DSP BUTTON))))

(DEFUN BUTTON-TRACK-MOUSE
 (BUTTON DSP)

(IL:* IL:|;;;| "a mouse key has gone down in BUTTON.  watch the mouse with button shaded 'til either the key goes up or the mouse leaves BUTTON.  if key went up then perform button action & return true.   ")


   (LET ((REGION (MAKE-REGION :LEFT 0 :BOTTOM 0 :WIDTH (BUTTON-WIDTH
 BUTTON)
                        :HEIGHT
                        (BUTTON-HEIGHT
 BUTTON)))
         (TIMER (IL:SETUPTIMER *BUTTON-HELP-DELAY*)))
        (UNWIND-PROTECT
            (PROGN (SHADE-BUTTON
 BUTTON DSP :REGION REGION)
                   (LOOP (IL:GETMOUSESTATE)
                         (UNLESS (IL:INSIDEP REGION (IL:LASTMOUSEX DSP)
                                        (IL:LASTMOUSEY DSP))
                                (RETURN))
                         (UNLESS (IL:LASTMOUSESTATE (OR IL:LEFT IL:MIDDLE))
                             (PERFORM-BUTTON-ACTION
 BUTTON DSP)

                             (IL:* IL:|;;| "return true if we performed action")


                             (RETURN T))
                         (WHEN (AND TIMER (IL:TIMEREXPIRED? TIMER))
                             (SETQ TIMER NIL)
                             (PRINT-BUTTON-HELP
 BUTTON))))
            (SHADE-BUTTON
 BUTTON DSP :REGION REGION :DESELECT T))))

(DEFUN PERFORM-BUTTON-ACTION
 (BUTTON DSP)
   (LET ((ACTION (BUTTON-ACTION BUTTON)))
        (TYPECASE ACTION
            (LIST (EVAL ACTION))
            (T (FUNCALL ACTION DSP BUTTON)))))

(DEFUN EDIT-BUTTON
 (BUTTON)
   (IL:ALLOW.BUTTON.EVENTS)
   (LET* ((EXTERNAL-FORM (EXTERNALIZE-BUTTON
 BUTTON T))
          (COPY (COPY-TREE EXTERNAL-FORM))
          (EDITED (WITH-PROFILE (FIND-PROFILE "XCL")
                         (IL:EDITE EXTERNAL-FORM NIL (TEXT-STRING (BUTTON-TEXT BUTTON))
                                NIL NIL :CLOSE-ON-COMPLETION))))
         (IF (EQUAL EDITED COPY)
             BUTTON
             (APPLY #'MAKE-BUTTON EDITED))))

(DEFUN BUTTON-COPY-SELECTED
 (BUTTON)
   (IF (FBOUNDP 'MAKE-BIO)

       (IL:* IL:|;;| "if ROOMS-BIO is loaded")


       (LET* ((DESTINATION (IL:WFROMDS (IL:PROCESS.TTY (IL:TTY.PROCESS))))
              (COPYINSERTFN (AND DESTINATION (IL:WINDOWPROP DESTINATION 'IL:COPYINSERTFN))))

             (IL:* IL:|;;| 

           "fake IL:COPYINSERT, but instead of punting to IL:BKSYSBUF punt to copying the window")


             (IF COPYINSERTFN
                 (FUNCALL COPYINSERTFN (MAKE-BIO (COPY-BUTTON
 BUTTON))
                        DESTINATION)
                 (MAKE-BUTTON-WINDOW
 (COPY-BUTTON
 BUTTON))))
       (MAKE-BUTTON-WINDOW
 (COPY-BUTTON
 BUTTON))))

(DEFUN SHADE-BUTTON
 (BUTTON DSP &KEY (REGION (MAKE-REGION :LEFT 0 :BOTTOM 0 :WIDTH (

                                                                                      BUTTON-WIDTH

                                                                                        BUTTON)
                                                        :HEIGHT
                                                        (BUTTON-HEIGHT
 BUTTON)))
                               DESELECT)

(IL:* IL:|;;;| "called when mouse key down in BUTTON.")


   (IL:* IL:|;;| "DESELECT? tells the intention of the call.")


   (IL:* IL:|;;| "see also DISPLAY-BUTTON")


   (LET ((MASK (BUTTON-%MASK BUTTON))
         (SELECTED? (BUTTON-%SELECTED? BUTTON)))
        (WHEN (EQ DESELECT SELECTED?)

            (IL:* IL:|;;| "invert MASK with *BUTTON-SELECTION-SHADE*")


            (IL:BITBLT MASK NIL NIL DSP 0 0 (REGION-WIDTH REGION)
                   (REGION-HEIGHT REGION)
                   (IF (NULL MASK)
                       'IL:TEXTURE
                       'IL:MERGE)
                   'IL:INVERT *BUTTON-SELECTION-SHADE*)

            (IL:* IL:|;;| "toggle SELECTED? bit")


            (SETF (BUTTON-%SELECTED? BUTTON)
                  (NOT SELECTED?)))))

(DEFUN PRINT-BUTTON-HELP
 (BUTTON)
   (NOTIFY-USER (OR (BUTTON-HELP-STRING BUTTON)
                    "No help provided for this button.")))



(IL:* IL:\; "button windows")



(DEFGLOBALVAR *BUTTON-HELP-DELAY*
 IL:MENUHELDWAIT)

(DEFPARAMETER *BUTTON-SELECTION-SHADE*
 32768)

(DEFUN MAKE-BUTTON-WINDOW
 (BUTTON &OPTIONAL POSITION)
   (LET* ((WIDTH (BUTTON-WIDTH
 BUTTON))
          (HEIGHT (BUTTON-HEIGHT
 BUTTON))
          (POSITION (OR (IL:POSITIONP POSITION)
                        (IL:GETBOXPOSITION WIDTH HEIGHT)))
          (WINDOW (IL:CREATEW (IL:CREATEREGION (POSITION-X POSITION)
                                     (POSITION-Y POSITION)
                                     WIDTH HEIGHT)
                         NIL 0)))
         (IL:WINDOWPROP WINDOW 'BUTTON BUTTON)
         (IL:WINDOWPROP WINDOW 'IL:BUTTONEVENTFN 'BW-BUTTONEVENTFN)
         (IL:WINDOWPROP WINDOW 'IL:AFTERMOVEFN 'BW-REPAINTFN)
         (IL:WINDOWPROP WINDOW 'IL:OPENFN 'BW-REPAINTFN)
         (IL:WINDOWPROP WINDOW 'IL:TOTOPFN 'BW-TOTOPFN)
         (IL:WINDOWPROP WINDOW 'IL:REPAINTFN 'BW-REPAINTFN)
         (IL:WINDOWPROP WINDOW 'IL:RESHAPEFN 'IL:DON\'T)
         (IL:WINDOWPROP WINDOW 'IL:SHRINKFN 'IL:DON\'T)
         (WHEN (BUTTON-PROP
 BUTTON :PROTECTED?)
             (IL:WINDOWPROP WINDOW 'IL:RIGHTBUTTONFN 'IL:TOTOPW))
         (BW-REPAINTFN
 WINDOW)
         WINDOW))

(DEFUN BW-REPAINTFN
 (WINDOW &REST REST &KEY NO-UPDATE)
   (DECLARE
 (IGNORE REST))
   (IL:TOTOPW WINDOW T)
   (LET* ((BUTTON (IL:WINDOWPROP WINDOW 'BUTTON))
          (DSP (IL:WINDOWPROP WINDOW 'IL:DSP))
          (TYPE (BUTTON-TYPE BUTTON)))
         (UNLESS NO-UPDATE
             (WHEN (UPDATED-BUTTON-P BUTTON)
                   (UPDATE-BUTTON
 BUTTON)))
         (LET ((WIDTH (BUTTON-WIDTH
 BUTTON))
               (HEIGHT (BUTTON-HEIGHT
 BUTTON)))
              (MAYBE-RESIZE-BUTTON-WINDOW
 WINDOW BUTTON WIDTH HEIGHT)
              (IF (AND (BUTTON-TYPE-IMAGE-BITMAP TYPE)
                       (NOT (BUTTON-TYPE-MASK-BITMAP TYPE)))

                  (IL:* IL:|;;| "OK to clear - don't care what's behind ")


                  (IL:CLEARW WINDOW)

                  (IL:* IL:|;;| "copy what's behind the window through ")


                  (IL:BITBLT (IL:WINDOWPROP WINDOW 'IL:IMAGECOVERED)
                         0 0 DSP 0 0 WIDTH HEIGHT 'IL:INPUT 'IL:REPLACE))
              (DISPLAY-BUTTON
 BUTTON DSP :NO-UPDATE T :WIDTH WIDTH :HEIGHT HEIGHT))))

(DEFUN BW-TOTOPFN
 (WINDOW)

   (IL:* IL:|;;| "called when window is un-hidden or brought to top")


   (LET ((BUTTON (IL:WINDOWPROP WINDOW 'BUTTON)))
        (WHEN (BUTTON-P BUTTON)
            (WHEN (OR 
                      (IL:* IL:|;;| "needs redisplay because of update")


                      (UPDATE-BUTTON
 BUTTON)

                      (IL:* IL:|;;| "or it has a mask & needs background copied through")


                      (BUTTON-TYPE-MASK-BITMAP (BUTTON-TYPE BUTTON))

                      (IL:* IL:|;;| 

         "or it has no mask and no image, i.e. it's transparent & needs background copied through.")


                      (NULL (BUTTON-TYPE-IMAGE-BITMAP (BUTTON-TYPE BUTTON))))
                  (BW-REPAINTFN
 WINDOW :NO-UPDATE T)))))

(DEFUN BW-BUTTONEVENTFN
 (WINDOW)
   (LET ((BUTTON (IL:WINDOWPROP WINDOW 'BUTTON)))
        (IF (IL:MOUSESTATE IL:MIDDLE)
            (COND
               ((BUTTON-PROP
 BUTTON :PROTECTED?)
                (BW-BUTTONEVENTFN-INTERNAL
 BUTTON WINDOW))
               ((EDIT-KEY-DOWN-P)
                (EDIT-BUTTON-WINDOW
 BUTTON WINDOW))
               ((COPY-KEY-DOWN-P)
                (BUTTON-COPY-SELECTED
 BUTTON))
               ((MOVE-KEY-DOWN-P)
                (IL:MOVEW WINDOW))
               ((DELETE-KEY-DOWN-P)
                (IF (FBOUNDP 'INTERACTIVE-CLOSE-WINDOW)
                    (INTERACTIVE-CLOSE-WINDOW WINDOW)
                    (CLOSE-WINDOW WINDOW)))
               ((HELP-KEY-DOWN-P)
                (PRINT-BUTTON-HELP
 BUTTON))
               (T (BW-BUTTONEVENTFN-INTERNAL
 BUTTON WINDOW)))
            (BW-BUTTONEVENTFN-INTERNAL
 BUTTON WINDOW))))

(DEFUN BW-BUTTONEVENTFN-INTERNAL
 (WINDOW BUTTON)
   (LET ((WINDOW WINDOW)
         (BUTTON BUTTON))
        (LOOP (WHEN (BUTTON-P BUTTON)
                  (IL:TOTOPW WINDOW)
                  (WHEN (BUTTON-TRACK-MOUSE
 BUTTON WINDOW)
                      (WHEN (UPDATE-BUTTON
 BUTTON)

                          (IL:* IL:|;;| "button's action caused it to need redisplay")


                          (BW-REPAINTFN
 WINDOW :NO-UPDATE T))
                      (RETURN)))
              (UNLESS (IL:MOUSESTATE (OR IL:LEFT IL:MIDDLE))
                     (RETURN))
              (SETQ WINDOW (IL:WHICHW))
              (SETQ BUTTON (WHEN WINDOW
                               (IL:WINDOWPROP WINDOW 'BUTTON))))))

(DEFUN SET-BUTTON-WINDOW-TEXT-STRING
 (WINDOW STRING)

(IL:* IL:|;;;| "note: this does everything but the redisplay.")


   (LET ((BUTTON (IL:WINDOWPROP WINDOW 'BUTTON)))
        (SET-BUTTON-TEXT-STRING
 BUTTON STRING)
        (MAYBE-RESIZE-BUTTON-WINDOW
 WINDOW BUTTON)))

(DEFUN MAYBE-RESIZE-BUTTON-WINDOW
 (WINDOW BUTTON &OPTIONAL (WIDTH (BUTTON-WIDTH
 BUTTON))
                                             (HEIGHT (BUTTON-HEIGHT
 BUTTON)))
   (LET ((OLD-REGION (WINDOW-REGION WINDOW)))
        (UNLESS (AND (= WIDTH (REGION-WIDTH OLD-REGION))
                     (= HEIGHT (REGION-HEIGHT OLD-REGION)))
            (UNWIND-PROTECT
                (PROGN (IL:TOTOPW WINDOW T)
                       (IL:WINDOWPROP WINDOW 'IL:RESHAPEFN 'IL:NILL)
                       (IL:SHAPEW1 WINDOW (MAKE-REGION :LEFT (REGION-LEFT OLD-REGION)
                                                 :BOTTOM
                                                 (REGION-BOTTOM OLD-REGION)
                                                 :WIDTH WIDTH :HEIGHT HEIGHT))

                       (IL:* IL:|;;| "return true if we shaped")


                       T)
                (IL:WINDOWPROP WINDOW 'IL:RESHAPEFN 'IL:DON\'T)))))

(DEFUN BW-SCREEN-CHANGED-FUNCTION
 ()
   (LET ((OLD-DEFAULT-FONT *DEFAULT-TEXT-FONT*)
         (NEW-DEFAULT-FONT (SET-DEFAULT-TEXT-FONT)))
        (UNLESS (EQ OLD-DEFAULT-FONT NEW-DEFAULT-FONT)
            (DOLIST (WINDOW (ALL-WINDOWS T))
                (LET ((BUTTON (IL:WINDOWPROP WINDOW 'BUTTON)))
                     (WHEN (AND (BUTTON-P BUTTON)
                                (EQ OLD-DEFAULT-FONT (TEXT-FONT (BUTTON-TEXT BUTTON))))

                         (IL:* IL:|;;| "upgrade buttons with default font")


                         (SETF (TEXT-FONT (BUTTON-TEXT BUTTON))
                               NEW-DEFAULT-FONT)
                         (UPDATE-TEXT-CACHES (BUTTON-TEXT BUTTON))
                         (COMPUTE-BUTTON-TEXT-POSITION
 BUTTON)

                         (IL:* IL:|;;| "force redisplay")


                         (SETF (BUTTON-%IMAGE BUTTON)
                               NIL)
                         (SETF (BUTTON-%MASK BUTTON)
                               NIL)))))))

(DEFGLOBALVAR *SCREEN-CHANGED-FUNCTIONS*
 (LIST '%INTERNALIZE-ALL-PLACEMENTS))

(PUSHNEW 'BW-SCREEN-CHANGED-FUNCTION *SCREEN-CHANGED-FUNCTIONS*)



(IL:* IL:\; "button bitmaps")



(DEFSTRUCT (NORTH-SOUTH-BITMAP
 (:CONC-NAME "NS-BITMAP-"))
   NORTH
   CENTER
   SOUTH)

(DEFSTRUCT (EAST-WEST-BITMAP
 (:CONC-NAME "EW-BITMAP-"))
   EAST
   CENTER
   WEST)

(DEFSTRUCT NSEW-BITMAP

   NORTH
   NW
   NE
   SOUTH
   SW
   SE
   EAST
   CENTER
   WEST)

(DEFUN DISPLAY-BUTTON-IMAGE
 (BUTTON DSP WIDTH HEIGHT)
   (LET ((CACHED-IMAGE (BUTTON-%IMAGE BUTTON))
         (INVERTED? (BUTTON-INVERTED? BUTTON))
         (MASK? (BUTTON-%MASK BUTTON)))
        (UNLESS CACHED-IMAGE
            (SETQ CACHED-IMAGE (IL:BITMAPCREATE WIDTH HEIGHT))
            (LET ((TYPE-IMAGE (BUTTON-TYPE-IMAGE-BITMAP (BUTTON-TYPE BUTTON))))
                 (WHEN TYPE-IMAGE (BUTTON-BITMAP-BITBLT
 TYPE-IMAGE CACHED-IMAGE WIDTH HEIGHT)))
            (DISPLAY-TEXT (BUTTON-TEXT BUTTON)
                   CACHED-IMAGE)
            (SETF (BUTTON-%IMAGE BUTTON)
                  CACHED-IMAGE))
        (IL:BITBLT CACHED-IMAGE 0 0 DSP 0 0 WIDTH HEIGHT (IF (AND INVERTED? (NOT MASK?))
                                                             'IL:INVERT
                                                             'IL:SOURCE)
               (IF (AND INVERTED? MASK?)
                   'IL:INVERT
                   'IL:PAINT))))

(DEFUN DISPLAY-BUTTON-MASK
 (BUTTON DSP WIDTH HEIGHT)
   (LET ((CACHED-MASK (BUTTON-%MASK BUTTON)))
        (UNLESS CACHED-MASK
            (SETQ CACHED-MASK (IL:BITMAPCREATE WIDTH HEIGHT))
            (LET ((TYPE-MASK (BUTTON-TYPE-MASK-BITMAP (BUTTON-TYPE BUTTON))))
                 (WHEN TYPE-MASK (BUTTON-BITMAP-BITBLT
 TYPE-MASK CACHED-MASK WIDTH HEIGHT)))
            (DISPLAY-TEXT (BUTTON-TEXT BUTTON)
                   CACHED-MASK :MASK-ONLY T)
            (SETF (BUTTON-%MASK BUTTON)
                  CACHED-MASK))
        (IL:BITBLT CACHED-MASK 0 0 DSP 0 0 WIDTH HEIGHT 'IL:SOURCE (IF (BUTTON-INVERTED? BUTTON)
                                                                       'IL:PAINT
                                                                       'IL:ERASE))))

(DEFUN BUTTON-WIDTH
 (BUTTON)
   (LET* ((BUTTON-TYPE (BUTTON-TYPE BUTTON))
          (MARGINS (BUTTON-TYPE-MARGINS BUTTON-TYPE))
          (BITMAP (BUTTON-TYPE-IMAGE-BITMAP BUTTON-TYPE))
          (TEXT-WIDTH (TEXT-%WIDTH (BUTTON-TEXT BUTTON))))
         (ETYPECASE BITMAP
             (BITMAP (IL:BITMAPWIDTH BITMAP))
             (NULL TEXT-WIDTH)
             (NORTH-SOUTH-BITMAP (IL:BITMAPWIDTH (NS-BITMAP-NORTH BITMAP)))
             ((OR NSEW-BITMAP EAST-WEST-BITMAP) (LET* ((WIDTH (+ TEXT-WIDTH (MARGINS-LEFT MARGINS)
                                                                 (MARGINS-RIGHT MARGINS)))
                                                       (EAST-WIDTH (IL:BITMAPWIDTH
                                                                    (TYPECASE BITMAP
                                                                        (NSEW-BITMAP (
                                                                                     NSEW-BITMAP-EAST
                                                                                      BITMAP))
                                                                        (EAST-WEST-BITMAP 
                                                                           (EW-BITMAP-EAST BITMAP))))
                                                              )
                                                       (CENTER-WIDTH
                                                        (IL:BITMAPWIDTH (TYPECASE BITMAP
                                                                            (NSEW-BITMAP 
                                                                               (NSEW-BITMAP-CENTER
                                                                                BITMAP))
                                                                            (EAST-WEST-BITMAP 
                                                                               (EW-BITMAP-CENTER
                                                                                BITMAP)))))
                                                       (WEST-WIDTH (IL:BITMAPWIDTH
                                                                    (TYPECASE BITMAP
                                                                        (NSEW-BITMAP (
                                                                                     NSEW-BITMAP-WEST
                                                                                      BITMAP))
                                                                        (EAST-WEST-BITMAP 
                                                                           (EW-BITMAP-WEST BITMAP))))
                                                              ))

                                 (IL:* IL:|;;| "we could use WIDTH directly but we'd rather tile in an even number of CENTER bitmaps, in case it's a pattern that needs to blend with the EAST and WEST.")


                                                      (MAX (+ WIDTH
                                                              (- CENTER-WIDTH
                                                                 (MOD (- WIDTH EAST-WIDTH WEST-WIDTH)
                                                                      CENTER-WIDTH)))
                                                           (+ EAST-WIDTH WEST-WIDTH)))))))

(DEFUN BUTTON-HEIGHT
 (BUTTON)
   (LET* ((BUTTON-TYPE (BUTTON-TYPE BUTTON))
          (MARGINS (BUTTON-TYPE-MARGINS BUTTON-TYPE))
          (BITMAP (BUTTON-TYPE-IMAGE-BITMAP BUTTON-TYPE))
          (TEXT-HEIGHT (TEXT-%HEIGHT (BUTTON-TEXT BUTTON))))
         (ETYPECASE BITMAP
             (BITMAP (IL:BITMAPHEIGHT BITMAP))
             (NULL TEXT-HEIGHT)
             (EAST-WEST-BITMAP (IL:BITMAPHEIGHT (EW-BITMAP-EAST BITMAP)))
             ((OR NSEW-BITMAP NORTH-SOUTH-BITMAP) (LET* ((HEIGHT (+ TEXT-HEIGHT (MARGINS-BOTTOM
                                                                                 MARGINS)
                                                                    (MARGINS-TOP MARGINS)))
                                                         (NORTH-HEIGHT
                                                          (IL:BITMAPHEIGHT (TYPECASE BITMAP
                                                                               (NSEW-BITMAP 
                                                                                  (NSEW-BITMAP-NORTH
                                                                                   BITMAP))
                                                                               (NORTH-SOUTH-BITMAP 
                                                                                  (NS-BITMAP-NORTH
                                                                                   BITMAP)))))
                                                         (CENTER-HEIGHT
                                                          (IL:BITMAPHEIGHT (TYPECASE BITMAP
                                                                               (NSEW-BITMAP 
                                                                                  (NSEW-BITMAP-CENTER
                                                                                   BITMAP))
                                                                               (NORTH-SOUTH-BITMAP 
                                                                                  (NS-BITMAP-CENTER
                                                                                   BITMAP)))))
                                                         (SOUTH-HEIGHT
                                                          (IL:BITMAPHEIGHT (TYPECASE BITMAP
                                                                               (NSEW-BITMAP 
                                                                                  (NSEW-BITMAP-SOUTH
                                                                                   BITMAP))
                                                                               (NORTH-SOUTH-BITMAP 
                                                                                  (NS-BITMAP-SOUTH
                                                                                   BITMAP))))))

                                 (IL:* IL:|;;| "we could use HEIGHT directly but we'd rather tile in an even number of CENTER bitmaps, in case it's a pattern that needs to blend with the EAST and WEST.")


                                                        (MAX (+ HEIGHT
                                                                (- CENTER-HEIGHT
                                                                   (MOD (- HEIGHT NORTH-HEIGHT 
                                                                           SOUTH-HEIGHT)
                                                                        CENTER-HEIGHT)))
                                                             (+ NORTH-HEIGHT SOUTH-HEIGHT)))))))

(DEFUN BUTTON-BITMAP-BITBLT
 (BITMAP DESTINATION WIDTH HEIGHT)
   (ETYPECASE BITMAP
       (BITMAP (IL:BITBLT BITMAP 0 0 DESTINATION 0 0 WIDTH HEIGHT))
       (EAST-WEST-BITMAP (EW-BITBLT
 (EW-BITMAP-WEST BITMAP)
                                (EW-BITMAP-CENTER BITMAP)
                                (EW-BITMAP-EAST BITMAP)
                                DESTINATION WIDTH 0))
       (NORTH-SOUTH-BITMAP (NS-BITBLT
 (NS-BITMAP-SOUTH BITMAP)
                                  (NS-BITMAP-CENTER BITMAP)
                                  (NS-BITMAP-NORTH BITMAP)
                                  DESTINATION HEIGHT 0))
       (NSEW-BITMAP (NSEW-BITBLT
 BITMAP DESTINATION WIDTH HEIGHT))))

(DEFUN EW-BITBLT
 (WEST CENTER EAST DESTINATION WIDTH BOTTOM)
   (LET* ((WEST-WIDTH (IL:BITMAPWIDTH WEST))
          (CENTER-WIDTH (IL:BITMAPWIDTH CENTER))
          (EAST-WIDTH (IL:BITMAPWIDTH EAST))
          (EAST-LEFT (- WIDTH EAST-WIDTH))
          (HEIGHT (IL:BITMAPHEIGHT CENTER)))

         (IL:* IL:|;;| "blt the west bitmap down the left ")


         (IL:BITBLT WEST 0 0 DESTINATION 0 BOTTOM WEST-WIDTH HEIGHT)
         (WHEN (> EAST-LEFT WEST-WIDTH)

             (IL:* IL:|;;| "blt in one copy of center")


             (IL:BITBLT CENTER 0 0 DESTINATION WEST-WIDTH BOTTOM CENTER-WIDTH HEIGHT)
             (DO* ((WIDTH CENTER-WIDTH (+ WIDTH WIDTH))
                   (LEFT (+ WEST-WIDTH WIDTH)
                         (+ WEST-WIDTH WIDTH)))
                  ((>= LEFT EAST-LEFT))

                (IL:* IL:|;;| "blt the center bitmap across the middle")


                (IL:BITBLT DESTINATION WEST-WIDTH BOTTOM DESTINATION LEFT BOTTOM
                       (MIN WIDTH (- EAST-LEFT LEFT))
                       HEIGHT)))

         (IL:* IL:|;;| "blt the east bitmap on the right end")


         (IL:BITBLT EAST 0 0 DESTINATION EAST-LEFT BOTTOM EAST-WIDTH HEIGHT)))

(DEFUN NS-BITBLT
 (SOUTH CENTER NORTH DESTINATION HEIGHT LEFT &OPTIONAL (DO-ENDS? T))
   (LET* ((SOUTH-HEIGHT (IL:BITMAPHEIGHT SOUTH))
          (CENTER-HEIGHT (IL:BITMAPHEIGHT CENTER))
          (NORTH-HEIGHT (IL:BITMAPHEIGHT NORTH))
          (NORTH-BOTTOM (- HEIGHT NORTH-HEIGHT))
          (WIDTH (IL:BITMAPWIDTH CENTER)))
         (WHEN DO-ENDS?

             (IL:* IL:|;;| "blt the south bitmap across the bottom")


             (IL:BITBLT SOUTH 0 0 DESTINATION LEFT 0 WIDTH SOUTH-HEIGHT))
         (WHEN (> NORTH-BOTTOM SOUTH-HEIGHT)

             (IL:* IL:|;;| "blt in one copy of center")


             (IL:BITBLT CENTER 0 0 DESTINATION LEFT SOUTH-HEIGHT WIDTH CENTER-HEIGHT)
             (DO* ((HEIGHT CENTER-HEIGHT (+ HEIGHT HEIGHT))
                   (BOTTOM (+ SOUTH-HEIGHT HEIGHT)
                          (+ SOUTH-HEIGHT HEIGHT)))
                  ((>= BOTTOM NORTH-BOTTOM))

                (IL:* IL:|;;| "blt the center bitmap up the middle")


                (IL:BITBLT DESTINATION LEFT SOUTH-HEIGHT DESTINATION LEFT BOTTOM WIDTH
                       (MIN HEIGHT (- NORTH-BOTTOM BOTTOM)))))
         (WHEN DO-ENDS?

             (IL:* IL:|;;| "blt the north bitmap across the top")


             (IL:BITBLT NORTH 0 0 DESTINATION LEFT NORTH-BOTTOM WIDTH NORTH-HEIGHT))))

(DEFUN NSEW-BITBLT
 (NSEW-BITMAP DESTINATION WIDTH HEIGHT)
   (LET* ((SW (NSEW-BITMAP-SW NSEW-BITMAP))
          (SE (NSEW-BITMAP-SE NSEW-BITMAP))
          (NW (NSEW-BITMAP-NW NSEW-BITMAP))
          (NE (NSEW-BITMAP-NE NSEW-BITMAP))
          (NORTH-BOTTOM (- HEIGHT (IL:BITMAPHEIGHT NW)))
          (EAST-LEFT (- WIDTH (IL:BITMAPWIDTH SE))))

         (IL:* IL:|;;| "across the bottom")


         (EW-BITBLT
 SW (NSEW-BITMAP-SOUTH NSEW-BITMAP)
                SE DESTINATION WIDTH 0)

         (IL:* IL:|;;| "across the top")


         (EW-BITBLT
 NW (NSEW-BITMAP-NORTH NSEW-BITMAP)
                NE DESTINATION WIDTH NORTH-BOTTOM)

         (IL:* IL:|;;| "up the left")


         (NS-BITBLT
 SW (NSEW-BITMAP-WEST NSEW-BITMAP)
                NW DESTINATION HEIGHT 0 NIL)

         (IL:* IL:|;;| "up the right")


         (NS-BITBLT
 SE (NSEW-BITMAP-EAST NSEW-BITMAP)
                NE DESTINATION HEIGHT EAST-LEFT NIL)

         (IL:* IL:|;;| "tile the center")


         (PAINT-REGION
 DESTINATION (LET ((LEFT (IL:BITMAPWIDTH SW))
                                             (BOTTOM (IL:BITMAPHEIGHT SW)))
                                            (MAKE-REGION :LEFT LEFT :BOTTOM BOTTOM :WIDTH
                                                   (- EAST-LEFT LEFT)
                                                   :HEIGHT
                                                   (- NORTH-BOTTOM BOTTOM)))
                (NSEW-BITMAP-CENTER NSEW-BITMAP))))

(DEFUN PAINT-REGION
 (DESTINATION REGION SHADE &OPTIONAL CLIPPING-REGION)

   (IL:* IL:|;;| "fill REGION of DESTINATION with SHADE")


   (TYPECASE SHADE
       (BITMAP 

          (IL:* IL:|;;| "tile the bitmap within REGION")


          (LET* ((REGION-LEFT (REGION-LEFT REGION))
                 (REGION-BOTTOM (REGION-BOTTOM REGION))
                 (REGION-WIDTH (REGION-WIDTH REGION))
                 (REGION-HEIGHT (REGION-HEIGHT REGION))
                 (BITMAP-WIDTH (IL:BITMAPWIDTH SHADE))
                 (BITMAP-HEIGHT (IL:BITMAPHEIGHT SHADE))
                 (REGION-RIGHT (+ REGION-LEFT REGION-WIDTH))
                 (REGION-TOP (+ REGION-BOTTOM REGION-HEIGHT))
                 (CLIPPING-REGION (IF CLIPPING-REGION
                                      (IL:INTERSECTREGIONS CLIPPING-REGION REGION)
                                      REGION)))

                (IL:* IL:|;;| "blt in one copy in lower left corner")


                (IL:BITBLT SHADE 0 0 DESTINATION REGION-LEFT REGION-BOTTOM BITMAP-WIDTH BITMAP-HEIGHT
                       NIL NIL NIL CLIPPING-REGION)

                (IL:* IL:|;;| "blt across bottom, doubling size each time")


                (LET ((LEFT BITMAP-WIDTH))
                     (LOOP (WHEN (>= LEFT REGION-RIGHT)
                                 (RETURN))
                           (IL:BITBLT DESTINATION REGION-LEFT REGION-BOTTOM DESTINATION
                                  (+ LEFT REGION-LEFT)
                                  REGION-BOTTOM LEFT BITMAP-HEIGHT NIL NIL NIL CLIPPING-REGION)
                           (SETF LEFT (+ LEFT LEFT))))

                (IL:* IL:|;;| "blt up, doubling size each time")


                (LET ((BOTTOM BITMAP-HEIGHT))
                     (LOOP (WHEN (>= BOTTOM REGION-TOP)
                                 (RETURN))
                           (IL:BITBLT DESTINATION REGION-LEFT REGION-BOTTOM DESTINATION REGION-LEFT
                                  (+ REGION-BOTTOM BOTTOM)
                                  REGION-WIDTH BOTTOM NIL NIL NIL CLIPPING-REGION)
                           (SETF BOTTOM (+ BOTTOM BOTTOM))))))
       (TEXTURE 

          (IL:* IL:|;;| "squirt the texture onto the screen within REGION")


          (IL:BLTSHADE SHADE DESTINATION (REGION-LEFT REGION)
                 (REGION-BOTTOM REGION)
                 (REGION-WIDTH REGION)
                 (REGION-HEIGHT REGION)
                 NIL CLIPPING-REGION))))



(IL:* IL:\; "externalization")



(DEFUN EDIT-BUTTON-WINDOW
 (BUTTON WINDOW)
   (UNLESS (IL:WINDOWPROP WINDOW 'BUTTON-BEING-EDITED)
       (UNWIND-PROTECT
           (PROGN (IL:WINDOWPROP WINDOW 'BUTTON-BEING-EDITED T)
                  (LET ((NEW-BUTTON (EDIT-BUTTON
 BUTTON)))
                       (UNLESS (EQ BUTTON NEW-BUTTON)
                           (IL:WINDOWPROP WINDOW 'BUTTON NEW-BUTTON)
                           (BW-REPAINTFN
 WINDOW))))
           (IL:REMWINDOWPROP WINDOW 'BUTTON-BEING-EDITED))))

(DEFUN EXTERNALIZE-BUTTON
 (BUTTON &OPTIONAL VERBOSE)

(IL:* IL:|;;;| "returns a property list to which MAKE-BUTTON can be applied")


   (LET* ((TEXT (BUTTON-TEXT BUTTON))
          (TYPE (BUTTON-TYPE BUTTON))
          (TYPE-NAME (BUTTON-TYPE-NAME TYPE))
          (SHADOWS (TEXT-SHADOWS TEXT))
          (FONT (TEXT-FONT TEXT))
          (INVERTED? (BUTTON-INVERTED? BUTTON)))
         `(,@(ETYPECASE BUTTON
                 (UPDATED-BUTTON `(:TEXT-FORM ,(UPDATED-BUTTON-TEXT-FORM BUTTON)))
                 (BUTTON `(:TEXT ,(TEXT-STRING TEXT))))
           :ACTION
           ,(COPY-TREE (BUTTON-ACTION BUTTON))
           :HELP
           ,(BUTTON-HELP-STRING BUTTON)
           ,@(WHEN (OR VERBOSE (NOT (EQ FONT *DEFAULT-TEXT-FONT*)))
                 (LIST :FONT (EXTERNALIZE-FONT
 FONT)))
           ,@(WHEN (OR VERBOSE (NOT (EQUAL SHADOWS (GETF (BUTTON-TYPE-PROPS TYPE)
                                                         :DEFAULT-SHADOWS *DEFAULT-BUTTON-SHADOWS*)))
                       )
                 (LIST :SHADOWS (EXTERNALIZE-TEXT-SHADOWS SHADOWS)))
           ,@(WHEN (OR (NULL TYPE-NAME)
                       VERBOSE
                       (NOT (EQUAL TYPE-NAME *DEFAULT-BUTTON-TYPE*)))
                 (LIST :TYPE (IF (NULL TYPE-NAME)
                                 TYPE
                                 TYPE-NAME)))
           ,@(WHEN (OR VERBOSE INVERTED?)
                   (LIST :INVERTED? INVERTED?))
           ,@(COPY-TREE (BUTTON-PROPS BUTTON)))))

(DEFUN EXTERNALIZE-FONT
 (FONT)
   (LIST (IL:FONTPROP FONT 'IL:FAMILY)
         (IL:FONTPROP FONT 'IL:SIZE)
         (IL:FONTPROP FONT 'IL:FACE)))

(DEFUN WITH-BUTTON
 (ACTION TEXT HELP)
   (IF (COPY-KEY-DOWN-P)
       (PROG1 NIL
           (MAKE-BUTTON-WINDOW
 (MAKE-BUTTON
 :TYPE *DEFAULT-BUTTON-TYPE* :TEXT TEXT :HELP HELP
                                          :ACTION ACTION)
                  TEXT HELP))
       (EVAL ACTION)))

(DEF-BUTTON-TYPE :DOOR
 :IMAGE #*(59 99)OOOOOOOOOOOOOON@OOOOOOOOOOOOOON@OOOOOOOOOOOOOON@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@OOOOL@OOOOL@N@L@OOOOL@OOOOL@N@L@L@@@L@L@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@OOOLL@OOONL@N@L@OOOOL@OOOOL@N@L@OOOOL@OOOOL@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@OOOOL@OOOOL@N@L@OOOOL@OOOOL@N@L@L@@@L@L@@@L@N@L@LBBBL@LBBBL@N@L@N@@@L@N@@CO@N@L@NHHHL@NHHGGHN@L@N@@@L@N@@NCLN@L@NBBBL@NBBLCLN@L@N@@@L@N@@NGLN@L@NHHHL@NHHOOLN@L@N@@@L@N@@OOLN@L@NBBBL@NBBGOHN@L@N@@@L@N@@CO@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@NBBBL@NBBBL@N@L@N@@@L@N@@@L@N@L@NHHHL@NHHHL@N@L@N@@@L@N@@@L@N@L@OOOLL@OOOHL@N@L@OOOOL@OOOOL@N@L@OOOOL@OOOOL@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@L@@@@@@@@@@@@@N@OOOOOOOOOOOOOON@OOOOOOOOOOOOOON@
   :MASK NIL
   :MARGINS (2 18 3 2)
   :DEFAULT-SHADOWS NIL)

(DEF-BUTTON-TYPE :SHADOWED
 :IMAGE #S(NSEW-BITMAP NORTH #*(2 4)L@@@L@@@@@@@@@@@ NW #*(5 4)CH@@GH@@N@@@L@@@ NE 
#*(7 4)O@@@OH@@CL@@AN@@ SOUTH #*(2 6)@@@@L@@@L@@@D@@@H@@@L@@@ SW #*(5 6)N@@@OH@@GH@@C@@@AH@@@H@@ SE 
#*(7 6)GJ@@OF@@OJ@@EN@@JL@@OH@@ EAST #*(7 2)CF@@CJ@@ CENTER #*(2 2)@@@@@@@@ WEST #*(5 2)L@@@L@@@)
   :MASK #S(NSEW-BITMAP NORTH #*(2 4)L@@@L@@@L@@@L@@@ NW #*(5 4)CH@@GH@@OH@@OH@@ NE #*(7 4)O@@@OH@@OL@@ON@@ SOUTH 
#*(2 6)L@@@L@@@L@@@D@@@H@@@L@@@ SW #*(5 6)OH@@OH@@GH@@C@@@AH@@@H@@ SE #*(7 6)OJ@@OF@@OJ@@EN@@JL@@OH@@ EAST 
#*(7 2)OF@@OJ@@ CENTER #*(2 2)L@@@L@@@ WEST #*(5 2)OH@@OH@@)
   :MARGINS (3 5 7 3))

(DEF-BUTTON-TYPE :TRANSPARENT
 :IMAGE NIL
   :MASK NIL
   :MARGINS (0 0 0 0)
   :DEFAULT-SHADOWS T)

(DEF-BUTTON-TYPE :PORTHOLE
 :IMAGE #S(NSEW-BITMAP NORTH #*(15 36)OOONOOON@@@@@@@@L@@FN@@NG@ALCHAHCHAHGHALOH@NO@@FN@@B@@@@@@@@OOONOOON@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ NW 
#*(36 36)@@@@@@@CO@@@@@@@@@GOO@@@@@@@@AON@@@@@@@@@OL@@@@@@@@@CO@@C@@@@@@@GH@@G@@@@@@AN@@@N@@@@@@CL@@@L@@@@@@G@O@@L@@@@@@NAOH@N@@@@@ALCIL@G@@@@@CHC@N@C@@@@@G@C@N@A@@@@@N@CIN@@@@@@AL@AON@@@@@@CH@@OLCO@@@@C@@@GIOO@@@@G@@@@CO@@@@@NCL@@OL@@@@@LGN@AO@@@@@ALNG@CL@@@@@AHLCHGH@@@@@AHLCHO@@@@@@CHNGIN@@@@@@C@GOKL@@@@@@G@COCH@@@@@@F@ANG@@@@@@@F@@@G@@@@@@@F@@@N@@@@@@@F@@@N@@@@@@@N@@AL@@@@@@@L@@AL@@@@@@@LCLAH@@@@@@@LGNAH@@@@@@@LNGAH@@@@@@@LLCIH@@@@@@@ NE 
#*(36 36)OL@@@@@@@@@@OON@@@@@@@@@@GOH@@@@@@@@@@CO@@@@@@@@L@@OL@@@@@@@N@@AN@@@@@@@G@@@GH@@@@@@CH@@CL@@@@@@CHAN@N@@@@@@GHCO@G@@@@@@OHGCHCH@@@@@O@FALAL@@@@@N@FAL@N@@@@@@@GCL@G@@@@@@@COL@CH@@@@OHAOH@AL@@@@OO@O@@@L@@@@@GL@@GHN@@@@@AO@@OLG@@@@@@GHALNC@@@@@@ALAHGCH@@@@@@NAHGAH@@@@@@GALOAH@@@@@@CHOOAL@@@@@@ALGN@L@@@@@@@LCL@N@@@@@@@N@@@F@@@@@@@F@@@F@@@@@@@G@@@F@@@@@@@C@@@F@@@@@@@C@@@G@@@@@@@CH@@C@@@@@@@AHGHC@@@@@@@AHOLC@@@@@@@AILNC@@@@@@@AIHGC@@@ SOUTH 
#*(15 36)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OOONOOON@@@@@@@@L@@FN@@NG@ALCHAHCHAHGH@LOH@NO@@FN@@B@@@@@@@@OOONOOON SW 
#*(36 36)LLCIH@@@@@@@LNGIH@@@@@@@LGOIH@@@@@@@LCOAH@@@@@@@LANAH@@@@@@@N@@@L@@@@@@@F@@@L@@@@@@@F@@@N@@@@@@@F@@@F@@@@@@@F@CLG@@@@@@@G@GNC@@@@@@@C@NGCH@@@@@@CHLCIL@@@@@@AHLCHN@@@@@@AHNGHG@@@@@@ALGOHCH@@@@@@LCO@AN@@@@@@NAN@@OH@@@@@G@@@@CO@@@@@C@@@O@OO@@@@CH@AOHAO@@@@AL@CIL@@@@@@@N@C@N@@@@@@@G@C@N@C@@@@@CHCIN@G@@@@@ALAON@N@@@@@@N@OL@L@@@@@@G@GH@L@@@@@@CL@@@N@@@@@@AN@@@G@@@@@@@GH@@C@@@@@@@CO@@A@@@@@@@@OL@@@@@@@@@@AON@@@@@@@@@@GOO@@@@@@@@@@CO@@@ SE 
#*(36 36)@@@@AIHGC@@@@@@@AILOC@@@@@@@AHOOC@@@@@@@AHGNC@@@@@@@AHCLC@@@@@@@C@@@G@@@@@@@C@@@F@@@@@@@G@@@F@@@@@@@F@@@F@@@@@@@NCL@F@@@@@@@LGN@N@@@@@@ALNG@L@@@@@@CHLCIL@@@@@@G@LCIH@@@@@@N@NGIH@@@@@AL@GOKH@@@@@GH@COCH@@@@AO@@ANG@@@@@GL@@@@O@@@@OO@GH@@N@@@@OH@OL@AL@@@@@@ALN@CL@@@@@@AHG@GH@@@@L@AHG@O@@@@@N@ALOAN@@@@@G@@OOCL@@@@@CH@GNGH@@@@@CH@CLO@@@@@@GH@@CN@@@@@@OH@@GL@@@@@@O@@AO@@@@@@@N@@OL@@@@@@@@@COH@@@@@@@@GOL@@@@@@@@OON@@@@@@@@@OL@@@@@@@@@@ EAST 
#*(36 15)@@@@AIHGC@@@@@@@AILOC@@@@@@@AHOOC@@@@@@@AHGNC@@@@@@@AHCLC@@@@@@@AH@@C@@@@@@@AH@@C@@@@@@@AH@@C@@@@@@@AH@@C@@@@@@@AH@@C@@@@@@@AH@@C@@@@@@@AHGHC@@@@@@@AHOLC@@@@@@@AILNC@@@@@@@AIHGC@@@ CENTER 
#*(15 15)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ WEST #*(36 15)LLCIH@@@@@@@LNGIH@@@@@@@LGOIH@@@@@@@LCOAH@@@@@@@LANAH@@@@@@@L@@AH@@@@@@@L@@AH@@@@@@@L@@AH@@@@@@@L@@AH@@@@@@@L@@AH@@@@@@@L@@AH@@@@@@@LCLAH@@@@@@@LGNAH@@@@@@@LNGAH@@@@@@@LLCIH@@@@@@@)
   :MASK #S(NSEW-BITMAP NORTH #*(15 36)OOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOON@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ NW 
#*(36 36)@@@@@@@CO@@@@@@@@@GOO@@@@@@@@AOOO@@@@@@@@OOOO@@@@@@@COOOO@@@@@@@GOOOO@@@@@@AOOOOO@@@@@@COOOOO@@@@@@GOOOOO@@@@@@OOOOOO@@@@@AOOOOOO@@@@@COOOOOO@@@@@GOOOOOO@@@@@OOOOOOO@@@@AOOOOOOO@@@@COOOOOOO@@@@COOOOOOO@@@@GOOOOOO@@@@@OOOOOOL@@@@@OOOOOO@@@@@AOOOOOL@@@@@AOOOOOH@@@@@AOOOOO@@@@@@COOOON@@@@@@COOOOL@@@@@@GOOOOH@@@@@@GOOOO@@@@@@@GOOOO@@@@@@@GOOON@@@@@@@GOOON@@@@@@@OOOOL@@@@@@@OOOOL@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@ NE 
#*(36 36)OL@@@@@@@@@@OON@@@@@@@@@OOOH@@@@@@@@OOOO@@@@@@@@OOOOL@@@@@@@OOOON@@@@@@@OOOOOH@@@@@@OOOOOL@@@@@@OOOOON@@@@@@OOOOOO@@@@@@OOOOOOH@@@@@OOOOOOL@@@@@OOOOOON@@@@@OOOOOOO@@@@@OOOOOOOH@@@@OOOOOOOL@@@@OOOOOOOL@@@@@GOOOOON@@@@@AOOOOOO@@@@@@GOOOOO@@@@@@AOOOOOH@@@@@@OOOOOH@@@@@@GOOOOH@@@@@@COOOOL@@@@@@AOOOOL@@@@@@@OOOON@@@@@@@OOOON@@@@@@@GOOON@@@@@@@GOOON@@@@@@@COOON@@@@@@@COOOO@@@@@@@COOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@ SOUTH 
#*(15 36)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOONOOON SW 
#*(36 36)OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOL@@@@@@@GOOOL@@@@@@@GOOON@@@@@@@GOOON@@@@@@@GOOOO@@@@@@@GOOOO@@@@@@@COOOOH@@@@@@COOOOL@@@@@@AOOOON@@@@@@AOOOOO@@@@@@AOOOOOH@@@@@@OOOOON@@@@@@OOOOOOH@@@@@GOOOOOO@@@@@COOOOOOO@@@@COOOOOOO@@@@AOOOOOOO@@@@@OOOOOOO@@@@@GOOOOOO@@@@@COOOOOO@@@@@AOOOOOO@@@@@@OOOOOO@@@@@@GOOOOO@@@@@@COOOOO@@@@@@AOOOOO@@@@@@@GOOOO@@@@@@@COOOO@@@@@@@@OOOO@@@@@@@@AOOO@@@@@@@@@GOO@@@@@@@@@@CO@@@ SE 
#*(36 36)@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@COOOO@@@@@@@COOON@@@@@@@GOOON@@@@@@@GOOON@@@@@@@OOOON@@@@@@@OOOON@@@@@@AOOOOL@@@@@@COOOOL@@@@@@GOOOOH@@@@@@OOOOOH@@@@@AOOOOOH@@@@@GOOOOOH@@@@AOOOOOO@@@@@GOOOOOO@@@@OOOOOOON@@@@OOOOOOOL@@@@OOOOOOOL@@@@OOOOOOOH@@@@OOOOOOO@@@@@OOOOOON@@@@@OOOOOOL@@@@@OOOOOOH@@@@@OOOOOO@@@@@@OOOOON@@@@@@OOOOOL@@@@@@OOOOO@@@@@@@OOOOL@@@@@@@OOOOH@@@@@@@OOOL@@@@@@@@OON@@@@@@@@@OL@@@@@@@@@@ EAST 
#*(36 15)@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@@@@@AOOOO@@@ CENTER 
#*(15 15)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ WEST #*(36 15)OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@OOOOH@@@@@@@)
   :MARGINS (17 17 17 17)
   :DEFAULT-SHADOWS T)

(DEF-BUTTON-TYPE :ARK
 :IMAGE #S(NORTH-SOUTH-BITMAP NORTH #*(86 5)OOOOOOOOOOOOOOOOOOOOOL@@JBBBBBBBBBBBBBBBBBBBBL@@HHHHHHHHHHHHHHHHHHHHID@@JBBBBBBBBBBBBBBBBBBBCL@@HHHHHHHHHHHHHHHHHHHHOD@@ CENTER 
#*(86 2)JEEEEEEEEEEEEEEEEEEEEL@@HJJJJJJJJJJJJJJJJJJJOD@@ SOUTH #*(86 5)JMMMMMMMMMMMMMMMMMMMML@@IGGGGGGGGGGGGGGGGGGGGD@@KMMMMMMMMMMMMMMMMMMMML@@OGGGGGGGGGGGGGGGGGGGGD@@OOOOOOOOOOOOOOOOOOOOOL@@)
   :MARGINS (4 5 5 6)
   :DEFAULT-SHADOWS :ARK)

(DEF-BUTTON-TYPE :ROUND-ARK
 :IMAGE #*(74 24)@@@@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOH@@@@GAAAAAAAAAAAAAAF@@@AL@DDDDDDDDDDDDDEH@@A@EEEEEEEEEEEEEEAH@@BBJJJJJJJJJJJJJJJL@@BEEEEEEEEEEEEEEEED@@FJJJJJJJJJJJJJJJJJ@@DEEEEEEEEEEEEEEEEF@@FJJJJJJJJJJJJJJJJJ@@EEEEEEEEEEEEEEEEEF@@GJJJJJJJJJJJJJJJJJ@@EEEEEEEEEEEEEEEEEF@@GJJJJJJJJJJJJJJJJN@@EEEEEEEEEEEEEEEEEF@@GJJJJJJJJJJJJJJJKN@@CMEEEEEEEEEEEEEEFL@@CFJJJJJJJJJJJJJJOL@@AMMMMMMMMMMMMMMMKH@@@GGGGGGGGGGGGGGGN@@@@AOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
   :MASK #*(74 24)@@@@@@@@@@@@@@@@@@@@@AOOOOOOOOOOOOOOH@@@@GOOOOOOOOOOOOOON@@@AOOOOOOOOOOOOOOOOH@@AOOOOOOOOOOOOOOOOH@@COOOOOOOOOOOOOOOOL@@COOOOOOOOOOOOOOOOL@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@GOOOOOOOOOOOOOOOON@@COOOOOOOOOOOOOOOOL@@COOOOOOOOOOOOOOOOL@@AOOOOOOOOOOOOOOOOH@@@GOOOOOOOOOOOOOON@@@@AOOOOOOOOOOOOOOH@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
   :MARGINS (5 4 5 2)
   :DEFAULT-SHADOWS :ARK)

(DEF-BUTTON-TYPE :STRETCHY-ARK
 :IMAGE #S(NSEW-BITMAP NORTH #*(4 5)O@@@D@@@A@@@D@@@A@@@ NW #*(5 5)OH@@J@@@HH@@J@@@HH@@ NE 
#*(5 5)OH@@EH@@BH@@GH@@NH@@ SOUTH #*(4 5)K@@@N@@@K@@@N@@@O@@@ SW #*(5 5)JH@@I@@@KH@@O@@@OH@@ SE #*(5 5
)KH@@NH@@KH@@NH@@OH@@ EAST #*(5 4)KH@@NH@@KH@@NH@@ CENTER #*(4 4)J@@@E@@@J@@@E@@@ WEST #*(5 4)J@@@HH@@J@@@HH@@)
   :MARGINS (6 6 6 6)
   :DEFAULT-SHADOWS :ARK)

(DEF-BUTTON-TYPE :STRETCHY-ROUND-ARK
 :IMAGE #S(NSEW-BITMAP NORTH #*(4 6)O@@@D@@@A@@@E@@@J@@@E@@@ NW 
#*(7 6)@B@@@N@@CH@@B@@@DD@@DJ@@ NE #*(9 6)N@@@EH@@AF@@DF@@JK@@EE@@ SOUTH #*(4 6)J@@@E@@@J@@@G@@@M@@@O@@@ SW 
#*(7 6)OD@@GJ@@FL@@CJ@@@N@@@B@@ SE #*(9 6)JOH@EK@@KO@@FN@@OH@@N@@@ EAST #*(9 8)JJH@EEH@JJH@EEH@JJH@EEH@JJH@EEH@ CENTER 
#*(4 8)J@@@E@@@J@@@E@@@J@@@E@@@J@@@E@@@ WEST #*(7 8)OD@@JJ@@OD@@JJ@@OD@@JJ@@OD@@JJ@@)
   :MASK #S(NSEW-BITMAP NORTH #*(4 6)O@@@O@@@O@@@O@@@O@@@O@@@ NW #*(7 6)@B@@@N@@CN@@CN@@GN@@GN@@ NE 
#*(9 6)N@@@OH@@ON@@ON@@OO@@OO@@ SOUTH #*(4 6)O@@@O@@@O@@@O@@@O@@@O@@@ SW #*(7 6)ON@@GN@@GN@@CN@@@N@@@B@@ SE 
#*(9 6)OOH@OO@@OO@@ON@@OH@@N@@@ EAST #*(9 8)OOH@OOH@OOH@OOH@OOH@OOH@OOH@OOH@ CENTER #*(4 8)O@@@O@@@O@@@O@@@O@@@O@@@O@@@O@@@ WEST 
#*(7 8)ON@@ON@@ON@@ON@@ON@@ON@@ON@@ON@@)
   :MARGINS (4 1 4 2)
   :DEFAULT-SHADOWS :ARK)
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY

(IL:GLOBALVARS IL:MENUHELDWAIT)
)
(IL:PUTPROPS IL:ROOMS-BUTTONS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990 2020))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL (6457 7875 (SELECT-BUTTON-TYPE 6457 . 7875)) (10909 13146 (MAKE-BUTTON 10909 . 13146)
) (13148 13414 (COPY-BUTTON 13148 . 13414)) (13416 14419 (DISPLAY-BUTTON 13416 . 14419)) (14421 15264 
(UPDATE-BUTTON 14421 . 15264)) (15266 15604 (SET-BUTTON-TEXT-STRING 15266 . 15604)) (15874 16212 (
SET-BUTTON-TEXT-STRING 15874 . 16212)) (16214 16417 (COMPUTE-BUTTON-TEXT-POSITION 16214 . 16417)) (
16419 17055 (BUTTON-TEXT-X-COORD 16419 . 17055)) (17057 17697 (BUTTON-TEXT-Y-COORD 17057 . 17697)) (
17699 18120 (TEXT-FROM-TEXT-FORM 17699 . 18120)) (18122 19426 (BUTTON-TRACK-MOUSE 18122 . 19426)) (
19428 19620 (PERFORM-BUTTON-ACTION 19428 . 19620)) (19622 20088 (EDIT-BUTTON 19622 . 20088)) (20090 
20785 (BUTTON-COPY-SELECTED 20090 . 20785)) (20787 22056 (SHADE-BUTTON 20787 . 22056)) (22058 22202 (
PRINT-BUTTON-HELP 22058 . 22202)) (22349 23450 (MAKE-BUTTON-WINDOW 22349 . 23450)) (23452 24543 (
BW-REPAINTFN 23452 . 24543)) (24545 25335 (BW-TOTOPFN 24545 . 25335)) (25337 26238 (BW-BUTTONEVENTFN 
25337 . 26238)) (26240 26967 (BW-BUTTONEVENTFN-INTERNAL 26240 . 26967)) (26969 27253 (
SET-BUTTON-WINDOW-TEXT-STRING 26969 . 27253)) (27255 28200 (MAYBE-RESIZE-BUTTON-WINDOW 27255 . 28200))
 (28202 29222 (BW-SCREEN-CHANGED-FUNCTION 28202 . 29222)) (29688 30643 (DISPLAY-BUTTON-IMAGE 29688 . 
30643)) (30645 31439 (DISPLAY-BUTTON-MASK 30645 . 31439)) (31441 34832 (BUTTON-WIDTH 31441 . 34832)) (
34834 38509 (BUTTON-HEIGHT 34834 . 38509)) (38511 39213 (BUTTON-BITMAP-BITBLT 38511 . 39213)) (39215 
40415 (EW-BITBLT 39215 . 40415)) (40417 41728 (NS-BITBLT 40417 . 41728)) (41730 43230 (NSEW-BITBLT 
41730 . 43230)) (43232 45698 (PAINT-REGION 43232 . 45698)) (45739 46229 (EDIT-BUTTON-WINDOW 45739 . 
46229)) (46231 47729 (EXTERNALIZE-BUTTON 46231 . 47729)) (47731 47880 (EXTERNALIZE-FONT 47731 . 47880)
) (47882 48179 (WITH-BUTTON 47882 . 48179)))))
IL:STOP