github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-13 15:37:38 +00:00
Code Issues Projects Releases Wiki Activity

IDLE will LOGOUT instead of SAVEVM if ONLINEP (#904)

Browse Source 
* IDLE will LOGOUT instead of SAVEVM if ONLINEP
* patched some idle hacks fora  better show
* idle.random chooses an idle program at random among those loaded
This commit is contained in:
Larry Masinter 2022-08-26 11:27:48 -07:00 committed by GitHub
parent f4c91ec419
commit fad70d4947
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 738 additions and 484 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

645
lispusers/HANOI
View File

@ -1,70 +1,74 @@
(FILECREATED "25-Feb-86 19:07:01" {ERIS}<LISPUSERS>KOTO>HANOI.;7 19947 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to: (VARS HANOICOMS) (FILECREATED "21-Aug-2022 18:08:56" {DSK}<home>larry>medley>lispusers>HANOI.;2 22228
previous date: "17-Feb-86 14:59:01" {ERIS}<LISPUSERS>KOTO>HANOI.;5) :CHANGES-TO (VARS HANOICOMS)
:PREVIOUS-DATE "25-Feb-86 19:07:01" {DSK}<home>larry>medley>lispusers>HANOI.;1)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.) (* ; "
Copyright (c) 1982-1986 by Xerox Corporation.
")
(PRETTYCOMPRINT HANOICOMS) (PRETTYCOMPRINT HANOICOMS)
(RPAQQ HANOICOMS ((FNS DISPLAYPEGSANDRINGS DOHANOI FINDOTHER HANOI HANOIDEMO MOVEDIS MOVERING (RPAQQ HANOICOMS
RINGSHADE SETUPRINGBITMAPS TRACK WHANOI XHANOI) ((FNS DISPLAYPEGSANDRINGS DOHANOI FINDOTHER HANOI HANOIDEMO MOVEDIS MOVERING RINGSHADE
(VARS (HANOIWINDOW)) SETUPRINGBITMAPS TRACK WHANOI XHANOI)
(DECLARE: DONTCOPY (RECORDS PEG RING) (VARS (HANOIWINDOW))
(CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE) (DECLARE%: DONTCOPY (RECORDS PEG RING)
(CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30) (CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE)
(MAXHORIZSPEED 44)) (CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30)
(MACROS PEGN)) (MAXHORIZSPEED 44))
(VARS EVENRINGSHADE ODDRINGSHADE PEGSHADE) (MACROS PEGN))
(ALISTS (IDLE.FUNCTIONS Hanoi HanoiUsername)))) (VARS EVENRINGSHADE ODDRINGSHADE PEGSHADE)
(ALISTS (IDLE.FUNCTIONS Hanoi HanoiUsername))))
(DEFINEQ (DEFINEQ
(DISPLAYPEGSANDRINGS (DISPLAYPEGSANDRINGS
[LAMBDA (PEGS W) (* edited: " 1-Oct-84 12:41") [LAMBDA (PEGS W) (* edited%: " 1-Oct-84 12:41")
(* displays the pegs and the rings on them.) (* displays the pegs and the rings on
(for PEG in PEGS  them.)
do (\CLEARBM W PEGSHADE (fetch PEGREGION of PEG)) (for PEG in PEGS do (\CLEARBM W PEGSHADE (fetch PEGREGION of PEG))
(for RING in (fetch RINGS of PEG) (for RING in (fetch RINGS of PEG)
do (\CLEARBM W (RINGSHADE (fetch RINGNUMBER of RING)) do (\CLEARBM W (RINGSHADE (fetch RINGNUMBER of RING))
(fetch RINGREGION of RING)) (fetch RINGREGION of RING))
(COND (COND
((fetch RINGLABEL of RING) ((fetch RINGLABEL of RING)
(CENTERPRINTINREGION (fetch RINGLABEL of RING) (CENTERPRINTINREGION (fetch RINGLABEL of RING)
(fetch RINGREGION of RING) (fetch RINGREGION of RING)
W]) W])
(DOHANOI (DOHANOI
[LAMBDA (N SRC DST W) (* lmm " 8-MAR-82 12:05") [LAMBDA (N SRC DST W) (* lmm " 8-MAR-82 12:05")
(COND (COND
((EQ N 1) ((EQ N 1)
(MOVERING SRC DST W)) (MOVERING SRC DST W))
(T (DOHANOI (SUB1 N) (T (DOHANOI (SUB1 N)
SRC SRC
(FINDOTHER SRC DST) (FINDOTHER SRC DST)
W) W)
(MOVERING SRC DST W) (MOVERING SRC DST W)
(DOHANOI (SUB1 N) (DOHANOI (SUB1 N)
(FINDOTHER SRC DST) (FINDOTHER SRC DST)
DST W]) DST W])
(FINDOTHER (FINDOTHER
[LAMBDA (S D) (* bas: "10-DEC-80 14:01") [LAMBDA (S D) (* bas%: "10-DEC-80 14:01")
(for Z from 1 to 3 thereis (NOT (OR (EQ Z S) (for Z from 1 to 3 thereis (NOT (OR (EQ Z S)
(EQ Z D]) (EQ Z D])
(HANOI (HANOI
[LAMBDA (NRINGS WINDOW FONT ONCE) (* lmm " 9-MAR-82 09:52") [LAMBDA (NRINGS WINDOW FONT ONCE) (* lmm " 9-MAR-82 09:52")
(WHANOI NRINGS WINDOW FONT ONCE]) (WHANOI NRINGS WINDOW FONT ONCE])
(HANOIDEMO (HANOIDEMO
[LAMBDA NIL (* lmm [LAMBDA NIL (* lmm "17-Feb-86 14:58")
"17-Feb-86 14:58")
(PROG (HANOI.MOUSE.SPEED) (PROG (HANOI.MOUSE.SPEED)
(WHANOI 7 (WHANOI 7
[COND [COND
((TYPENAMEP HANOIWINDOW (QUOTE WINDOW)) ((TYPENAMEP HANOIWINDOW 'WINDOW)
HANOIWINDOW) HANOIWINDOW)
(T (SETQ HANOIWINDOW (T (SETQ HANOIWINDOW
(CREATEW (create REGION (CREATEW (create REGION
@ -75,18 +79,16 @@
NIL T]) NIL T])
(MOVEDIS (MOVEDIS
[LAMBDA (RING DY SX DX W) (* lmm [LAMBDA (RING DY SX DX W) (* lmm "17-Feb-86 14:58")
"17-Feb-86 14:58")
(* moves RING from its position on the source peg whose left is SX to the peg
(* moves RING from its position on the source peg whose left is SX to  whose left is DX at a height of DY)
the peg whose left is DX at a height of DY)
(PROG ((RINGREGION (fetch RINGREGION of RING)) (PROG ((RINGREGION (fetch RINGREGION of RING))
RINGWIDTH HORIZWIDTH MOVERIGHTFLG) RINGWIDTH HORIZWIDTH MOVERIGHTFLG)
[COND [COND
(HANOI.MOUSE.SPEED (GETMOUSESTATE) (* IPLUS 16 is (HANOI.MOUSE.SPEED (GETMOUSESTATE) (* IPLUS 16 is because cursor can go
because cursor can go  negative.)
negative.)
(SETQ VERTSPEED (IMIN (IMAX (IDIFFERENCE 17 (IQUOTIENT LASTMOUSEY 50)) (SETQ VERTSPEED (IMIN (IMAX (IDIFFERENCE 17 (IQUOTIENT LASTMOUSEY 50))
1) 1)
MAXVERTSPEED)) MAXVERTSPEED))
@ -95,333 +97,298 @@
MAXHORIZSPEED] MAXHORIZSPEED]
(SETUPRINGBITMAPS RING (SETQ RINGWIDTH (fetch WIDTH of RINGREGION)) (SETUPRINGBITMAPS RING (SETQ RINGWIDTH (fetch WIDTH of RINGREGION))
(SETQ MOVERIGHTFLG (IGREATERP DX SX)) (SETQ MOVERIGHTFLG (IGREATERP DX SX))
W) (* PROG is because W) (* PROG is because FOR loop bug.)
FOR loop bug.)
(PROG ((I (fetch BOTTOM of RINGREGION)) (PROG ((I (fetch BOTTOM of RINGREGION))
(TOPLIMIT (IDIFFERENCE PEGTOP VERTSPEED))) (TOPLIMIT (IDIFFERENCE PEGTOP VERTSPEED)))
LP (COND LP (COND
((IGREATERP TOPLIMIT I) ((IGREATERP TOPLIMIT I)
(BITBLT UPRINGBM 0 0 W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED) (BITBLT UPRINGBM 0 0 W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE)) 'REPLACE)
(SETQ I (IPLUS VERTSPEED I)) (SETQ I (IPLUS VERTSPEED I))
(GO LP))) (GO LP)))
(BITBLT UPRINGBM 0 (IDIFFERENCE I TOPLIMIT) (BITBLT UPRINGBM 0 (IDIFFERENCE I TOPLIMIT)
W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED) W SX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE))) 'REPLACE))
(BITBLT TOPUPRINGBM 0 0 W SX PEGTOP RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED) (BITBLT TOPUPRINGBM 0 0 W SX PEGTOP RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE)) 'REPLACE)
(SETQ HORIZWIDTH (IPLUS RINGWIDTH HORIZSPEED)) (SETQ HORIZWIDTH (IPLUS RINGWIDTH HORIZSPEED))
(for I from (COND (for I from (COND
(MOVERIGHTFLG SX) (MOVERIGHTFLG SX)
(T (IDIFFERENCE SX HORIZSPEED))) (T (IDIFFERENCE SX HORIZSPEED)))
to (COND to (COND
(MOVERIGHTFLG (SUB1 (IDIFFERENCE DX HORIZSPEED))) (MOVERIGHTFLG (SUB1 (IDIFFERENCE DX HORIZSPEED)))
(T (ADD1 DX))) by (ITIMES (COND (T (ADD1 DX))) by (ITIMES (COND
((IGREATERP DX SX) ((IGREATERP DX SX)
1) 1)
(T -1)) (T -1))
HORIZSPEED) HORIZSPEED) do (BITBLT HORIZRINGBM 0 0 W I
do (BITBLT HORIZRINGBM 0 0 W I (IPLUS PEGTOP VERTSPEED) (IPLUS PEGTOP VERTSPEED)
HORIZWIDTH RINGHEIGHT (QUOTE INPUT) HORIZWIDTH RINGHEIGHT 'INPUT
(QUOTE REPLACE))) 'REPLACE))
(BITBLT HORIZRINGBM 0 0 W (COND (BITBLT HORIZRINGBM 0 0 W (COND
(MOVERIGHTFLG (IDIFFERENCE DX HORIZSPEED)) (MOVERIGHTFLG (IDIFFERENCE DX HORIZSPEED))
(T DX)) (T DX))
(IPLUS PEGTOP VERTSPEED) (IPLUS PEGTOP VERTSPEED)
HORIZWIDTH NIL (QUOTE INPUT) HORIZWIDTH NIL 'INPUT 'REPLACE) (* Update the ring region's left)
(QUOTE REPLACE)) (* Update the ring
region's left)
(replace LEFT of RINGREGION with (IPLUS (fetch LEFT of RINGREGION) (replace LEFT of RINGREGION with (IPLUS (fetch LEFT of RINGREGION)
(IDIFFERENCE DX SX))) (IDIFFERENCE DX SX)))
(for I from PEGTOP to (SUB1 (IDIFFERENCE PEGTOP RINGHEIGHT)) (for I from PEGTOP to (SUB1 (IDIFFERENCE PEGTOP RINGHEIGHT)) by (IMINUS VERTSPEED)
by (IMINUS VERTSPEED) do (BITBLT TOPDOWNRINGBM NIL NIL W DX I RINGWIDTH do (BITBLT TOPDOWNRINGBM NIL NIL W DX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
(IPLUS RINGHEIGHT VERTSPEED) 'INPUT
(QUOTE INPUT) 'REPLACE))
(QUOTE REPLACE)))
(BITBLT TOPDOWNRINGBM NIL NIL W DX (IDIFFERENCE PEGTOP RINGHEIGHT) (BITBLT TOPDOWNRINGBM NIL NIL W DX (IDIFFERENCE PEGTOP RINGHEIGHT)
RINGWIDTH RINGWIDTH
(IPLUS RINGHEIGHT VERTSPEED) (IPLUS RINGHEIGHT VERTSPEED)
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE)) 'REPLACE)
(PROG [(I (IDIFFERENCE PEGTOP (IPLUS VERTSPEED RINGHEIGHT] (PROG [(I (IDIFFERENCE PEGTOP (IPLUS VERTSPEED RINGHEIGHT]
LP (COND LP (COND
((IGREATERP DY I) (* blt last ring ((IGREATERP DY I) (* blt last ring image)
image)
(BITBLT DOWNRINGBM 0 0 W DX DY RINGWIDTH (COND (BITBLT DOWNRINGBM 0 0 W DX DY RINGWIDTH (COND
((IGREATERP VERTSPEED RINGHEIGHT) ((IGREATERP VERTSPEED RINGHEIGHT)
(IDIFFERENCE (IPLUS RINGHEIGHT (IDIFFERENCE (IPLUS RINGHEIGHT
VERTSPEED) VERTSPEED)
(IDIFFERENCE DY I))) (IDIFFERENCE DY I)))
(T (IPLUS RINGHEIGHT VERTSPEED))) (T (IPLUS RINGHEIGHT VERTSPEED)))
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE)) 'REPLACE)
(RETURN))) (RETURN)))
(BITBLT DOWNRINGBM 0 0 W DX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED) (BITBLT DOWNRINGBM 0 0 W DX I RINGWIDTH (IPLUS RINGHEIGHT VERTSPEED)
(QUOTE INPUT) 'INPUT
(QUOTE REPLACE)) 'REPLACE)
(SETQ I (IDIFFERENCE I VERTSPEED)) (SETQ I (IDIFFERENCE I VERTSPEED))
(GO LP)) (GO LP))
(replace BOTTOM of RINGREGION with DY) (replace BOTTOM of RINGREGION with DY)
(RETURN RING]) (RETURN RING])
(MOVERING (MOVERING
[LAMBDA (SRC DST W) (* rrb " 2-AUG-82 17:41") [LAMBDA (SRC DST W) (* rrb " 2-AUG-82 17:41")
(PROG ([X (fetch RINGREGION of (CAR (fetch RINGS of (PEGN DST] (PROG ([X (fetch RINGREGION of (CAR (fetch RINGS of (PEGN DST]
RING) RING)
(push (fetch RINGS of (PEGN DST)) (push (fetch RINGS of (PEGN DST))
(MOVEDIS [SETQ RING (pop (fetch RINGS of (PEGN SRC] (MOVEDIS [SETQ RING (pop (fetch RINGS of (PEGN SRC]
(IPLUS (fetch BOTTOM of X) (IPLUS (fetch BOTTOM of X)
(fetch HEIGHT of X)) (fetch HEIGHT of X))
(TRACK SRC (fetch RINGREGION of RING)) (TRACK SRC (fetch RINGREGION of RING))
(TRACK DST (fetch RINGREGION of RING)) (TRACK DST (fetch RINGREGION of RING))
W)) W))
(BLOCK]) (BLOCK])
(RINGSHADE (RINGSHADE
[LAMBDA (RINGN) (* rrb " 9-JUN-81 15:11") [LAMBDA (RINGN) (* rrb " 9-JUN-81 15:11")
(COND (COND
((EQ RINGN (QUOTE BASE)) ((EQ RINGN 'BASE)
PEGSHADE) PEGSHADE)
((ZEROP (LOGAND RINGN 1)) ((ZEROP (LOGAND RINGN 1))
EVENRINGSHADE) EVENRINGSHADE)
(T ODDRINGSHADE]) (T ODDRINGSHADE])
(SETUPRINGBITMAPS (SETUPRINGBITMAPS
[LAMBDA (RING RINGWIDTH MOVERIGHTFLG W) (* edited: " 1-Oct-84 12:43") [LAMBDA (RING RINGWIDTH MOVERIGHTFLG W) (* edited%: " 1-Oct-84 12:43")
(* sets up the ring bitmaps. There are 5 ring bitmaps: up while on peg, up above peg, horizontal, down above peg and (* sets up the ring bitmaps. There are 5 ring bitmaps%: up while on peg, up above
down while on peg.)  peg, horizontal, down above peg and down while on peg.)
(PROG ((PEGOFFSET (IQUOTIENT (IDIFFERENCE RINGWIDTH PEGWIDTH)
(PROG ((PEGOFFSET (IQUOTIENT (IDIFFERENCE RINGWIDTH PEGWIDTH) 2))
2)) (RINGREGION (fetch RINGREGION of RING))
(RINGREGION (fetch RINGREGION of RING)) (RINGN (fetch RINGNUMBER of RING)))
(RINGN (fetch RINGNUMBER of RING))) (AND FONT (DSPFONT FONT RDEST))
(AND FONT (DSPFONT FONT RDEST)) (DSPOPERATION 'ERASE RDEST)
(DSPOPERATION (QUOTE ERASE) [PROGN (\CLEARBM UPRINGBM)
RDEST) (BITBLT NIL NIL NIL UPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
[PROGN (\CLEARBM UPRINGBM) (RINGSHADE RINGN)) (* put in peg)
(BITBLT NIL NIL NIL UPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT (QUOTE TEXTURE) (BITBLT NIL NIL NIL UPRINGBM PEGOFFSET 0 PEGWIDTH VERTSPEED 'TEXTURE 'REPLACE
(QUOTE REPLACE) PEGSHADE)
(RINGSHADE RINGN)) (* put in peg) (COND
(BITBLT NIL NIL NIL UPRINGBM PEGOFFSET 0 PEGWIDTH VERTSPEED (QUOTE TEXTURE) ((fetch RINGLABEL of RING) (* print in label if there is one.)
(QUOTE REPLACE) (DSPDESTINATION UPRINGBM RDEST)
PEGSHADE) (CENTERPRINTINAREA (fetch RINGLABEL of RING)
(COND 0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
((fetch RINGLABEL of RING) (* print in label if there is one.) [PROGN (\CLEARBM TOPUPRINGBM)
(DSPDESTINATION UPRINGBM RDEST) (BITBLT NIL NIL NIL TOPUPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT 'TEXTURE
(CENTERPRINTINAREA (fetch RINGLABEL of RING) 'REPLACE
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST] (RINGSHADE RINGN))
[PROGN (\CLEARBM TOPUPRINGBM) (COND
(BITBLT NIL NIL NIL TOPUPRINGBM 0 VERTSPEED RINGWIDTH RINGHEIGHT (QUOTE TEXTURE) ((fetch RINGLABEL of RING) (* print in label if there is one.)
(QUOTE REPLACE) (DSPDESTINATION TOPUPRINGBM RDEST)
(RINGSHADE RINGN)) (CENTERPRINTINAREA (fetch RINGLABEL of RING)
(COND 0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST]
((fetch RINGLABEL of RING) (* print in label if there is one.) (PROGN (\CLEARBM DOWNRINGBM)
(DSPDESTINATION TOPUPRINGBM RDEST) (BITBLT NIL NIL NIL DOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
(CENTERPRINTINAREA (fetch RINGLABEL of RING) (RINGSHADE RINGN))
0 VERTSPEED RINGWIDTH RINGHEIGHT RDEST] (COND
(PROGN (\CLEARBM DOWNRINGBM) ((fetch RINGLABEL of RING) (* print in label if there is one.)
(BITBLT NIL NIL NIL DOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE) (DSPDESTINATION DOWNRINGBM RDEST)
(QUOTE REPLACE) (CENTERPRINTINAREA (fetch RINGLABEL of RING)
(RINGSHADE RINGN)) 0 0 RINGWIDTH RINGHEIGHT RDEST)))(* put in peg)
(COND (BITBLT NIL NIL NIL DOWNRINGBM PEGOFFSET RINGHEIGHT PEGWIDTH VERTSPEED 'TEXTURE
((fetch RINGLABEL of RING) (* print in label if there is one.) 'REPLACE PEGSHADE))
(DSPDESTINATION DOWNRINGBM RDEST) [PROGN (\CLEARBM TOPDOWNRINGBM)
(CENTERPRINTINAREA (fetch RINGLABEL of RING) (BITBLT NIL NIL NIL TOPDOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE
0 0 RINGWIDTH RINGHEIGHT RDEST))) (RINGSHADE RINGN))
(* put in peg) (COND
(BITBLT NIL NIL NIL DOWNRINGBM PEGOFFSET RINGHEIGHT PEGWIDTH VERTSPEED (QUOTE ((fetch RINGLABEL of RING) (* print in label if there is one.)
TEXTURE) (DSPDESTINATION TOPDOWNRINGBM RDEST)
(QUOTE REPLACE) (CENTERPRINTINAREA (fetch RINGLABEL of RING)
PEGSHADE)) 0 0 RINGWIDTH RINGHEIGHT RDEST]
[PROGN (\CLEARBM TOPDOWNRINGBM) [PROGN (\CLEARBM HORIZRINGBM)
(BITBLT NIL NIL NIL TOPDOWNRINGBM 0 0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE) (BITBLT NIL NIL NIL HORIZRINGBM (COND
(QUOTE REPLACE) (MOVERIGHTFLG HORIZSPEED)
(RINGSHADE RINGN)) (T 0))
(COND 0 RINGWIDTH RINGHEIGHT 'TEXTURE 'REPLACE (RINGSHADE RINGN))
((fetch RINGLABEL of RING) (* print in label if there is one.) (COND
(DSPDESTINATION TOPDOWNRINGBM RDEST) ((fetch RINGLABEL of RING) (* print in label if there is one.)
(CENTERPRINTINAREA (fetch RINGLABEL of RING) (DSPDESTINATION HORIZRINGBM RDEST)
0 0 RINGWIDTH RINGHEIGHT RDEST] (CENTERPRINTINAREA (fetch RINGLABEL of RING)
[PROGN (\CLEARBM HORIZRINGBM) (COND
(BITBLT NIL NIL NIL HORIZRINGBM (COND (MOVERIGHTFLG HORIZSPEED)
(MOVERIGHTFLG HORIZSPEED) (T 0))
(T 0)) 0 RINGWIDTH RINGHEIGHT RDEST]
0 RINGWIDTH RINGHEIGHT (QUOTE TEXTURE) (RETURN])
(QUOTE REPLACE)
(RINGSHADE RINGN))
(COND
((fetch RINGLABEL of RING) (* print in label if there is one.)
(DSPDESTINATION HORIZRINGBM RDEST)
(CENTERPRINTINAREA (fetch RINGLABEL of RING)
(COND
(MOVERIGHTFLG HORIZSPEED)
(T 0))
0 RINGWIDTH RINGHEIGHT RDEST]
(RETURN])
(TRACK (TRACK
[LAMBDA (PN REGION) (* lmm " 8-MAR-82 12:10") [LAMBDA (PN REGION) (* lmm " 8-MAR-82 12:10")
(* returns the track offset for ring movement on a  (* returns the track offset for ring
peg.)  movement on a peg.)
(IPLUS HANOIMARGIN (IPLUS (ITIMES RINGLARGEST (SUB1 PN)) (IPLUS HANOIMARGIN (IPLUS (ITIMES RINGLARGEST (SUB1 PN))
(IQUOTIENT (IDIFFERENCE RINGLARGEST (fetch WIDTH of REGION)) (IQUOTIENT (IDIFFERENCE RINGLARGEST (fetch WIDTH of REGION))
2]) 2])
(WHANOI (WHANOI
[LAMBDA (RINGS W FONT ONCE) (* lmm " 3-Dec-85 12:51") [LAMBDA (RINGS W FONT ONCE) (* lmm " 3-Dec-85 12:51")
(* runs hanoi in a region of a displaystream) (* runs hanoi in a region of a
(PROG ([REGION (DSPCLIPPINGREGION NIL (SETQ W (COND  displaystream)
[(NULL W) (PROG ([REGION (DSPCLIPPINGREGION NIL (SETQ W (COND
(OR HANOIWINDOW (SETQ HANOIWINDOW (CREATEW] [(NULL W)
((WINDOWP W)) (OR HANOIWINDOW (SETQ HANOIWINDOW (CREATEW]
(T (CREATEW W] ((WINDOWP W))
[NRINGS (COND (T (CREATEW W]
((NUMBERP RINGS) [NRINGS (COND
RINGS) ((NUMBERP RINGS)
(T (LENGTH RINGS] RINGS)
(HORIZSPEED 21) (T (LENGTH RINGS]
(VERTSPEED 17) (HORIZSPEED 21)
PEGS RINGBM TOPUPRINGBM RINGLARGEST TOPDOWNRINGBM PEGWIDTH BASEWIDTH RINGHEIGHT (VERTSPEED 17)
MOVEMENTHEIGHT BASEHEIGHT PEGTOP RINGDISPLAYSTREAM HANOIWINDOW RINGDELTA UPRINGBM PEGS RINGBM TOPUPRINGBM RINGLARGEST TOPDOWNRINGBM PEGWIDTH BASEWIDTH RINGHEIGHT
HORIZRINGBM DOWNRINGBM (RDEST (DSPCREATE))) MOVEMENTHEIGHT BASEHEIGHT PEGTOP RINGDISPLAYSTREAM HANOIWINDOW RINGDELTA UPRINGBM
(DECLARE (SPECVARS . T)) HORIZRINGBM DOWNRINGBM (RDEST (DSPCREATE)))
(PROG (IMAGEHEIGHT) (DECLARE (SPECVARS . T))
(SETQ BASEWIDTH (IDIFFERENCE (fetch WIDTH of REGION) (PROG (IMAGEHEIGHT)
(ITIMES HANOIMARGIN 2))) (SETQ BASEWIDTH (IDIFFERENCE (fetch WIDTH of REGION)
(SETQ RINGLARGEST (IQUOTIENT BASEWIDTH 3)) (ITIMES HANOIMARGIN 2)))
(* RINGDELTA is the difference in peg size on each  (SETQ RINGLARGEST (IQUOTIENT BASEWIDTH 3)) (* RINGDELTA is the difference in peg
side.)  size on each side.)
(COND (COND
([ZEROP (SETQ RINGDELTA (IQUOTIENT (IDIFFERENCE RINGLARGEST PEGMIN) ([ZEROP (SETQ RINGDELTA (IQUOTIENT (IDIFFERENCE RINGLARGEST PEGMIN)
(ADD1 (ITIMES NRINGS 2] (ADD1 (ITIMES NRINGS 2]
(HELP "Not enough width for a display."))) (HELP "Not enough width for a display.")))
(* leave one ring width for base, one for top of peg and two above peg for movement. Doesn't really use two heights (* leave one ring width for base, one for top of peg and two above peg for
at top, only one plus VERTSPEED)  movement. Doesn't really use two heights at top, only one plus VERTSPEED)
(SETQ RINGHEIGHT (IQUOTIENT (SETQ IMAGEHEIGHT (IDIFFERENCE (fetch HEIGHT of REGION)
(SETQ RINGHEIGHT (IQUOTIENT (SETQ IMAGEHEIGHT (IDIFFERENCE (fetch (ITIMES HANOIMARGIN 2)))
HEIGHT (IPLUS NRINGS 4)))
of REGION) (COND
(ITIMES ((ZEROP RINGHEIGHT)
HANOIMARGIN (HELP "Not enough height for display.")))
2))) (SETQ PEGWIDTH (IQUOTIENT (IDIFFERENCE RINGLARGEST (ITIMES RINGDELTA (SUB1 NRINGS)
(IPLUS NRINGS 4))) 2))
(COND 3)) (* put extra in base if it comes out
((ZEROP RINGHEIGHT)  closer to pegwidth.)
(HELP "Not enough height for display."))) (COND
(SETQ PEGWIDTH (IQUOTIENT (IDIFFERENCE RINGLARGEST (ITIMES RINGDELTA [(IGREATERP PEGWIDTH RINGHEIGHT)
(SUB1 NRINGS) (SETQ BASEHEIGHT (IMIN PEGWIDTH (IPLUS RINGHEIGHT (IDIFFERENCE
2)) IMAGEHEIGHT
3)) (* put extra in base if it comes out closer to  (ITIMES (IPLUS NRINGS 4)
pegwidth.) RINGHEIGHT]
(COND (T (SETQ BASEHEIGHT RINGHEIGHT)))
[(IGREATERP PEGWIDTH RINGHEIGHT) (SETQ MOVEMENTHEIGHT (IPLUS [SETQ PEGTOP (IPLUS HANOIMARGIN BASEHEIGHT
(SETQ BASEHEIGHT (IMIN PEGWIDTH (IPLUS RINGHEIGHT (ITIMES RINGHEIGHT (ADD1 NRINGS]
(IDIFFERENCE VERTSPEED))
IMAGEHEIGHT (DSPFONT FONT RDEST)
(ITIMES (IPLUS NRINGS 4) (DSPFONT FONT W)
RINGHEIGHT] (DSPOPERATION 'ERASE RDEST)
(T (SETQ BASEHEIGHT RINGHEIGHT))) (DSPOPERATION 'ERASE W))
(SETQ MOVEMENTHEIGHT (IPLUS [SETQ PEGTOP (IPLUS HANOIMARGIN BASEHEIGHT [PROG ((BASE (create REGION
(ITIMES RINGHEIGHT LEFT _ HANOIMARGIN
(ADD1 NRINGS] BOTTOM _ HANOIMARGIN
VERTSPEED)) WIDTH _ BASEWIDTH
(DSPFONT FONT RDEST) HEIGHT _ BASEHEIGHT)))
(DSPFONT FONT W) (SETQ PEGS (for PLEFT from (IPLUS HANOIMARGIN (IQUOTIENT (IDIFFERENCE RINGLARGEST
(DSPOPERATION (QUOTE ERASE) PEGWIDTH)
RDEST) 2)) by RINGLARGEST as I
(DSPOPERATION (QUOTE ERASE) from 1 to 3
W)) collect (create PEG
[PROG ((BASE (create REGION PEGREGION _ (create REGION
LEFT _ HANOIMARGIN LEFT _ PLEFT
BOTTOM _ HANOIMARGIN BOTTOM _ (IPLUS BASEHEIGHT
WIDTH _ BASEWIDTH HANOIMARGIN)
HEIGHT _ BASEHEIGHT))) WIDTH _ PEGWIDTH
(SETQ PEGS (for PLEFT from (IPLUS HANOIMARGIN (IQUOTIENT (IDIFFERENCE HEIGHT _ (ITIMES RINGHEIGHT
RINGLARGEST (ADD1 NRINGS)))
PEGWIDTH) RINGS _ (LIST (create RING
2)) RINGREGION _ BASE
by RINGLARGEST as I from 1 to 3 RINGNUMBER _ 'BASE]
collect (create PEG [PROG [(SOURCEPEG (PEGN 1))
PEGREGION _(create REGION (RINGLABELS (COND
LEFT _ PLEFT ((LISTP RINGS)
BOTTOM _(IPLUS (REVERSE RINGS))
BASEHEIGHT (T (* collect n NILs as lables.)
HANOIMARGIN) (for I from 1 to RINGS collect NIL]
WIDTH _ PEGWIDTH (for RINGBOTTOM from (IPLUS HANOIMARGIN BASEHEIGHT) by RINGHEIGHT as RINGLEFT
HEIGHT _(ITIMES from (IPLUS HANOIMARGIN (ITIMES RINGLARGEST (SUB1 1))) by RINGDELTA as I
RINGHEIGHT from 0 to (SUB1 NRINGS) as LABEL in RINGLABELS
(ADD1 NRINGS))) do (push (fetch RINGS of SOURCEPEG)
RINGS _(LIST (create RING (create RING
RINGREGION _ BASE RINGREGION _ (create REGION
RINGNUMBER _(QUOTE LEFT _ RINGLEFT
BASE] BOTTOM _ RINGBOTTOM
[PROG [(SOURCEPEG (PEGN 1)) WIDTH _ (IDIFFERENCE RINGLARGEST
(RINGLABELS (COND (ITIMES I 2 RINGDELTA))
((LISTP RINGS) HEIGHT _ RINGHEIGHT)
(REVERSE RINGS)) RINGNUMBER _ (ADD1 (IDIFFERENCE NRINGS I))
(T (* collect n NILs as lables.) RINGLABEL _ LABEL))) (* allocate bitmaps for ring movement)
(for I from 1 to RINGS collect NIL] (SETQ HORIZRINGBM (BITMAPCREATE (IPLUS RINGLARGEST MAXHORIZSPEED)
(for RINGBOTTOM from (IPLUS HANOIMARGIN BASEHEIGHT) by RINGHEIGHT RINGHEIGHT))
as RINGLEFT from (IPLUS HANOIMARGIN (ITIMES RINGLARGEST (SUB1 1))) (SETQ UPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
by RINGDELTA as I from 0 to (SUB1 NRINGS) as LABEL in RINGLABELS (SETQ DOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
do (push (fetch RINGS of SOURCEPEG) (SETQ TOPUPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
(create RING (SETQ TOPDOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED]
RINGREGION _(create REGION (\CLEARBM W)
LEFT _ RINGLEFT (DISPLAYPEGSANDRINGS PEGS W)
BOTTOM _ RINGBOTTOM (bind (HERE _ 1)
WIDTH _(IDIFFERENCE (THERE _ 3) do (DOHANOI NRINGS HERE THERE W)
RINGLARGEST (COND
(ITIMES I 2 RINGDELTA)) (ONCE (RETURN)))
HEIGHT _ RINGHEIGHT) (DISMISS 2000)
RINGNUMBER _(ADD1 (IDIFFERENCE NRINGS I)) (SETQ HERE (PROG1 THERE
RINGLABEL _ LABEL))) (SETQ THERE (FINDOTHER HERE THERE)))])
(* allocate bitmaps for ring movement)
(SETQ HORIZRINGBM (BITMAPCREATE (IPLUS RINGLARGEST MAXHORIZSPEED)
RINGHEIGHT))
(SETQ UPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
(SETQ DOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED)))
(SETQ TOPUPRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT MAXVERTSPEED))
)
(SETQ TOPDOWNRINGBM (BITMAPCREATE RINGLARGEST (IPLUS RINGHEIGHT
MAXVERTSPEED]
(\CLEARBM W)
(DISPLAYPEGSANDRINGS PEGS W)
(bind (HERE _ 1)
(THERE _ 3)
do (DOHANOI NRINGS HERE THERE W)
(COND
(ONCE (RETURN)))
(DISMISS 2000)
(SETQ HERE (PROG1 THERE (SETQ THERE (FINDOTHER HERE THERE])
(XHANOI (XHANOI
[LAMBDA NIL (* lmm " 8-MAR-82 15:59") [LAMBDA NIL (* lmm " 8-MAR-82 15:59")
(PROG ((EVENRINGSHADE XRINGSHADE) (PROG ((EVENRINGSHADE XRINGSHADE)
(ODDRINGSHADE ORINGSHADE) (ODDRINGSHADE ORINGSHADE)
(PEGSHADE XPEGSHADE)) (PEGSHADE XPEGSHADE))
(WHANOI (QUOTE (X E R O X)) (WHANOI '(X E R O X)
(QUOTE (0 0 400 280)) '(0 0 400 280)
(FONTCREATE (QUOTE LOGO) (FONTCREATE 'LOGO 24])
24])
) )
(RPAQQ HANOIWINDOW NIL) (RPAQQ HANOIWINDOW NIL)
(DECLARE: DONTCOPY (DECLARE%: DONTCOPY
[DECLARE: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(RECORD PEG (PEGREGION RINGS)) (RECORD PEG (PEGREGION RINGS))
(RECORD RING (RINGREGION RINGNUMBER RINGLABEL)) (RECORD RING (RINGREGION RINGNUMBER RINGLABEL))
] )
(DECLARE: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(RPAQQ XRINGSHADE 42405) (RPAQQ XRINGSHADE 42405)
@ -429,10 +396,11 @@
(RPAQQ XPEGSHADE 65535) (RPAQQ XPEGSHADE 65535)
(CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE) (CONSTANTS XRINGSHADE ORINGSHADE XPEGSHADE)
) )
(DECLARE: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(RPAQQ PEGMIN 2) (RPAQQ PEGMIN 2)
@ -442,15 +410,18 @@
(RPAQQ MAXHORIZSPEED 44) (RPAQQ MAXHORIZSPEED 44)
(CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30) (CONSTANTS PEGMIN HANOIMARGIN (MAXVERTSPEED 30)
(MAXHORIZSPEED 44)) (MAXHORIZSPEED 44))
) )
(DECLARE: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
[PUTPROPS PEGN MACRO ((N)
(CAR (SELECTQ N (1 PEGS) (PUTPROPS PEGN MACRO [(N)
(2 (CDR PEGS)) (CAR (SELECTQ N
(CDDR PEGS] (1 PEGS)
(2 (CDR PEGS))
(CDDR PEGS])
) )
) )
@ -461,17 +432,13 @@
(RPAQQ PEGSHADE 65535) (RPAQQ PEGSHADE 65535)
(ADDTOVAR IDLE.FUNCTIONS [Hanoi (FUNCTION (LAMBDA (W) (ADDTOVAR IDLE.FUNCTIONS [Hanoi (FUNCTION (LAMBDA (W)
(HANOI (UNPACK (QUOTE "Xerox AI Systems")) (HANOI (UNPACK "Interlisp.org")
W W
(QUOTE (TIMESROMAND 36] '(TIMESROMAND 36])
[HanoiUsername (FUNCTION (LAMBDA (W)
(HANOI (UNPACK (USERNAME NIL T T))
W
(QUOTE (TIMESROMAND 36])
(PUTPROPS HANOI COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986)) (PUTPROPS HANOI COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (797 18810 (DISPLAYPEGSANDRINGS 807 . 1479) (DOHANOI 1481 . 1818) (FINDOTHER 1820 . 2022 (FILEMAP (NIL (920 20991 (DISPLAYPEGSANDRINGS 930 . 1875) (DOHANOI 1877 . 2288) (FINDOTHER 2290 . 2512
) (HANOI 2024 . 2167) (HANOIDEMO 2169 . 2861) (MOVEDIS 2863 . 8440) (MOVERING 8442 . 8994) (RINGSHADE ) (HANOI 2514 . 2657) (HANOIDEMO 2659 . 3254) (MOVEDIS 3256 . 8151) (MOVERING 8153 . 8808) (RINGSHADE
8996 . 9245) (SETUPRINGBITMAPS 9247 . 12568) (TRACK 12570 . 12983) (WHANOI 12985 . 18479) (XHANOI 8810 . 9049) (SETUPRINGBITMAPS 9051 . 12799) (TRACK 12801 . 13291) (WHANOI 13293 . 20670) (XHANOI
18481 . 18808))))) 20672 . 20989)))))
STOP STOP

BIN
lispusers/HANOI.LCOM
View File

Binary file not shown.

314
lispusers/IDLEHAX
View File

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

BIN
lispusers/IDLEHAX.LCOM
View File

Binary file not shown.

60
sources/DMISC
View File

@ -1,11 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Jan-2022 19:08:15" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;3 45512 (FILECREATED "20-Aug-2022 14:26:31" {DSK}<home>larry>medley>sources>DMISC.;2 45041
:CHANGES-TO (FNS FLASHWINDOW) :CHANGES-TO (FNS \SAVEVMBACKGROUND)
:PREVIOUS-DATE "16-May-90 15:53:57" :PREVIOUS-DATE " 6-Jan-2022 19:08:15" {DSK}<home>larry>medley>sources>DMISC.;1)
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;1)
(* ; " (* ; "
@ -135,21 +134,12 @@ with the terms of said license.
(SETQ BACKGROUNDPAGECNT BACKGROUNDPAGEFREQ]) (SETQ BACKGROUNDPAGECNT BACKGROUNDPAGEFREQ])
(\SAVEVMBACKGROUND (\SAVEVMBACKGROUND
[LAMBDA NIL (* bvm%: "14-Feb-85 23:27") [LAMBDA NIL (* ; "Edited 20-Aug-2022 13:29 by lmm")
(* bvm%: "14-Feb-85 23:27")
(COND (COND
((AND (ILESSP \DIRTYPAGEHINT SAVEVMMAX) ((AND (FIXP SAVEVMWAIT)
(NEQ (fetch (IFPAGE Key) of \InterfacePage)
\IFPValidKey)
(FIXP SAVEVMWAIT)
(\SECONDSCLOCKGREATERP \LASTUSERACTION SAVEVMWAIT)) (\SECONDSCLOCKGREATERP \LASTUSERACTION SAVEVMWAIT))
(COND (SAVEVM])
((AND (ILESSP (SETQ \DIRTYPAGEHINT (\COUNTREALPAGES 'DIRTY))
SAVEVMMAX)
(\FLUSHVMOK? 'SAVEVM T)) (* ;
"Recalculate the hint before deciding it's okay")
(RESETLST (AND SAVINGCURSOR (GETD 'CURSOR)
(RESETSAVE (CURSOR SAVINGCURSOR)))
(SAVEVM])
(COPYVM (COPYVM
[LAMBDA (FILE) (* bvm%: "12-Jan-84 12:07") [LAMBDA (FILE) (* bvm%: "12-Jan-84 12:07")
@ -951,22 +941,22 @@ with the terms of said license.
(PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990) (PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990)
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (4747 5450 (BACKSPACEDEL 4757 . 5448)) (5545 5978 (PERIODICALLYRECLAIM 5555 . 5976)) ( (FILEMAP (NIL (4712 5415 (BACKSPACEDEL 4722 . 5413)) (5510 5943 (PERIODICALLYRECLAIM 5520 . 5941)) (
6208 7899 (\DIRTYBACKGROUND 6218 . 6640) (\SAVEVMBACKGROUND 6642 . 7426) (COPYVM 7428 . 7897)) (8320 6173 7428 (\DIRTYBACKGROUND 6183 . 6605) (\SAVEVMBACKGROUND 6607 . 6955) (COPYVM 6957 . 7426)) (7849
9519 (SETTIME 8330 . 9517)) (9520 13551 (RINGBELLS 9530 . 10023) (FLASHWINDOW 10025 . 11953) (PLAYTUNE 9048 (SETTIME 7859 . 9046)) (9049 13080 (RINGBELLS 9059 . 9552) (FLASHWINDOW 9554 . 11482) (PLAYTUNE
11955 . 13549)) (13813 19345 (DISPLAYDOWN 13823 . 14211) (SETDISPLAYHEIGHT 14213 . 17013) (VIDEORATE 11484 . 13078)) (13342 18874 (DISPLAYDOWN 13352 . 13740) (SETDISPLAYHEIGHT 13742 . 16542) (VIDEORATE
17015 . 19343)) (19769 20490 (DOAROUNDEXITFORMS 19779 . 20488)) (20693 22408 (REALMEMORYSIZE 20703 . 16544 . 18872)) (19298 20019 (DOAROUNDEXITFORMS 19308 . 20017)) (20222 21937 (REALMEMORYSIZE 20232 .
20861) (LISPVERSION 20863 . 21016) (MICROCODEVERSION 21018 . 21176) (BCPLVERSION 21178 . 21331) ( 20390) (LISPVERSION 20392 . 20545) (MICROCODEVERSION 20547 . 20705) (BCPLVERSION 20707 . 20860) (
REQUIREVERSION 21333 . 22406)) (22445 27023 (APROPOS 22455 . 26471) (APROPRINT 26473 . 27021)) (27049 REQUIREVERSION 20862 . 21935)) (21974 26552 (APROPOS 21984 . 26000) (APROPRINT 26002 . 26550)) (26578
30957 (READPRINTERPORT 27059 . 27200) (WRITEPRINTERPORT 27202 . 27357) (\READPRINTERPORT.UFN 27359 . 30486 (READPRINTERPORT 26588 . 26729) (WRITEPRINTERPORT 26731 . 26886) (\READPRINTERPORT.UFN 26888 .
27548) (\WRITEPRINTERPORT.UFN 27550 . 27748) (\MISC1.UFN 27750 . 27903) (\MISC2.UFN 27905 . 28143) ( 27077) (\WRITEPRINTERPORT.UFN 27079 . 27277) (\MISC1.UFN 27279 . 27432) (\MISC2.UFN 27434 . 27672) (
\MISC3.UFN 28145 . 28878) (\MISC4.UFN 28880 . 29430) (\MISC5.UFN 29432 . 29585) (\MISC6.UFN 29587 . \MISC3.UFN 27674 . 28407) (\MISC4.UFN 28409 . 28959) (\MISC5.UFN 28961 . 29114) (\MISC6.UFN 29116 .
29837) (\MISC7.UFN 29839 . 30324) (\MISC8.UFN 30326 . 30627) (\MISC10.UFN 30629 . 30955)) (31011 38460 29366) (\MISC7.UFN 29368 . 29853) (\MISC8.UFN 29855 . 30156) (\MISC10.UFN 30158 . 30484)) (30540 37989
(\BLKFDIFF.UFN 31021 . 31586) (\BLKFPLUS.UFN 31588 . 32160) (\BLKFTIMES.UFN 32162 . 32737) ( (\BLKFDIFF.UFN 30550 . 31115) (\BLKFPLUS.UFN 31117 . 31689) (\BLKFTIMES.UFN 31691 . 32266) (
\BLKSEP.UFN 32739 . 33870) (\BLKPERM.UFN 33872 . 34341) (\BLKEXPONENT.UFN 34343 . 34753) ( \BLKSEP.UFN 32268 . 33399) (\BLKPERM.UFN 33401 . 33870) (\BLKEXPONENT.UFN 33872 . 34282) (
\BLKFLOATP2COMP.UFN 34755 . 35339) (\BLKSMALLP2FLOAT.UFN 35341 . 35700) (\BLKMAG.UFN 35702 . 36353) ( \BLKFLOATP2COMP.UFN 34284 . 34868) (\BLKSMALLP2FLOAT.UFN 34870 . 35229) (\BLKMAG.UFN 35231 . 35882) (
\FLOATTOBYTE.UFN 36355 . 36934) (\BLKFMAX.UFN 36936 . 37328) (\BLKFMIN.UFN 37330 . 37719) ( \FLOATTOBYTE.UFN 35884 . 36463) (\BLKFMAX.UFN 36465 . 36857) (\BLKFMIN.UFN 36859 . 37248) (
\BLKFABSMAX.UFN 37721 . 38090) (\BLKFABSMIN.UFN 38092 . 38458)) (38500 40318 (\P-MISC2.UFN 38510 . \BLKFABSMAX.UFN 37250 . 37619) (\BLKFABSMIN.UFN 37621 . 37987)) (38029 39847 (\P-MISC2.UFN 38039 .
38751) (\LINES-EQUAL-P 38753 . 39137) (\GET-NEXT-RUN 39139 . 40316)) (40319 44498 (IBLT1 40329 . 42331 38280) (\LINES-EQUAL-P 38282 . 38666) (\GET-NEXT-RUN 38668 . 39845)) (39848 44027 (IBLT1 39858 . 41860
) (IBLT2 42333 . 44496))))) ) (IBLT2 41862 . 44025)))))
STOP STOP

BIN
sources/DMISC.LCOM
View File

Binary file not shown.

203
sources/IDLER
View File

File diff suppressed because one or more lines are too long

BIN
sources/IDLER.LCOM
View File

Binary file not shown.