(FILECREATED "23-Jul-86 21:26:54" {ERIS}<LISPUSERS>KOTO>READBRUSH.;2 8678
changes to: (FNS READBRUSHFILE)
previous date: "30-May-86 03:07:53" {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 "23-Jul-86 21:26")
(OR (AND (LITATOM FILE)
(GET FILE (QUOTE BRUSH)))
(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 (BIN16 STR))
(SETQ H (BIN16 STR))
(RPTQ 10 (BIN STR))
(SETQ BM (READBINARYBITMAP W H STR))
(if M
then (SETQ MASK (READBINARYBITMAP W H STR)))
(CLOSEF STR)
(SETQ BM (CONS BM MASK))
(IF (LITATOM FILE)
THEN (PUT FILE (QUOTE BRUSH)
BM))
(RETURN BM])
(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 (1132 7990 (CHOOSE.IDLE.BITMAP 1142 . 1667) (READBRUSHFILE 1669 . 2920) (READBRUSH 2922
. 3602) (READROOTPICTURE 3604 . 3976) (IDLE.GLIDING.BOX 3978 . 7988)))))
STOP