patch some idle hacks and merge in IDLEDRAIN
This commit is contained in:
Larry Masinter
parent
4ae11aebf4
commit
071f8e5004
@ -1,62 +0,0 @@
|
||||
(FILECREATED "28-May-86 12:00:22" {ERIS}<LISPUSERS>KOTO>IDLEDRAIN.;2 2598
|
||||
|
||||
changes to: (FNS IDLE-DRAIN)
|
||||
(VARS IDLEDRAINCOMS)
|
||||
|
||||
previous date: "28-May-86 11:44:43" {ERIS}<LISPUSERS>KOTO>IDLEDRAIN.;1)
|
||||
|
||||
|
||||
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT IDLEDRAINCOMS)
|
||||
|
||||
(RPAQQ IDLEDRAINCOMS ([ADDVARS (IDLE.FUNCTIONS ("Drain" (QUOTE IDLE-DRAIN]
|
||||
(FNS IDLE-DRAIN)))
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Drain" (QUOTE IDLE-DRAIN)))
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-DRAIN
|
||||
[LAMBDA (WINDOW) (* hdj "28-May-86 11:52")
|
||||
(do (BITBLT (WINDOWPROP WINDOW (QUOTE IMAGECOVERED))
|
||||
NIL NIL WINDOW NIL NIL NIL NIL (QUOTE INVERT)
|
||||
(QUOTE REPLACE))
|
||||
(LET* ((WIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
|
||||
(HEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
|
||||
(HALF-WIDTH (IQUOTIENT WIDTH 2))
|
||||
(HALF-HEIGHT (IQUOTIENT HEIGHT 2)))
|
||||
(for EDGE from 0 to (MIN HALF-WIDTH HALF-HEIGHT)
|
||||
do (BLOCK)
|
||||
(BITBLT WINDOW EDGE 0 WINDOW (1+ EDGE)
|
||||
0
|
||||
(- HALF-WIDTH EDGE)
|
||||
HEIGHT
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(BLTSHADE WHITESHADE WINDOW EDGE 0 1 HEIGHT (QUOTE REPLACE))
|
||||
(BITBLT WINDOW (1+ HALF-WIDTH)
|
||||
0 WINDOW HALF-WIDTH 0 (- HALF-WIDTH EDGE)
|
||||
HEIGHT
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(BLTSHADE WHITESHADE WINDOW (- WIDTH EDGE)
|
||||
0 1 HEIGHT (QUOTE REPLACE))
|
||||
(BITBLT WINDOW 0 EDGE WINDOW 0 (1+ EDGE)
|
||||
WIDTH
|
||||
(- HALF-HEIGHT EDGE)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(BLTSHADE WHITESHADE WINDOW 0 EDGE WIDTH 1 (QUOTE REPLACE))
|
||||
(BITBLT WINDOW 0 (+ HALF-HEIGHT EDGE 1)
|
||||
WINDOW 0 (+ HALF-HEIGHT EDGE)
|
||||
WIDTH
|
||||
(- HALF-HEIGHT EDGE)
|
||||
(QUOTE INPUT)
|
||||
(QUOTE REPLACE))
|
||||
(BLTSHADE WHITESHADE WINDOW 0 (- HEIGHT EDGE)
|
||||
WIDTH 1 (QUOTE REPLACE])
|
||||
)
|
||||
(PUTPROPS IDLEDRAIN COPYRIGHT ("Xerox Corporation" 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (520 2518 (IDLE-DRAIN 530 . 2516)))))
|
||||
STOP
|
||||
Binary file not shown.
@ -1,21 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;2 22517
|
||||
(FILECREATED " 9-Feb-2022 13:53:05" {DSK}<home>larry>medley>lispusers>IDLEHAX.;3 26245
|
||||
|
||||
:CHANGES-TO (FNS CONNECTPOLYS)
|
||||
:CHANGES-TO (FNS IDLE-DRAIN)
|
||||
(VARS IDLEHAXCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Sep-91 14:35:23" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
:PREVIOUS-DATE "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985-1988, 1991 by Xerox Corporation.
|
||||
Copyright (c) 1985-1988, 1991, 2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT IDLEHAXCOMS)
|
||||
|
||||
(RPAQQ IDLEHAXCOMS
|
||||
((COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES)
|
||||
[(COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES)
|
||||
(Warp-Out 'WARP)
|
||||
(Radar 'WALKINGSPOKE)
|
||||
[Triangles (FUNCTION (LAMBDA (W)
|
||||
@ -56,7 +56,12 @@ Copyright (c) 1985-1988, 1991 by Xerox Corporation.
|
||||
(COMS (* ; "utilities")
|
||||
(FNS DEMOWINDOW)
|
||||
(GLOBALVARS BLOCKTIMER)
|
||||
(MACROS PERIODIC.BLOCK))))
|
||||
(MACROS PERIODIC.BLOCK))
|
||||
(COMS [ADDVARS (IDLE.FUNCTIONS ("Drain" 'IDLE-DRAIN]
|
||||
(FNS IDLE-DRAIN))
|
||||
(COMS (INITVARS (IDLE-SWAP-SIZE 64))
|
||||
(FNS IDLE-SWAP)
|
||||
(ADDVARS (IDLE.FUNCTIONS ("Swap" 'IDLE-SWAP])
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS
|
||||
(Lines 'LINES)
|
||||
@ -389,13 +394,88 @@ Copyright (c) 1985-1988, 1991 by Xerox Corporation.
|
||||
then (BLOCK)
|
||||
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
|
||||
)
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991))
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Drain" 'IDLE-DRAIN))
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-DRAIN
|
||||
[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))
|
||||
(HEIGHT (WINDOWPROP WINDOW 'HEIGHT))
|
||||
(HALF-WIDTH (IQUOTIENT WIDTH 2))
|
||||
(HALF-HEIGHT (IQUOTIENT HEIGHT 2)))
|
||||
(for EDGE from 0 to (MIN HALF-WIDTH HALF-HEIGHT)
|
||||
do (BLOCK)
|
||||
(BITBLT WINDOW EDGE 0 WINDOW (PLUS 1 EDGE)
|
||||
0
|
||||
(- HALF-WIDTH EDGE)
|
||||
HEIGHT
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(BLTSHADE WHITESHADE WINDOW EDGE 0 1 HEIGHT 'REPLACE)
|
||||
(BITBLT WINDOW (PLUS 1 HALF-WIDTH)
|
||||
0 WINDOW HALF-WIDTH 0 (- HALF-WIDTH EDGE)
|
||||
HEIGHT
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(BLTSHADE WHITESHADE WINDOW (- WIDTH EDGE)
|
||||
0 1 HEIGHT 'REPLACE)
|
||||
(BITBLT WINDOW 0 EDGE WINDOW 0 (PLUS 1 EDGE)
|
||||
WIDTH
|
||||
(- HALF-HEIGHT EDGE)
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(BLTSHADE WHITESHADE WINDOW 0 EDGE WIDTH 1 'REPLACE)
|
||||
(BITBLT WINDOW 0 (+ HALF-HEIGHT EDGE 1)
|
||||
WINDOW 0 (+ HALF-HEIGHT EDGE)
|
||||
WIDTH
|
||||
(- HALF-HEIGHT EDGE)
|
||||
'INPUT
|
||||
'REPLACE)
|
||||
(BLTSHADE WHITESHADE WINDOW 0 (- HEIGHT EDGE)
|
||||
WIDTH 1 'REPLACE])
|
||||
)
|
||||
|
||||
(RPAQ? IDLE-SWAP-SIZE 64)
|
||||
(DEFINEQ
|
||||
|
||||
(IDLE-SWAP
|
||||
[LAMBDA (WINDOW) (* hdj "29-May-86 23:41")
|
||||
(DECLARE (GLOBALVARS IDLE-SWAP-SIZE))
|
||||
(BITBLT (WINDOWPROP WINDOW 'IMAGECOVERED)
|
||||
NIL NIL WINDOW NIL NIL NIL NIL 'INVERT 'REPLACE)
|
||||
(LET [(WIDTH (WINDOWPROP WINDOW 'WIDTH))
|
||||
(HEIGHT (WINDOWPROP WINDOW 'HEIGHT]
|
||||
(do (BLOCK (RAND 0 5000))
|
||||
(LET [[RAND-X-1 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT WIDTH IDLE-SWAP-SIZE]
|
||||
[RAND-Y-1 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT HEIGHT IDLE-SWAP-SIZE]
|
||||
[RAND-X-2 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT WIDTH IDLE-SWAP-SIZE]
|
||||
(RAND-Y-2 (TIMES IDLE-SWAP-SIZE (RAND 0 (IQUOTIENT HEIGHT IDLE-SWAP-SIZE]
|
||||
(if (AND (NEQ RAND-X-1 RAND-X-2)
|
||||
(NEQ RAND-Y-1 RAND-Y-2))
|
||||
then
|
||||
|
||||
(* * swap the two regions of the window using BITBLT only)
|
||||
|
||||
(BITBLT WINDOW RAND-X-1 RAND-Y-1 WINDOW RAND-X-2 RAND-Y-2 IDLE-SWAP-SIZE
|
||||
IDLE-SWAP-SIZE 'INPUT 'INVERT)
|
||||
(BITBLT WINDOW RAND-X-2 RAND-Y-2 WINDOW RAND-X-1 RAND-Y-1 IDLE-SWAP-SIZE
|
||||
IDLE-SWAP-SIZE 'INPUT 'INVERT)
|
||||
(BITBLT WINDOW RAND-X-1 RAND-Y-1 WINDOW RAND-X-2 RAND-Y-2 IDLE-SWAP-SIZE
|
||||
IDLE-SWAP-SIZE 'INPUT 'INVERT])
|
||||
)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Swap" 'IDLE-SWAP))
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3562 7602 (POLYGONSDEMO 3572 . 3742) (POLYGONS 3744 . 4108) (CONNECTPOLYS 4110 . 6508)
|
||||
(DRAWPOLY1 6510 . 7147) (RANDOMPT 7149 . 7600)) (8239 11221 (KALDEMO 8249 . 9660) (KAL.ADVANCE 9662 .
|
||||
10063) (KAL.SPOTS 10065 . 10406) (KAL.BMS 10408 . 10895) (KAL.ORAND 10897 . 11219)) (11258 12744 (
|
||||
BUBBLES 11268 . 12374) (BUBBLE.CREATE 12376 . 12742)) (12771 13756 (IDLE-WINDOWS 12781 . 13754)) (
|
||||
13791 16062 (LINES 13801 . 14860) (LINES1 14862 . 15272) (LINES2 15274 . 15585) (LINES3 15587 . 16060)
|
||||
) (16122 17335 (WALKINGSPOKE 16132 . 16913) (WARP 16915 . 17333)) (17360 21643 (IDLE-MELT 17370 .
|
||||
19886) (IDLE-SLIDE 19888 . 21641)) (21814 22060 (DEMOWINDOW 21824 . 22058)))))
|
||||
(FILEMAP (NIL (3794 7834 (POLYGONSDEMO 3804 . 3974) (POLYGONS 3976 . 4340) (CONNECTPOLYS 4342 . 6740)
|
||||
(DRAWPOLY1 6742 . 7379) (RANDOMPT 7381 . 7832)) (8471 11453 (KALDEMO 8481 . 9892) (KAL.ADVANCE 9894 .
|
||||
10295) (KAL.SPOTS 10297 . 10638) (KAL.BMS 10640 . 11127) (KAL.ORAND 11129 . 11451)) (11490 12976 (
|
||||
BUBBLES 11500 . 12606) (BUBBLE.CREATE 12608 . 12974)) (13003 13988 (IDLE-WINDOWS 13013 . 13986)) (
|
||||
14023 16294 (LINES 14033 . 15092) (LINES1 15094 . 15504) (LINES2 15506 . 15817) (LINES3 15819 . 16292)
|
||||
) (16354 17567 (WALKINGSPOKE 16364 . 17145) (WARP 17147 . 17565)) (17592 21875 (IDLE-MELT 17602 .
|
||||
20118) (IDLE-SLIDE 20120 . 21873)) (22046 22292 (DEMOWINDOW 22056 . 22290)) (22704 24577 (IDLE-DRAIN
|
||||
22714 . 24575)) (24609 26090 (IDLE-SWAP 24619 . 26088)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user