(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "27-Oct-87 16:35:37" {ERINYES}<LISPUSERS>LYRIC>IDLEHAX.;1
 17158  

      changes to%:  (FNS IDLE-SLIDE)

      previous date%: "28-Nov-86 15:26:36" |{IE:PARC:XEROX}<LISP>LYRIC>LISPUSERS>IDLEHAX.;1|)


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

(PRETTYCOMPRINT IDLEHAXCOMS)

(RPAQQ IDLEHAXCOMS
 ((COMS (ADDVARS (IDLE.FUNCTIONS (Lines (QUOTE LINES)) (Warp-Out (QUOTE WARP)) (Radar (QUOTE WALKINGSPOKE)) (Triangles (FUNCTION (LAMBDA (W) (LINES W 3 1 40)))) (RandAngles (FUNCTION (LAMBDA (W) (LINES W (RAND 3 7) (RAND 1 16) (RAND 25 100))))) (Polygons (QUOTE POLYGONS)) (Bubbles (QUOTE BUBBLES)) (Kaleidoscope (QUOTE KALDEMO)) (Windows (QUOTE IDLE-WINDOWS)))) (VARS (IDLE.DEFAULTFN (QUOTE LINES)))) (COMS (* for drawing polygons) (FNS POLYGONSDEMO POLYGONS CONNECTPOLYS DRAWPOLY1 RANDOMPT) (INITVARS (POLYGONSWINDOW)) (VARS POLYGONWAIT2 POLYGONMINPTS POLYGONMAXPTS POLYGONSTEPS POLYGONWAIT) (RECORDS NPOINT) (P (DEFPRINT (QUOTE NPOINT) (QUOTE (LAMBDA (PT FL) (CONS (CONCAT "(" (fetch XC of PT) "," (fetch YC of PT) ")") (PACK))))))) (COMS (* and dots) (DECLARE%: DONTCOPY (RECORDS KALSTATE) (CONSTANTS KAL.MASK)) (FNS KALDEMO KAL.ADVANCE KAL.SPOTS KAL.BMS KAL.ORAND)) (COMS (* Fun with circles...) (FNS BUBBLES BUBBLE.CREATE) (VARS (BUBBLECNT 20)) (FNS IDLE-WINDOWS)) (COMS (* line drawing demo) (FNS LINES LINES1 LINES2 LINES3) (VARS LINECNT)) (COMS (* circles and lines) (FNS WALKINGSPOKE WARP)) (COMS (* melting) (FNS IDLE-MELT IDLE-SLIDE) (VARS MELT-BLOCK-SIZE) (ADDVARS (IDLE.FUNCTIONS ("Melt screen" (QUOTE IDLE-MELT)) ("Slide screen" (QUOTE IDLE-SLIDE))))) (COMS (* utilities) (FNS DEMOWINDOW) (GLOBALVARS BLOCKTIMER) (MACROS PERIODIC.BLOCK)))
)

(ADDTOVAR IDLE.FUNCTIONS
 (Lines (QUOTE LINES)) (Warp-Out (QUOTE WARP)) (Radar (QUOTE WALKINGSPOKE)) (Triangles (FUNCTION (LAMBDA (W) (LINES W 3 1 40))))
 (RandAngles (FUNCTION (LAMBDA (W) (LINES W (RAND 3 7) (RAND 1 16) (RAND 25 100))))) (Polygons (QUOTE POLYGONS))
 (Bubbles (QUOTE BUBBLES)) (Kaleidoscope (QUOTE KALDEMO)) (Windows (QUOTE IDLE-WINDOWS)))

(RPAQQ IDLE.DEFAULTFN
 LINES)



(* for drawing polygons)


(DEFINEQ

(POLYGONSDEMO

(LAMBDA NIL (* hts%: "20-AUG-83 22:55") (POLYGONS (OR POLYGONSWINDOW (SETQ POLYGONSWINDOW (CREATEW (QUOTE (200 150 600 500))))) T (SETUPTIMER 10000)))
)

(POLYGONS

(LAMBDA (W) (* lmm "30-Jul-85 20:31") (SETQ W (DEMOWINDOW W)) (LET ((OP (if (VIDEOCOLOR) then (QUOTE PAINT) else (QUOTE ERASE)))) (bind NPOINTS do (SETQ NPOINTS (RAND POLYGONMINPTS POLYGONMAXPTS)) (CONNECTPOLYS (for I from 1 to NPOINTS collect (RANDOMPT W)) (for I from 1 to NPOINTS collect (RANDOMPT W)) POLYGONSTEPS W OP) (DISMISS POLYGONWAIT))))
)

(CONNECTPOLYS

(LAMBDA (FROMS TOS NSTEPS W OPERATION) (* lmm "30-Jul-85 17:19") (PROG (DIFFS) (CLEARW W) (LINES2 FROMS 3 W OPERATION) (SETQ DIFFS (for FPT in FROMS as TPT in TOS bind DX DY collect (SETQ DX (IQUOTIENT (IDIFFERENCE (fetch XC of TPT) (fetch XC of FPT)) POLYGONSTEPS)) (SETQ DY (IQUOTIENT (IDIFFERENCE (fetch YC of TPT) (fetch YC of FPT)) POLYGONSTEPS)) (replace XC of TPT with (IPLUS (fetch XC of FPT) (ITIMES POLYGONSTEPS DX))) (replace YC of TPT with (IPLUS (fetch YC of FPT) (ITIMES POLYGONSTEPS DY))) (CONS DX DY))) (LINES2 TOS 3 W OPERATION) (for FPT in FROMS as TPT in TOS do (DRAWLINE (fetch XC of FPT) (fetch YC of FPT) (fetch XC of TPT) (fetch YC of TPT) 1 OPERATION W)) (DISMISS POLYGONWAIT2) (CLEARW W) (for I from 1 to POLYGONSTEPS do (BLOCK) (LINES2 FROMS 1 W OPERATION) (for PT in FROMS as DIF in DIFFS do (add (fetch XC of PT) (CAR DIF)) (add (fetch YC of PT) (CDR DIF))) finally (LINES2 FROMS 1 W OPERATION))))
)

(DRAWPOLY1

(LAMBDA (PTLIST WIDTH OPERATION W NOBLOCK) (* edited%: "19-AUG-83 04:14") (* draws a closed polygon of the points given If OPERATION is not given, use the one from the default DS.) (COND (PTLIST (OR OPERATION (SETQ OPERATION (DSPOPERATION NIL W))) (PROG ((PTS PTLIST)) (while (CDR PTS) do (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CADR PTS)) (fetch YC of (CADR PTS)) WIDTH OPERATION W) (pop PTS) finally (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CAR PTLIST)) (fetch YC of (CAR PTLIST)) WIDTH OPERATION W))))) (COND (NOBLOCK (ALLOW.BUTTON.EVENTS)) (T (BLOCK))))
)

(RANDOMPT

(LAMBDA (DS) (* edited%: "18-AUG-83 16:22") (PROG ((REG (DSPCLIPPINGREGION NIL DS))) (RETURN (create NPOINT XC ← (RAND (fetch LEFT of REG) (fetch RIGHT of REG)) YC ← (RAND (fetch BOTTOM of REG) (fetch TOP of REG))))))
)
)

(RPAQ? POLYGONSWINDOW
 )

(RPAQQ POLYGONWAIT2
 250)

(RPAQQ POLYGONMINPTS
 3)

(RPAQQ POLYGONMAXPTS
 9)

(RPAQQ POLYGONSTEPS
 35)

(RPAQQ POLYGONWAIT
 2000)
(DECLARE%: EVAL@COMPILE

(DATATYPE NPOINT
 ((XC XPOINTER) (YC XPOINTER)))
)
(/DECLAREDATATYPE (QUOTE NPOINT) (QUOTE (XPOINTER XPOINTER)) (QUOTE ((NPOINT 0 XPOINTER) (NPOINT 2 XPOINTER))) (QUOTE 4))
(DEFPRINT (QUOTE NPOINT) (QUOTE (LAMBDA (PT FL) (CONS (CONCAT "(" (fetch XC of PT) "," (fetch YC of PT) ")") (PACK)))))



(* and dots)


(DECLARE%: DONTCOPY 
(DECLARE%: EVAL@COMPILE

(RECORD KALSTATE
 (A B C PERIODCOUNT PERIOD))
)

(DECLARE%: EVAL@COMPILE 

(RPAQQ KAL.MASK
 65535)

(CONSTANTS KAL.MASK)
)
)
(DEFINEQ

(KALDEMO

(LAMBDA (W PERIOD PERSISTENCE) (* lmm " 5-Aug-85 22:16") (OR PERIOD (SETQ PERIOD (RAND 8 128))) (OR PERSISTENCE (SETQ PERSISTENCE (LSH 1 (RAND 4 13)))) (SETQ W (DEMOWINDOW W)) (LET ((XSTATEB (create KALSTATE A ← 1 B ← -1849 C ← (RAND 2 4) PERIOD ← PERIOD PERIODCOUNT ← 1)) (XSTATEE (create KALSTATE)) (YSTATEB (create KALSTATE A ← 1 B ← -1809 C ← (RAND 0 20) PERIOD ← PERIOD PERIODCOUNT ← 1)) (YSTATEE (create KALSTATE)) (WINDOWSIDE (MIN (WINDOWPROP W (QUOTE HEIGHT)) (WINDOWPROP W (QUOTE WIDTH)))) (TIMER (SETUPTIMER 0 NIL (QUOTE TICKS))) (BLACK (NOT (VIDEOCOLOR))) XOFFSET) (SETQ XOFFSET (QUOTIENT (MAX (DIFFERENCE (WINDOWPROP W (QUOTE WIDTH)) WINDOWSIDE) 0) 2)) (SETQ XSTATEE (COPY XSTATEB)) (SETQ YSTATEE (COPY YSTATEB)) (from 1 to PERSISTENCE do (KAL.ADVANCE XSTATEB) (KAL.ADVANCE YSTATEB) (KAL.SPOTS (ffetch A of XSTATEB) (ffetch A of YSTATEB) WINDOWSIDE W BLACK XOFFSET) (PERIODIC.BLOCK TIMER)) (do (KAL.ADVANCE XSTATEE) (KAL.ADVANCE YSTATEE) (PROG ((X0 (LOGAND (LRSH (ffetch A of XSTATEE) 7) KAL.MASK)) (Y0 (LOGAND (LRSH (ffetch A of YSTATEE) 7) KAL.MASK)) X1 Y1) (COND ((ILESSP X0 Y0) (SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE) X0)) (SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE) Y0)) (KAL.BMS W X0 Y0 X1 Y1 (if BLACK then 1 else 0) XOFFSET)))) (KAL.ADVANCE XSTATEB) (KAL.ADVANCE YSTATEB) (KAL.SPOTS (ffetch A of XSTATEB) (ffetch A of YSTATEB) WINDOWSIDE W BLACK XOFFSET) (PERIODIC.BLOCK TIMER))))
)

(KAL.ADVANCE

(LAMBDA (STATE) (* lmm "30-Jul-85 20:16") (freplace A of STATE with (KAL.ORAND (ffetch A of STATE) (ffetch B of STATE))) (freplace PERIODCOUNT of STATE with (SUB1 (ffetch PERIODCOUNT of STATE))) (COND ((EQ (ffetch PERIODCOUNT of STATE) 0) (freplace B of STATE with (KAL.ORAND (ffetch B of STATE) (ffetch C of STATE))) (freplace PERIODCOUNT of STATE with (ffetch PERIOD of STATE)))))
)

(KAL.SPOTS

(LAMBDA (X Y WINDOWSIDE W BLACK XOFFSET) (* lmm " 3-Aug-85 21:59") (PROG ((X0 (LRSH X 7)) (Y0 (LRSH Y 7)) X1 Y1 C) (COND ((ILESSP X0 Y0) (SETQ X1 (IDIFFERENCE (SUB1 WINDOWSIDE) X0)) (SETQ Y1 (IDIFFERENCE (SUB1 WINDOWSIDE) Y0)) (SETQ C (LOGAND X 1)) (KAL.BMS W X0 Y0 X1 Y1 (if BLACK then (DIFFERENCE 1 C) else C) XOFFSET)))))
)

(KAL.BMS

(LAMBDA (W X0 Y0 X1 Y1 C XOFFSET) (* lmm "30-Jul-85 19:38") (UNINTERRUPTABLY (if (EQUAL (GETWINDOWPROP W (QUOTE REGION)) WHOLESCREEN) then (TOTOPW W) (SETQ W (SCREENBITMAP))) (BITMAPBIT W (PLUS XOFFSET X0) Y0 C) (BITMAPBIT W (PLUS XOFFSET Y0) X0 C) (BITMAPBIT W (PLUS XOFFSET X1) Y0 C) (BITMAPBIT W (PLUS XOFFSET Y0) X1 C) (BITMAPBIT W (PLUS XOFFSET X1) Y1 C) (BITMAPBIT W (PLUS XOFFSET Y1) X1 C) (BITMAPBIT W (PLUS XOFFSET X0) Y1 C) (BITMAPBIT W (PLUS XOFFSET Y1) X0 C)))
)

(KAL.ORAND

(LAMBDA (A B) (* DECLARATIONS%: (BLOCKRECORD BOX ((VALUE FIXP)))) (* lmm " 3-Aug-85 21:58") (LET ((BOX (CONSTANT (NCREATE (QUOTE FIXP))))) (replace (BOX VALUE) of BOX with A) (\BOXIPLUS BOX B) (LOGXOR (LOGAND BOX KAL.MASK) (LOGAND B KAL.MASK))))
)
)



(* Fun with circles...)


(DEFINEQ

(BUBBLES

(LAMBDA (W) (* lmm "30-Jul-85 20:35") (WINDOWPROP (SETQ W (DEMOWINDOW W)) (QUOTE RESHAPEFN) (FUNCTION (LAMBDA (W) (DSPFILL NIL (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) (QUOTE REPLACE) W)))) (DSPFILL NIL (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) (QUOTE REPLACE) W) (bind (ARRAY ← (ARRAY BUBBLECNT (QUOTE POINTER))) (I ← 1) CIRCLE eachtime (SETQ I (if (EQ I BUBBLECNT) then 1 else (ADD1 I))) do (* * first erase the circle at I in array) (SETQ CIRCLE (ELT ARRAY I)) (DSPOPERATION (if (VIDEOCOLOR) then (QUOTE ERASE) else (QUOTE PAINT)) W) (* there will be no circle at I the first time through) (AND CIRCLE (DRAWCIRCLE (CAR CIRCLE) (CADR CIRCLE) (CADDR CIRCLE) NIL NIL W)) (* * now put a new circle in array at I and draw it) (SETQ CIRCLE (SETA ARRAY I (BUBBLE.CREATE W))) (DSPOPERATION (QUOTE REPLACE) W) (* fill center w/ black so it ocludes ones under) (FILLCIRCLE (CAR CIRCLE) (CADR CIRCLE) (SUB1 (CADDR CIRCLE)) (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) W) (DSPOPERATION (QUOTE INVERT) W) (DRAWCIRCLE (CAR CIRCLE) (CADR CIRCLE) (CADDR CIRCLE) NIL NIL W) (BLOCK)))
)

(BUBBLE.CREATE

(LAMBDA (W) (* drc%: "29-Jul-85 13:51") (LET* ((REGION (WINDOWPROP W (QUOTE REGION))) (WIDTH (SUB1 (fetch WIDTH of REGION))) (HEIGHT (SUB1 (fetch HEIGHT of REGION))) (CENTERX (RAND 1 (SUB1 WIDTH))) (CENTERY (RAND 1 (SUB1 HEIGHT)))) (LIST CENTERX CENTERY (RAND 1 (IMIN (IDIFFERENCE WIDTH CENTERX) CENTERX (IDIFFERENCE HEIGHT CENTERY) CENTERY)))))
)
)

(RPAQQ BUBBLECNT
 20)
(DEFINEQ

(IDLE-WINDOWS

(LAMBDA (W DELAY) (* lmm " 7-Jun-86 22:21") (SETQ W (DEMOWINDOW W)) (PROG ((D (WINDOWPROP W (QUOTE WIDTH))) (H (WINDOWPROP W (QUOTE HEIGHT))) (TIMER (SETUPTIMER 0 NIL (QUOTE TICKS)))) (LET ((TITLE (WINDOWPROP (CREATEW (LIST 0 0 D (HEIGHTIFWINDOW 0 T)) "Yet another window" NIL T) (QUOTE IMAGECOVERED)))) (while T do (PROG ((X (RAND 0 (- D (+ 2 2 100)))) (Y (RAND 0 (- H 8 100)))) (PROG ((D0 (MAX 100 (RAND 100 (- D X)))) (H0 (MAX 100 (RAND 100 (- H Y))))) (BITBLT NIL NIL NIL W X Y D0 2 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT NIL NIL NIL W X Y 2 H0 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT NIL NIL NIL W (+ X (- D0 2)) Y 2 H0 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT TITLE NIL (+ WBorder (QUOTIENT WBorder 2)) W X (+ Y H0) D0 NIL NIL (QUOTE REPLACE)) (BITBLT NIL NIL NIL W (+ X 2) (+ Y 2) (- D0 (+ 2 2)) (- H0 2) (QUOTE TEXTURE) (QUOTE ERASE) BLACKSHADE))) (if DELAY then (BLOCK DELAY) else (PERIODIC.BLOCK TIMER))))))
)
)



(* line drawing demo)


(DEFINEQ

(LINES

(LAMBDA (W N LCNT STEPS ODDSTEP) (* lmm "27-Sep-85 00:50") (SETQ W (DEMOWINDOW W)) (OR STEPS (SETQ STEPS POLYGONSTEPS)) (OR N (SETQ N 2)) (RESETLST (PROG ((LINES (to (OR LCNT (if (NEQ N 2) then (ADD1 (QUOTIENT LINECNT N)) else LINECNT)) collect NIL)) (CNT 0) FROMPTS TOPTS DXS (ODDSTART)) (RESETSAVE NIL (LIST (FUNCTION RPLACD) LINES)) (NCONC LINES LINES) (SETQ FROMPTS (to N collect (RANDOMPT W))) (bind (TIMER ← (SETUPTIMER 0 NIL (QUOTE TICKS))) while T do (COND ((ILEQ CNT 0) (SETQ TOPTS (bind (ODDP ← (SETQ ODDSTART (NOT ODDSTART))) for X in FROMPTS collect (if (AND ODDSTEP (SETQ ODDP (NOT ODDP))) then X else (RANDOMPT W)))) (SETQ DXS (for TP in TOPTS as FP in FROMPTS collect (create NPOINT XC ← (QUOTIENT (DIFFERENCE (fetch XC TP) (fetch XC FP)) STEPS) YC ← (QUOTIENT (DIFFERENCE (fetch YC TP) (fetch YC FP)) STEPS)))) (SETQ CNT STEPS)) (T (SETQ CNT (SUB1 CNT)))) (LINES1 FROMPTS LINES W) (for X in FROMPTS as D in DXS do (add (fetch XC X) (fetch XC D)) (add (fetch YC X) (fetch YC D))) (SETQ LINES (CDR LINES)) (PERIODIC.BLOCK TIMER)))))
)

(LINES1

(LAMBDA (ENDPOINTS LINES DSP) (* lmm "30-Jul-85 17:33") (PROG (PTS) (COND ((SETQ PTS (CAR LINES)) (* ERASE OLD) (LINES3 (CAR LINES) 1 DSP (QUOTE INVERT) ENDPOINTS)) (T (RPLACA LINES (SETQ PTS (in ENDPOINTS collect (create NPOINT)))) (LINES2 ENDPOINTS 1 DSP (QUOTE INVERT)))) (for PT in PTS as EP in ENDPOINTS do (replace XC of PT with (fetch XC of EP)) (replace YC of PT with (fetch YC of EP)))))
)

(LINES2

(LAMBDA (ENDPOINTS WIDTH WINDOW OPERATION) (* lmm "30-Jul-85 17:14") (for (X ← ENDPOINTS) while (OR (CDR X) (if (CDDR ENDPOINTS) then X)) do (DRAWLINE (fetch XC (CAR X)) (fetch YC (CAR X)) (fetch XC (CAR (OR (SETQ X (CDR X)) ENDPOINTS))) (fetch YC (CAR (OR X ENDPOINTS))) WIDTH OPERATION WINDOW)))
)

(LINES3

(LAMBDA (ENDPOINTS WIDTH WINDOW OPERATION EP2) (* lmm "30-Jul-85 17:33") (for (X ← ENDPOINTS) while (OR (CDR X) (if (CDDR ENDPOINTS) then X)) bind (Y ← EP2) do (DRAWLINE (fetch XC (CAR X)) (fetch YC (CAR X)) (fetch XC (CAR (OR (SETQ X (CDR X)) ENDPOINTS))) (fetch YC (CAR (OR X ENDPOINTS))) WIDTH OPERATION WINDOW) (DRAWLINE (fetch XC (CAR Y)) (fetch YC (CAR Y)) (fetch XC (CAR (OR (SETQ Y (CDR Y)) EP2))) (fetch YC (CAR (OR Y EP2))) WIDTH OPERATION WINDOW)))
)
)

(RPAQQ LINECNT
 100)



(* circles and lines)


(DEFINEQ

(WALKINGSPOKE

(LAMBDA (W) (* lmm "19-Mar-86 17:49") (LET ((W (DEMOWINDOW W)) (SINARRAY (ARRAY 360 NIL NIL 0)) (MARGIN (QUOTIENT MAX.SMALLP SCREENWIDTH))) (for N from 0 to 359 do (SETA SINARRAY N (FIXR (TIMES MARGIN (SIN N))))) (CLEARW W) (do (PROG ((WIDTH (WINDOWPROP W (QUOTE WIDTH))) (HEIGHT (WINDOWPROP W (QUOTE HEIGHT)))) (* for YY from 0 to 298 do (DRAWLINE 0 YY 298 YY 1 (QUOTE INVERT) RADARWINDOW)) (LET ((R (QUOTIENT (RAND (MIN 100 WIDTH HEIGHT) (MIN WIDTH HEIGHT)) 2))) (LET ((X (RAND R (DIFFERENCE WIDTH R))) (Y (RAND R (DIFFERENCE HEIGHT R)))) (RPTQ 2 (for N from 0 to 359 do (DRAWLINE X Y (PLUS X (QUOTIENT (TIMES R (ELT SINARRAY (IMOD (PLUS N 90) 360))) MARGIN)) (PLUS Y (QUOTIENT (TIMES R (ELT SINARRAY N)) MARGIN)) 2 (QUOTE INVERT) W) (BLOCK)) (RECLAIM))))))))
)

(WARP

(LAMBDA (W) (* hdj " 1-Apr-86 14:22") (do (CLEARW W) (LET ((OLDOP (DSPOPERATION (QUOTE INVERT) W))) (LET ((WIDTH (WINDOWPROP W (QUOTE WIDTH))) (HEIGHT (WINDOWPROP W (QUOTE HEIGHT)))) (LET ((CENTERX (RAND 0 WIDTH)) (CENTERY (RAND 0 HEIGHT))) (for RADIUS from (RAND 5 250) to 5 by -2 do (FILLCIRCLE (PLUS CENTERX (RAND 0 2)) (PLUS CENTERY (RAND 0 2)) RADIUS BLACKSHADE W) (BLOCK)))) (DSPOPERATION OLDOP W))))
)
)



(* melting)


(DEFINEQ

(IDLE-MELT

(LAMBDA (WINDOW SIZE INITIAL PATH) (* ; "Edited 28-Nov-86 15:25 by Masinter") (OR SIZE (SETQ SIZE MELT-BLOCK-SIZE)) (SETQ WINDOW (DEMOWINDOW WINDOW)) (PROG ((W (WINDOWPROP WINDOW (QUOTE WIDTH))) (H (WINDOWPROP WINDOW (QUOTE HEIGHT))) BM (TAIL INITIAL) TIMER) REPAINT (CLEARW WINDOW) (SETQ BM (OR (CAR TAIL) (WINDOWPROP WINDOW (QUOTE IMAGECOVERED)))) (for BITMAP inside BM do (BITBLT (SETQ BITMAP (if (BITMAPP BITMAP) then BITMAP elseif (CL:SYMBOLP BITMAP) then (CAR (READBRUSHFILE BITMAP)) else (IDLE.BITMAP NIL BITMAP))) NIL NIL WINDOW (RAND 0 (- W (BITMAPWIDTH BITMAP))) (RAND 0 (- H (BITMAPHEIGHT BITMAP))))) (if INITIAL then (SETQ TIMER (AND (CADR TAIL) (SETUPTIMER (CADR TAIL) TIMER (QUOTE SECONDS) (QUOTE SECONDS)))) (SETQ TAIL (OR (CDDR TAIL) INITIAL))) (do (LET ((X (RAND 0 (- W SIZE))) (Y (RAND 0 (- H SIZE)))) (BITMAPBIT WINDOW X Y 0) (* ; "had a complaint that the screen tended to go to white. This makes sure that the bits are off (in standard idle windows)") (BITBLT WINDOW X Y WINDOW (+ X (RAND -1 1)) (+ Y (RAND -1 1)) SIZE SIZE NIL (QUOTE REPLACE))) (BLOCK) repeatuntil (AND TIMER (TIMEREXPIRED? TIMER (QUOTE SECONDS)))) (GO REPAINT)))
)

(IDLE-SLIDE

(LAMBDA (W SIZE SPEED COUNT SOURCE) (* ; "Edited 27-Oct-87 16:33 by Masinter") (OR SIZE (SETQ SIZE 128)) (OR COUNT (SETQ COUNT 120)) (OR SPEED (SETQ SPEED 2)) (SETQ W (DEMOWINDOW W)) (BITBLT (OR SOURCE (SETQ SOURCE (WINDOWPROP W (QUOTE IMAGECOVERED)))) NIL NIL W NIL NIL NIL NIL NIL (QUOTE REPLACE)) (LET ((D (WINDOWPROP W (QUOTE WIDTH))) (H (WINDOWPROP W (QUOTE HEIGHT)))) (LET ((XMAX (- D SIZE)) (YMAX (- H SIZE)) X Y DX DY (CNT 1) DDX DDY (TIMER (SETUPTIMER 0 NIL (QUOTE TICKS)))) (do (COND ((OR (EQ (add CNT -1) 0) (< X 0) (> X XMAX) (< Y 0) (> Y YMAX)) (SETQ X (RAND 0 XMAX)) (SETQ Y (RAND 0 YMAX)) (SETQ DX (RAND (- SPEED) SPEED)) (SETQ DY (RAND (- SPEED) SPEED)) (BITBLT SOURCE X Y W X Y SIZE SIZE NIL (QUOTE REPLACE)) (SETQ DDX DY) (SETQ DDY DX) (SETQ CNT COUNT))) (BITBLT W X Y W (+ X DDX) (+ Y DDY) SIZE SIZE NIL (QUOTE REPLACE)) (add X DX) (add Y DY) (PERIODIC.BLOCK TIMER)))))
)
)

(RPAQQ MELT-BLOCK-SIZE
 32)

(ADDTOVAR IDLE.FUNCTIONS
 ("Melt screen" (QUOTE IDLE-MELT)) ("Slide screen" (QUOTE IDLE-SLIDE)))



(* utilities)


(DEFINEQ

(DEMOWINDOW

(LAMBDA (W) (* lmm "30-Jul-85 20:34") (OR W (SETQ W (OR POLYGONSWINDOW (SETQ POLYGONSWINDOW (CREATEW))))) (DSPTEXTURE (if (VIDEOCOLOR) then WHITESHADE else BLACKSHADE) W) (DSPOPERATION (QUOTE INVERT) W) (CLEARW W) W)
)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BLOCKTIMER)
)
(DECLARE%: EVAL@COMPILE 
(PUTPROPS PERIODIC.BLOCK MACRO ((TIMER) (if (TIMEREXPIRED? TIMER (QUOTE TICKS)) then (BLOCK) (SETQ TIMER (SETUPTIMER 100 TIMER (QUOTE TICKS) (QUOTE MILLISECONDS))))))
)
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2212 4581 (POLYGONSDEMO 2222 . 2392) (POLYGONS 2394 . 2758) (CONNECTPOLYS 2760 . 3705) 
(DRAWPOLY1 3707 . 4344) (RANDOMPT 4346 . 4579)) (5277 8199 (KALDEMO 5287 . 6698) (KAL.ADVANCE 6700 . 
7101) (KAL.SPOTS 7103 . 7444) (KAL.BMS 7446 . 7933) (KAL.ORAND 7935 . 8197)) (8232 9718 (BUBBLES 8242
 . 9348) (BUBBLE.CREATE 9350 . 9716)) (9745 10730 (IDLE-WINDOWS 9755 . 10728)) (10761 13032 (LINES 
10771 . 11830) (LINES1 11832 . 12242) (LINES2 12244 . 12555) (LINES3 12557 . 13030)) (13088 14301 (
WALKINGSPOKE 13098 . 13879) (WARP 13881 . 14299)) (14322 16411 (IDLE-MELT 14332 . 15501) (IDLE-SLIDE 
15503 . 16409)) (16567 16813 (DEMOWINDOW 16577 . 16811)))))
STOP