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

patch some idlehacks to not draw so fast

Browse Source
This commit is contained in:
Larry Masinter 2022-01-15 20:09:52 -08:00
parent 479de87011
commit 82eaacc542
2 changed files with 42 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
lispusers/IDLEHAX
View File

@ -1,21 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Sep-91 14:35:23" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;2| 22593
changes to%: (FNS CONNECTPOLYS RANDOMPT KAL.ORAND)
(VARS IDLEHAXCOMS)
(RECORDS KALFIXP)
(FILECREATED "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;2 22517
previous date%: "10-Jun-88 17:50:01" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;1|)
:CHANGES-TO (FNS CONNECTPOLYS)
(VARS IDLEHAXCOMS)
:PREVIOUS-DATE "26-Sep-91 14:35:23" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved.
Copyright (c) 1985-1988, 1991 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)
@ -28,7 +28,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(Bubbles 'BUBBLES)
(Kaleidoscope 'KALDEMO)
(Windows 'IDLE-WINDOWS]
(VARS (IDLE.DEFAULTFN 'LINES]
(VARS (IDLE.DEFAULTFN 'LINES)
(POLYGONWAIT3 250)))
(COMS (* ; "for drawing polygons")
(FNS POLYGONSDEMO POLYGONS CONNECTPOLYS DRAWPOLY1 RANDOMPT)
(INITVARS (POLYGONSWINDOW))
@ -74,6 +75,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(RPAQQ IDLE.DEFAULTFN LINES)
(RPAQQ POLYGONWAIT3 250)
(* ; "for drawing polygons")
@ -89,39 +92,39 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
)
(CONNECTPOLYS
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* lmm "30-Jul-85 17:19")
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 12-Jan-2022 15:22 by larry")
(* 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))
(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)))
(ITIMES POLYGONSTEPS DX)))
(replace YC of TPT with (IPLUS (fetch YC of FPT)
(ITIMES POLYGONSTEPS DY)))
(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))
(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])
(for I from 1 to POLYGONSTEPS do (DISMISS POLYGONWAIT3)
(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))))
@ -151,7 +154,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(DECLARE%: EVAL@COMPILE
(DATATYPE NPOINT ((XC XPOINTER)
(YC XPOINTER)))
(YC XPOINTER)))
)
(/DECLAREDATATYPE 'NPOINT '(XPOINTER XPOINTER)
@ -363,7 +366,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(RPAQQ MELT-BLOCK-SIZE 32)
(ADDTOVAR IDLE.FUNCTIONS ("Melt screen" 'IDLE-MELT)
("Slide screen" 'IDLE-SLIDE))
("Slide screen" 'IDLE-SLIDE))
@ -382,18 +385,17 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
(DECLARE%: EVAL@COMPILE
(PUTPROPS PERIODIC.BLOCK MACRO [(TIMER)
(if (TIMEREXPIRED? TIMER 'TICKS)
then (BLOCK)
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS
'MILLISECONDS])
(if (TIMEREXPIRED? TIMER 'TICKS)
then (BLOCK)
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
)
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3587 7576 (POLYGONSDEMO 3597 . 3767) (POLYGONS 3769 . 4133) (CONNECTPOLYS 4135 . 6482)
(DRAWPOLY1 6484 . 7121) (RANDOMPT 7123 . 7574)) (8217 11199 (KALDEMO 8227 . 9638) (KAL.ADVANCE 9640 .
10041) (KAL.SPOTS 10043 . 10384) (KAL.BMS 10386 . 10873) (KAL.ORAND 10875 . 11197)) (11236 12722 (
BUBBLES 11246 . 12352) (BUBBLE.CREATE 12354 . 12720)) (12749 13734 (IDLE-WINDOWS 12759 . 13732)) (
13769 16040 (LINES 13779 . 14838) (LINES1 14840 . 15250) (LINES2 15252 . 15563) (LINES3 15565 . 16038)
) (16100 17313 (WALKINGSPOKE 16110 . 16891) (WARP 16893 . 17311)) (17338 21621 (IDLE-MELT 17348 .
19864) (IDLE-SLIDE 19866 . 21619)) (21796 22042 (DEMOWINDOW 21806 . 22040)))))
(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)))))
STOP

BIN
lispusers/IDLEHAX.LCOM
View File

Binary file not shown.