(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "ROOMS")

(IL:FILECREATED " 5-Dec-2020 16:37:39" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>WALLPAPER.;2|
 3287   

      IL:|previous| IL:|date:| "17-Aug-90 14:48:22" 
IL:|{DSK}<Users>arunwelch>SKYDRIVE>DOCUMENTS>UNIX>LISP>LDE>ROOMS>MEDLEY-35>WALLPAPER.;1|)


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

(IL:PRETTYCOMPRINT IL:WALLPAPERCOMS)

(IL:RPAQQ IL:WALLPAPERCOMS
 ((FILE-ENVIRONMENTS IL:WALLPAPER)
                                (IL:P (EXPORT '(MAKE-WALLPAPER-WINDOW HACK-BACKGROUND)
                                             "ROOMS"))
                                (IL:FILES (IL:SYSLOAD)
                                       IL:SCREENPAPER)
                                (IL:FUNCTIONS MAKE-WALLPAPER-WINDOW WALLPAPER-WINDOW-BUTTONEVENTFN 
                                       HACK-BACKGROUND)
                                (IL:WINDOW-TYPES :WALLPAPER)))

(DEFINE-FILE-ENVIRONMENT IL:WALLPAPER
 :COMPILER :COMPILE-FILE
   :PACKAGE "ROOMS"
   :READTABLE "XCL")

(EXPORT '(MAKE-WALLPAPER-WINDOW
 HACK-BACKGROUND)
       "ROOMS")

(IL:FILESLOAD (IL:SYSLOAD)
       IL:SCREENPAPER)

(DEFUN MAKE-WALLPAPER-WINDOW
 (&OPTIONAL REGION)
   (LET ((WINDOW (IL:CREATEW REGION "Wallpaper" 10)))
        (IL:WINDOWPROP WINDOW 'IL:BUTTONEVENTFN 'WALLPAPER-WINDOW-BUTTONEVENTFN)
        WINDOW))

(DEFUN WALLPAPER-WINDOW-BUTTONEVENTFN
 (WINDOW)
   (NOTIFY-USER "Pick regions of the screen with LEFT~%Press MIDDLE when satisfied, RIGHT to abort.")
   (LET ((SHADE (IL:SCREENPAPER WINDOW NIL 'IL:PICK)))
        (WHEN SHADE (HACK-BACKGROUND
 SHADE))))

(DEFUN HACK-BACKGROUND
 (SHADE &OPTIONAL (ROOM *CURRENT-ROOM*))

(IL:* IL:|;;;| "set the first shade specification of ROOM to be SHADE, or add a :WHOLE-SCREEN specification ROOM has no shades specified.")


   (IL:* IL:|;;| "always call this before we hack a room")


   (UPDATE-PLACEMENTS)
   (LET ((SPECS (BACKGROUND-EXTERNAL-FORM (ROOM-BACKGROUND ROOM))))
        (DOLIST (SPEC SPECS (PUSH (LIST :WHOLE-SCREEN SHADE)
                                  SPECS))
            (CASE (FIRST SPEC)
                (:WHOLE-SCREEN 
                   (SETF (SECOND SPEC)
                         SHADE)
                   (RETURN))
                (:REGION 
                   (SETF (GETF SPEC :SHADE)
                         SHADE)
                   (RETURN))))
        (SETF (ROOM-BACKGROUND ROOM)
              (MAKE-BACKGROUND SPECS)))

   (IL:* IL:|;;| "always call this after we hack a room")


   (ROOM-CHANGED ROOM :EDITED))

(DEF-WINDOW-TYPE :WALLPAPER
 :RECOGNIZER (LAMBDA (WINDOW)
                                                   (EQ (IL:WINDOWPROP WINDOW 'IL:BUTTONEVENTFN)
                                                       'WALLPAPER-WINDOW-BUTTONEVENTFN))
   :ABSTRACTER (LAMBDA (WINDOW)
                      (LIST :REGION (EXTERNALIZE-REGION (WINDOW-REGION WINDOW))))
   :RECONSTITUTER (LAMBDA (ARGS)
                         (MAKE-WALLPAPER-WINDOW
 (INTERNALIZE-REGION (GETF ARGS :REGION))))
   :TITLE "Wallpaper"
   :FILES (IL:WALLPAPER))
(IL:PUTPROPS IL:WALLPAPER IL:COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 2020))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL (1232 1435 (MAKE-WALLPAPER-WINDOW 1232 . 1435)) (1437 1695 (
WALLPAPER-WINDOW-BUTTONEVENTFN 1437 . 1695)) (1697 2636 (HACK-BACKGROUND 1697 . 2636)))))
IL:STOP