(FILECREATED "21-Jan-86 01:46:39" {ERIS}<LISPUSERS>KOTO>READBRUSH.;2 8315   

      changes to:  (FNS IDLE.GLIDING.BOX)

      previous date: " 5-Nov-85 00:19:19" {ERIS}<LISPUSERS>KOTO>READBRUSH.;1)


(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT READBRUSHCOMS)

(RPAQQ READBRUSHCOMS ((FNS CHOOSE.IDLE.BITMAP READBRUSHFILE READBRUSH READROOTPICTURE 
                           IDLE.GLIDING.BOX)
                      (FILES BITMAPFNS)
                      [ADDVARS (IDLE.FUNCTIONS ("Gliding box" (QUOTE IDLE.GLIDING.BOX)
                                                      "moves images around on the screen"
                                                      (SUBITEMS ("Pick image from MesaHacks"
                                                                 (PROGN (CHOOSE.IDLE.BITMAP)
                                                                        (QUOTE IDLE.GLIDING.BOX]
                      (INITVARS (IDLE.BITMAP)
                             (BRUSHMENU)
                             (ROOTPICTUREMENU))
                      (VARS BRUSHDIRECTORY)))
(DEFINEQ

(CHOOSE.IDLE.BITMAP

  [LAMBDA NIL                                                (* lmm "28-Oct-85 18:24")

    (
PROG
 NIL
	    (
ALLOW.BUTTON.EVENTS
)
	    (
SETQ
 IDLE.BITMAP
	      (
CAR
 (READBRUSHFILE
 (
OR
 [
MENU
 (
OR
 BRUSHMENU
							  (
SETQ
 BRUSHMENU
							    (create
 MENU
								      ITEMS _
								      (for
 FILE infiles
 
					   "{GOOFY:OSBU NORTH:XEROX}<HACKS>DATA>BRUSHES>*.BRUSH;"
									 collect
 (
NAMEFIELD

										     FILE]
					    (
RETURN
])

(READBRUSHFILE

  [LAMBDA (FILE)                                             (* lmm " 8-Aug-85 02:28")

    (
PROG
 ((STR (
OPENSTREAM
 (
PACKFILENAME.STRING
 (
QUOTE
 BODY)
						 FILE
						 (
QUOTE
 DIRECTORY)
						 BRUSHDIRECTORY
						 (
QUOTE
 EXTENSION)
						 (
QUOTE
 BRUSH))
			    (
QUOTE
 INPUT)
			    (
QUOTE
 OLD)))
	   M W H BM MASK REG)
          (
BIN
 STR)
          (
SETQ
 M (
SELECTQ
 (
BIN
 STR)
			   (1 T)
			   (0 NIL)
			   NIL))
          (
SETQ
 W (
LOGOR
 (
LLSH
 (
BIN
 STR)
			       8)
			 (
BIN
 STR)))
          (
SETQ
 H (
LOGOR
 (
LLSH
 (
BIN
 STR)
			       8)
			 (
BIN
 STR)))
          (
RPTQ
 10 (
BIN
 STR))
          (
SETQ
 BM (
READBINARYBITMAP
 W H STR))
          (if
 M
	      then
 (
SETQ
 MASK (
READBINARYBITMAP
 W H STR)))
          (
CLOSEF
 STR)
          (
RETURN
 (
CONS
 BM MASK])

(READBRUSH

  [LAMBDA (FILE)                                             (* lmm " 4-Aug-85 07:31")

    (
PROG
 ((BMS (READBRUSHFILE
 FILE))
	   WIN REG)
          (if
 (
CDR
 BMS)
	      then
 (
SETQ
 WIN (
ICONW
 (
CAR
 BMS)
				    (
CDR
 BMS)))
	    else
 (
MOVEW
 (
SETQ
 WIN (
CREATEWFROMIMAGE
 (
CAR
 BMS)))
			[fetch
 (REGION LEFT) of
 (
SETQ
 REG (
GETBOXREGION
 (
WINDOWPROP
 WIN (
QUOTE
 WIDTH))
									(
WINDOWPROP
 WIN (
QUOTE
 HEIGHT]
			(fetch
 (REGION BOTTOM) of
 REG))
		 (
OPENW
 WIN))
          (
WINDOWPROP
 WIN (
QUOTE
 BUTTONEVENTFN)
		      (
QUOTE
 MOVEW))
          (
RETURN
 WIN])

(READROOTPICTURE

  [LAMBDA (FILE)                                             (* edited: "17-May-85 19:21")

    (
CHANGEBACKGROUND
 (
READPRESS
 (
PACKFILENAME.STRING
 (
QUOTE
 BODY)
						      FILE
						      (
QUOTE
 DIRECTORY)
						      "{GOOFY:OSBU NORTH}<HACKS>DATA>ROOTPICTURES>"
						      (
QUOTE
 EXTENSION)
						      (
QUOTE
 PRESS])

(IDLE.GLIDING.BOX
  [LAMBDA (WIN BITMAPS WAIT WAITSEQ MAXD)                                  (* lmm 
                                                                           "21-Jan-86 01:45")
    (OR BITMAPS (SETQ BITMAPS IDLE.BITMAP))
    [OR WIN (SETQ WIN (OR POLYGONSWINDOW (SETQ POLYGONSWINDOW (CREATEW]
    (OR MAXD (SETQ MAXD 4))
    [SETQ BITMAPS (for X inside BITMAPS
                     collect (if (LITATOM X)
                                 then [OR (GETPROP X (QUOTE BITMAP))
                                          (PUTPROP X (QUOTE BITMAP)
                                                 (OR (CAR (READBRUSHFILE X))
                                                     (BITMAPCREATE 10 10]
                               else (IDLE.BITMAP NIL X]
    (LET ((W (for X in BITMAPS largest (BITMAPWIDTH X) finally (RETURN $$EXTREME)))
          (H (for X in BITMAPS largest (BITMAPHEIGHT X) finally (RETURN $$EXTREME)))
          (REG (DSPCLIPPINGREGION NIL WIN)))
         (LET ((XBM (BITMAPCREATE (PLUS MAXD MAXD W)
                           (PLUS MAXD MAXD H)))
               (MAXX (MAX (DIFFERENCE (fetch WIDTH REG)
                                 (ADD1 W))
                          10))
               (MAXY (MAX (DIFFERENCE (fetch HEIGHT REG)
                                 (ADD1 W))
                          10))
               (MAXDD (FIX (SQRT MAXD)))
               X Y (CNT 0)
               DX DY STEPS NEWX NEWY REALX REALY ORIGX ORIGY TOY TOX THISBITMAP)
              (SETQ X (RAND 1 MAXX))
              (SETQ Y (RAND 1 MAXY))
              (BITBLT (SETQ THISBITMAP (CAR BITMAPS))
                     NIL NIL WIN X Y NIL NIL NIL (QUOTE INVERT))
              (while T do [COND
                             ((ILEQ CNT 0)
                              (SETQ ORIGX X)
                              (SETQ ORIGY Y)
                              (SETQ TOX (RAND 1 (SUB1 MAXX)))
                              (SETQ TOY (RAND 1 (SUB1 MAXY)))
                              (SETQ CNT (SETQ STEPS (QUOTIENT (PLUS (MAX (ABS (DIFFERENCE TOX X))
                                                                         (ABS (DIFFERENCE TOY Y)))
                                                                    MAXD -1)
                                                           MAXD)))
                              (QUOTIENT (PLUS (ABS (DIFFERENCE TOX X))
                                              STEPS -1)
                                     STEPS))
                             (T (SETQ CNT (SUB1 CNT]
                          (SETQ NEWX (PLUS (QUOTIENT (TIMES CNT (DIFFERENCE ORIGX TOX))
                                                  STEPS)
                                           TOX))
                          (if (GREATERP (ABS (SETQ DX (DIFFERENCE NEWX X)))
                                     MAXD)
                              then (SHOULDNT))
                          (SETQ NEWY (PLUS (QUOTIENT (TIMES CNT (DIFFERENCE ORIGY TOY))
                                                  STEPS)
                                           TOY))
                          (if (GREATERP (ABS (SETQ DY (DIFFERENCE NEWY Y)))
                                     MAXD)
                              then (SHOULDNT))
                          (BITBLT NIL NIL NIL XBM NIL NIL NIL NIL (QUOTE TEXTURE)
                                 (QUOTE ERASE)
                                 BLACKSHADE)
                          (BITBLT THISBITMAP NIL NIL XBM MAXD MAXD NIL NIL NIL (QUOTE INVERT))
                          (BITBLT THISBITMAP NIL NIL XBM (PLUS MAXD DX)
                                 (PLUS MAXD DY)
                                 NIL NIL NIL (QUOTE INVERT))
                          (BITBLT XBM NIL NIL WIN (DIFFERENCE X MAXD)
                                 (DIFFERENCE Y MAXD)
                                 NIL NIL NIL (QUOTE INVERT))
                          (add X DX)
                          (add Y DY)
                          (DISMISS WAIT])
)
(FILESLOAD BITMAPFNS)

(ADDTOVAR IDLE.FUNCTIONS ["Gliding box" (QUOTE IDLE.GLIDING.BOX)
                                "moves images around on the screen"
                                (SUBITEMS ("Pick image from MesaHacks" (PROGN (CHOOSE.IDLE.BITMAP)
                                                                              (QUOTE IDLE.GLIDING.BOX
                                                                                     ])

(RPAQ? IDLE.BITMAP )

(RPAQ? BRUSHMENU )

(RPAQ? ROOTPICTUREMENU )

(RPAQQ BRUSHDIRECTORY "{GOOFY:OSBU NORTH}<HACKS>DATA>BRUSHES>")
(PUTPROPS READBRUSH COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1125 7647 (CHOOSE.IDLE.BITMAP 1135 . 1660) (READBRUSHFILE 1662 . 2577) (READBRUSH 2579
 . 3259) (READROOTPICTURE 3261 . 3633) (IDLE.GLIDING.BOX 3635 . 7645)))))
STOP