patch some idlehacks to not draw so fast

Author: masinter

lispusers/IDLEHAX

@@ -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