github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-27 04:37:42 +00:00
Code Issues Projects Releases Wiki Activity

Lispusers package KINETIC: add CLOSEFN to Kinetic window so that kinetic activity stops and window closes when CLOSEW is called .. (#2351)

Browse Source 
* 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.
This commit is contained in:
Frank Halasz
2025-11-07 17:48:24 -08:00
committed by GitHub
parent 72251e34a6
commit e4641d8515
2 changed files with 24 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
lispusers/KINETIC
View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2 1928 (FILECREATED " 1-Nov-2025 20:26:43" {DSK}<home>frank>il>medley>lispusers>KINETIC.;5 2264
:EDIT-BY "FGH"
:CHANGES-TO (FNS KINETIC) :CHANGES-TO (FNS KINETIC)
:PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1) :PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}<home>frank>il>medley>lispusers>KINETIC.;1)
(* ; "
Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
")
(PRETTYCOMPRINT KINETICCOMS) (PRETTYCOMPRINT KINETICCOMS)
(RPAQQ KINETICCOMS ((FNS KINETIC) (RPAQQ KINETICCOMS ((FNS KINETIC)
@@ -20,26 +18,31 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
(DEFINEQ (DEFINEQ
(KINETIC (KINETIC
[LAMBDA (WINDOW) (* ; "Edited 22-Sep-2022 22:07 by lmm") [LAMBDA (WINDOW) (* ; "Edited 1-Nov-2025 20:23 by FGH")
(* ; "Edited 22-Sep-2022 22:07 by lmm")
(* lmm " 3-Dec-85 14:16") (* lmm " 3-Dec-85 14:16")
(* test example (KINETICDEMO)
 (SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))
[OR (WINDOWP WINDOW) [OR (WINDOWP WINDOW)
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"] (SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
[OR (WINDOWPROP WINDOW 'CLOSEFN)
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
(WINDOWPROP W 'CLOSE T]
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
(WINDOWPROP W 'CLOSE T]
(PROG ((WD (WINDOWPROP WINDOW 'WIDTH)) (PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
(HT (WINDOWPROP WINDOW 'HEIGHT)) (HT (WINDOWPROP WINDOW 'HEIGHT))
X Y) X Y)
(do (SETQ X (RAND 0 WD)) (while (NEQ (WINDOWPROP WINDOW 'CLOSE)
(SETQ Y (RAND 0 HT)) T) do (SETQ X (RAND 0 WD))
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X)) (SETQ Y (RAND 0 HT))
(RAND 0 (IDIFFERENCE HT Y)) (BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
X Y 'TEXTURE (SELECTQ (RAND 0 5) (RAND 0 (IDIFFERENCE HT Y))
(0 'PAINT) X Y 'TEXTURE (SELECTQ (RAND 0 5)
'INVERT) (0 'PAINT)
(SELECTQ (AND CHECKSHADE (RAND 0 12)) 'INVERT)
(0 CHECKSHADE) (SELECTQ (AND CHECKSHADE (RAND 0 12))
BLACKSHADE)) (0 CHECKSHADE)
(BLOCK 100]) BLACKSHADE))
(BLOCK 100) finally (WINDOWPROP WINDOW 'CLOSE NIL])
) )
(RPAQQ CHECKSHADE 63903) (RPAQQ CHECKSHADE 63903)
@@ -47,7 +50,6 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
(RPAQQ KINETICWINDOW NIL) (RPAQQ KINETICWINDOW NIL)
(ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC)) (ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC))
(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (573 1723 (KINETIC 583 . 1721))))) (FILEMAP (NIL (534 2130 (KINETIC 544 . 2128)))))
STOP STOP

BIN
lispusers/KINETIC.LCOM
View File

Binary file not shown.