Skip to content

Commit e4641d8

Browse files
authored
Lispusers package KINETIC: add CLOSEFN to Kinetic window so that kinetic activity stops and window closes when CLOSEW is called .. (#2351)
* Add a CLOSEFN to KINETIC window that forces the kinetic to stop and exit when closew is called. * Reset the window close flag after window is closed so that can repeatedly close and open the KINETICWINDOW.
1 parent 72251e3 commit e4641d8

File tree

2 files changed

+24
-22
lines changed

2 files changed

+24
-22
lines changed

lispusers/KINETIC

Lines changed: 24 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,13 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2 1928
3+
(FILECREATED " 1-Nov-2025 20:26:43" {DSK}<home>frank>il>medley>lispusers>KINETIC.;5 2264
44

5-
:CHANGES-TO (FNS KINETIC)
5+
:EDIT-BY "FGH"
66

7-
:PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1)
7+
:CHANGES-TO (FNS KINETIC)
88

9+
:PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}<home>frank>il>medley>lispusers>KINETIC.;1)
910

10-
(* ; "
11-
Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
12-
")
1311

1412
(PRETTYCOMPRINT KINETICCOMS)
1513

@@ -20,34 +18,38 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
2018
(DEFINEQ
2119

2220
(KINETIC
23-
[LAMBDA (WINDOW) (* ; "Edited 22-Sep-2022 22:07 by lmm")
21+
[LAMBDA (WINDOW) (* ; "Edited 1-Nov-2025 20:23 by FGH")
22+
(* ; "Edited 22-Sep-2022 22:07 by lmm")
2423
(* lmm " 3-Dec-85 14:16")
25-
(* test example (KINETICDEMO)
26-
 (SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))
2724
[OR (WINDOWP WINDOW)
2825
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
26+
[OR (WINDOWPROP WINDOW 'CLOSEFN)
27+
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
28+
(WINDOWPROP W 'CLOSE T]
29+
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
30+
(WINDOWPROP W 'CLOSE T]
2931
(PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
3032
(HT (WINDOWPROP WINDOW 'HEIGHT))
3133
X Y)
32-
(do (SETQ X (RAND 0 WD))
33-
(SETQ Y (RAND 0 HT))
34-
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
35-
(RAND 0 (IDIFFERENCE HT Y))
36-
X Y 'TEXTURE (SELECTQ (RAND 0 5)
37-
(0 'PAINT)
38-
'INVERT)
39-
(SELECTQ (AND CHECKSHADE (RAND 0 12))
40-
(0 CHECKSHADE)
41-
BLACKSHADE))
42-
(BLOCK 100])
34+
(while (NEQ (WINDOWPROP WINDOW 'CLOSE)
35+
T) do (SETQ X (RAND 0 WD))
36+
(SETQ Y (RAND 0 HT))
37+
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
38+
(RAND 0 (IDIFFERENCE HT Y))
39+
X Y 'TEXTURE (SELECTQ (RAND 0 5)
40+
(0 'PAINT)
41+
'INVERT)
42+
(SELECTQ (AND CHECKSHADE (RAND 0 12))
43+
(0 CHECKSHADE)
44+
BLACKSHADE))
45+
(BLOCK 100) finally (WINDOWPROP WINDOW 'CLOSE NIL])
4346
)
4447

4548
(RPAQQ CHECKSHADE 63903)
4649

4750
(RPAQQ KINETICWINDOW NIL)
4851

4952
(ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC))
50-
(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
5153
(DECLARE%: DONTCOPY
52-
(FILEMAP (NIL (573 1723 (KINETIC 583 . 1721)))))
54+
(FILEMAP (NIL (534 2130 (KINETIC 544 . 2128)))))
5355
STOP

lispusers/KINETIC.LCOM

351 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)