This reverts commit fad70d4947.
This commit is contained in:
Larry Masinter
GitHub
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-Aug-2022 08:50:16" {DSK}<home>larry>medley>lispusers>IDLEHAX.;3 31969
|
||||
(FILECREATED "26-Jun-2022 18:21:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;4 26796
|
||||
|
||||
:CHANGES-TO (FNS KALDEMO IDLE-DRAIN LINES1 WARP CONNECTPOLYS BUBBLES IDLE-MELT IDLE-WINDOWS)
|
||||
(VARS POLYGONWAIT2)
|
||||
:CHANGES-TO (FNS KAL.ADVANCE)
|
||||
|
||||
:PREVIOUS-DATE "21-Aug-2022 18:08:56" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
:PREVIOUS-DATE " 9-Feb-2022 13:53:05"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>IDLEHAX.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -97,7 +98,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(CONNECTPOLYS
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 23-Aug-2022 08:10 by larry")
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 12-Jan-2022 15:22 by larry")
|
||||
(* lmm "30-Jul-85 17:19")
|
||||
(PROG (DIFFS)
|
||||
(CLEARW W)
|
||||
@@ -119,8 +120,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(fetch YC of FPT)
|
||||
(fetch XC of TPT)
|
||||
(fetch YC of TPT)
|
||||
1 OPERATION W)
|
||||
(DISMISS POLYGONWAIT2))
|
||||
1 OPERATION W))
|
||||
(DISMISS POLYGONWAIT2)
|
||||
(CLEARW W)
|
||||
(for I from 1 to POLYGONSTEPS do (DISMISS POLYGONWAIT3)
|
||||
(LINES2 FROMS 1 W OPERATION)
|
||||
@@ -147,7 +148,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
|
||||
(RPAQ? POLYGONSWINDOW )
|
||||
|
||||
(RPAQQ POLYGONWAIT2 25)
|
||||
(RPAQQ POLYGONWAIT2 250)
|
||||
|
||||
(RPAQQ POLYGONMINPTS 3)
|
||||
|
||||
@@ -190,67 +191,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(KALDEMO
|
||||
[LAMBDA (W PERIOD PERSISTENCE) (* ; "Edited 23-Aug-2022 08:49 by lmm")
|
||||
(* lmm " 5-Aug-85 22:16")
|
||||
(OR PERIOD (SETQ PERIOD (RAND 16 128)))
|
||||
[OR PERSISTENCE (SETQ PERSISTENCE (LSH 1 (RAND 14 23]
|
||||
(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 'HEIGHT)
|
||||
(WINDOWPROP W 'WIDTH]
|
||||
(TIMER (SETUPTIMER 0 NIL 'TICKS))
|
||||
(BLACK (NOT (VIDEOCOLOR)))
|
||||
XOFFSET)
|
||||
(SETQ XOFFSET (QUOTIENT (MAX (DIFFERENCE (WINDOWPROP W '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)
|
||||
(BLOCK 100 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])
|
||||
(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) (* ; "Edited 26-Jun-2022 18:20 by rmk")
|
||||
@@ -289,59 +231,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(BUBBLES
|
||||
[LAMBDA (W) (* ; "Edited 23-Aug-2022 08:14 by larry")
|
||||
(* lmm "30-Jul-85 20:35")
|
||||
[WINDOWPROP (SETQ W (DEMOWINDOW W))
|
||||
'RESHAPEFN
|
||||
(FUNCTION (LAMBDA (W)
|
||||
(DSPFILL NIL (if (VIDEOCOLOR)
|
||||
then WHITESHADE
|
||||
else BLACKSHADE)
|
||||
'REPLACE W]
|
||||
(DSPFILL NIL (if (VIDEOCOLOR)
|
||||
then WHITESHADE
|
||||
else BLACKSHADE)
|
||||
'REPLACE W)
|
||||
(bind (ARRAY _ (ARRAY BUBBLECNT '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 'ERASE
|
||||
else '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 '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 'INVERT W)
|
||||
(DRAWCIRCLE (CAR CIRCLE)
|
||||
(CADR CIRCLE)
|
||||
(CADDR CIRCLE)
|
||||
NIL NIL W)
|
||||
(BLOCK 100])
|
||||
(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)))))
|
||||
@@ -352,32 +243,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-WINDOWS
|
||||
[LAMBDA (W DELAY) (* ; "Edited 23-Aug-2022 08:35 by lmm")
|
||||
(* lmm " 7-Jun-86 22:21")
|
||||
(SETQ W (DEMOWINDOW W))
|
||||
(PROG [(D (WINDOWPROP W 'WIDTH))
|
||||
(H (WINDOWPROP W 'HEIGHT]
|
||||
(LET [(TITLE (WINDOWPROP (CREATEW (LIST 0 0 D (HEIGHTIFWINDOW 0 T))
|
||||
"Yet another window" NIL T)
|
||||
'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 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT NIL NIL NIL W X Y 2 H0 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT NIL NIL NIL W (+ X (- D0 2))
|
||||
Y 2 H0 'TEXTURE 'REPLACE BLACKSHADE)
|
||||
(BITBLT TITLE NIL (+ WBorder (QUOTIENT WBorder 2))
|
||||
W X (+ Y H0)
|
||||
D0 NIL NIL 'REPLACE)
|
||||
(BITBLT NIL NIL NIL W (+ X 2)
|
||||
(+ Y 2)
|
||||
(- D0 (+ 2 2))
|
||||
(- H0 2)
|
||||
'TEXTURE
|
||||
'ERASE BLACKSHADE)))
|
||||
(BLOCK (OR DELAY 500])
|
||||
(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))))))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
@@ -391,18 +258,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(LINES1
|
||||
[LAMBDA (ENDPOINTS LINES DSP) (* ; "Edited 23-Aug-2022 07:59 by larry")
|
||||
(* lmm "30-Jul-85 17:33")
|
||||
(PROG (PTS)
|
||||
[COND
|
||||
((SETQ PTS (CAR LINES)) (* ERASE OLD)
|
||||
(LINES3 (CAR LINES)
|
||||
1 DSP 'INVERT ENDPOINTS))
|
||||
(T [RPLACA LINES (SETQ PTS (in ENDPOINTS collect (create NPOINT]
|
||||
(LINES2 ENDPOINTS 1 DSP 'INVERT]
|
||||
(BLOCK 75)
|
||||
(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])
|
||||
(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)))
|
||||
@@ -426,20 +283,8 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(WARP
|
||||
[LAMBDA (W) (* ; "Edited 23-Aug-2022 08:01 by larry")
|
||||
(* hdj " 1-Apr-86 14:22")
|
||||
(do (CLEARW W)
|
||||
(LET ((OLDOP (DSPOPERATION 'INVERT W)))
|
||||
[LET [(WIDTH (WINDOWPROP W 'WIDTH))
|
||||
(HEIGHT (WINDOWPROP W '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 75]
|
||||
(DSPOPERATION OLDOP W])
|
||||
(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))))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
@@ -449,8 +294,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-MELT
|
||||
[LAMBDA (WINDOW SIZE INITIAL PATH) (* ; "Edited 23-Aug-2022 08:20 by larry")
|
||||
(* ; "Edited 10-Jun-88 17:15 by MASINTER")
|
||||
[LAMBDA (WINDOW SIZE INITIAL PATH) (* ; "Edited 10-Jun-88 17:15 by MASINTER")
|
||||
(OR SIZE (SETQ SIZE MELT-BLOCK-SIZE))
|
||||
(SETQ WINDOW (DEMOWINDOW WINDOW))
|
||||
(PROG ((W (WINDOWPROP WINDOW 'WIDTH))
|
||||
@@ -463,34 +307,37 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
[SETQ BM (OR (CAR TAIL)
|
||||
(WINDOWPROP WINDOW '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)))
|
||||
NIL NIL (if (VIDEOCOLOR)
|
||||
then NIL
|
||||
else 'INVERT)
|
||||
'REPLACE))
|
||||
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)))
|
||||
NIL NIL (if (VIDEOCOLOR)
|
||||
then NIL
|
||||
else 'INVERT)
|
||||
'REPLACE))
|
||||
(if INITIAL
|
||||
then [SETQ TIMER (AND (CADR TAIL)
|
||||
(SETUPTIMER (CADR TAIL)
|
||||
TIMER
|
||||
'SECONDS
|
||||
'SECONDS]
|
||||
(SETQ TAIL (OR (CDDR TAIL)
|
||||
INITIAL)))
|
||||
(SETUPTIMER (CADR TAIL)
|
||||
TIMER
|
||||
'SECONDS
|
||||
'SECONDS]
|
||||
(SETQ TAIL (OR (CDDR TAIL)
|
||||
INITIAL)))
|
||||
[do (LET [(X (RAND 0 (- W SIZE)))
|
||||
(Y (RAND 0 (- H SIZE]
|
||||
(BITBLT WINDOW X Y WINDOW (+ X (RAND -1 1))
|
||||
(+ Y (RAND -1 1))
|
||||
SIZE SIZE NIL 'REPLACE))
|
||||
(BLOCK 100) repeatuntil (AND TIMER (TIMEREXPIRED? TIMER 'SECONDS]
|
||||
(Y (RAND 0 (- H SIZE]
|
||||
(BITBLT WINDOW X Y WINDOW (+ X (RAND -1 1))
|
||||
(+ Y (RAND -1 1))
|
||||
SIZE SIZE NIL 'REPLACE))
|
||||
(BLOCK) repeatuntil (AND TIMER (TIMEREXPIRED? TIMER 'SECONDS]
|
||||
(GO REPAINT])
|
||||
|
||||
(IDLE-SLIDE
|
||||
[LAMBDA (W SIZE SPEED COUNT SOURCE) (* ; "Edited 10-Jun-88 17:12 by MASINTER")
|
||||
[LAMBDA (W SIZE SPEED COUNT SOURCE) (* ; "Edited 10-Jun-88 17:12 by MASINTER")
|
||||
(OR SIZE (SETQ SIZE 128))
|
||||
(OR COUNT (SETQ COUNT 120))
|
||||
(OR SPEED (SETQ SPEED 2))
|
||||
@@ -507,28 +354,28 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
X Y DX DY (CNT 1)
|
||||
DDX DDY (TIMER (SETUPTIMER 0 NIL '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 'REPLACE)
|
||||
(SETQ DDX DY)
|
||||
(SETQ DDY DX)
|
||||
(SETQ CNT COUNT)))
|
||||
(BITBLT W X Y W (+ X DDX)
|
||||
(+ Y DDY)
|
||||
SIZE SIZE NIL 'REPLACE)
|
||||
(add X DX)
|
||||
(add Y DY)
|
||||
(PERIODIC.BLOCK TIMER])
|
||||
((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 'REPLACE)
|
||||
(SETQ DDX DY)
|
||||
(SETQ DDY DX)
|
||||
(SETQ CNT COUNT)))
|
||||
(BITBLT W X Y W (+ X DDX)
|
||||
(+ Y DDY)
|
||||
SIZE SIZE NIL 'REPLACE)
|
||||
(add X DX)
|
||||
(add Y DY)
|
||||
(PERIODIC.BLOCK TIMER])
|
||||
)
|
||||
|
||||
(RPAQQ MELT-BLOCK-SIZE 32)
|
||||
@@ -552,16 +399,17 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PERIODIC.BLOCK MACRO ((TIMER)
|
||||
(BLOCK 100 TIMER)))
|
||||
(PUTPROPS PERIODIC.BLOCK MACRO [(TIMER)
|
||||
(if (TIMEREXPIRED? TIMER 'TICKS)
|
||||
then (BLOCK)
|
||||
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
|
||||
)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Drain" 'IDLE-DRAIN))
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-DRAIN
|
||||
[LAMBDA (WINDOW) (* ; "Edited 23-Aug-2022 07:52 by larry")
|
||||
(* hdj "28-May-86 11:52")
|
||||
[LAMBDA (WINDOW) (* hdj "28-May-86 11:52")
|
||||
(do (BITBLT (WINDOWPROP WINDOW 'IMAGECOVERED)
|
||||
NIL NIL WINDOW NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
(LET* ((WIDTH (WINDOWPROP WINDOW 'WIDTH))
|
||||
@@ -569,7 +417,7 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(HALF-WIDTH (IQUOTIENT WIDTH 2))
|
||||
(HALF-HEIGHT (IQUOTIENT HEIGHT 2)))
|
||||
(for EDGE from 0 to (MIN HALF-WIDTH HALF-HEIGHT)
|
||||
do (BLOCK 100)
|
||||
do (BLOCK)
|
||||
(BITBLT WINDOW EDGE 0 WINDOW (PLUS 1 EDGE)
|
||||
0
|
||||
(- HALF-WIDTH EDGE)
|
||||
@@ -632,12 +480,12 @@ Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Swap" 'IDLE-SWAP))
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3859 7936 (POLYGONSDEMO 3869 . 4039) (POLYGONS 4041 . 4405) (CONNECTPOLYS 4407 . 6842)
|
||||
(DRAWPOLY1 6844 . 7481) (RANDOMPT 7483 . 7934)) (8572 13651 (KALDEMO 8582 . 11557) (KAL.ADVANCE 11559
|
||||
. 12493) (KAL.SPOTS 12495 . 12836) (KAL.BMS 12838 . 13325) (KAL.ORAND 13327 . 13649)) (13688 17534 (
|
||||
BUBBLES 13698 . 17164) (BUBBLE.CREATE 17166 . 17532)) (17561 19344 (IDLE-WINDOWS 17571 . 19342)) (
|
||||
19379 22047 (LINES 19389 . 20448) (LINES1 20450 . 21257) (LINES2 21259 . 21570) (LINES3 21572 . 22045)
|
||||
) (22107 23728 (WALKINGSPOKE 22117 . 22898) (WARP 22900 . 23726)) (23753 27654 (IDLE-MELT 23763 .
|
||||
25975) (IDLE-SLIDE 25977 . 27652)) (27825 28071 (DEMOWINDOW 27835 . 28069)) (28315 30301 (IDLE-DRAIN
|
||||
28325 . 30299)) (30333 31814 (IDLE-SWAP 30343 . 31812)))))
|
||||
(FILEMAP (NIL (3812 7852 (POLYGONSDEMO 3822 . 3992) (POLYGONS 3994 . 4358) (CONNECTPOLYS 4360 . 6758)
|
||||
(DRAWPOLY1 6760 . 7397) (RANDOMPT 7399 . 7850)) (8489 12004 (KALDEMO 8499 . 9910) (KAL.ADVANCE 9912 .
|
||||
10846) (KAL.SPOTS 10848 . 11189) (KAL.BMS 11191 . 11678) (KAL.ORAND 11680 . 12002)) (12041 13527 (
|
||||
BUBBLES 12051 . 13157) (BUBBLE.CREATE 13159 . 13525)) (13554 14539 (IDLE-WINDOWS 13564 . 14537)) (
|
||||
14574 16845 (LINES 14584 . 15643) (LINES1 15645 . 16055) (LINES2 16057 . 16368) (LINES3 16370 . 16843)
|
||||
) (16905 18118 (WALKINGSPOKE 16915 . 17696) (WARP 17698 . 18116)) (18143 22426 (IDLE-MELT 18153 .
|
||||
20669) (IDLE-SLIDE 20671 . 22424)) (22597 22843 (DEMOWINDOW 22607 . 22841)) (23255 25128 (IDLE-DRAIN
|
||||
23265 . 25126)) (25160 26641 (IDLE-SWAP 25170 . 26639)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user