github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-27 12:52:06 +00:00
Code Issues Projects Releases Wiki Activity

FILEWATCH, QIX, SOLITAIRE--rename fields that conflict with REGION and POINT (#1763)

Browse Source
This commit is contained in:
rmkaplan
2024-06-16 21:17:48 -07:00
committed by GitHub
parent 3e77f627a0
commit ffe99d6bcc
6 changed files with 133 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
lispusers/FILEWATCH
View File

Binary file not shown.

BIN
lispusers/FILEWATCH.LCOM
View File

Binary file not shown.

193
lispusers/QIX
View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "24-Aug-2022 07:58:48" |{DSK}<home>larry>medley>lispusers>QIX.;2| 11276
(FILECREATED "14-Jun-2024 14:54:24" |{WMEDLEY}<lispusers>QIX.;4| 12192
:CHANGES-TO (FNS QIX.IDLE)
:EDIT-BY |rmk|
:PREVIOUS-DATE "12-Aug-87 03:05:50" |{DSK}<home>larry>medley>lispusers>QIX.;1|)
:CHANGES-TO (FNS QIX.GROW)
:PREVIOUS-DATE "14-Jun-2024 14:49:48" |{WMEDLEY}<lispusers>QIX.;3|)
; Copyright (c) 1987 by Xerox Corporation.
(PRETTYCOMPRINT QIXCOMS)
@@ -18,69 +18,72 @@
(DEFINEQ
(QIX.GROW
(LAMBDA (WINDOW DONTDISMISS) (* \; "Edited 1-Aug-87 16:57 by JEFF.SHRAGER")
(* * |This| |sets| |up| \a QIX |the| |specified| |window.|
 |The| |QIX's| |parameters| |are| |defined| |at| |random,| |but| |with|
 |reasonable| |value| |ranges.| |The| |dismiss| |argument| |tell| |the| QIX
 |whether| |to| DISMISS |every| |cycle| |or| |not.|
 B\e |careful.|)
(LAMBDA (WINDOW DONTDISMISS) (* \; "Edited 14-Jun-2024 14:54 by rmk")
(* \;
 "Edited 1-Aug-87 16:57 by JEFF.SHRAGER")
(* |;;;| "This sets up a QIX the specified window. The QIX's parameters are defined at random, but with reasonable value ranges. The dismiss argument tell the QIX whether to DISMISS every cycle or not. Be careful.")
(PROG (P P2 (W (OR WINDOW (CREATEW)))
L)
(SETQ *STOP.QIXS* NIL)
(* * P |and| P2 |define| \a QIX.)
(* |;;;| "P and P2 define a QIX.")
(SETQ P (|create| QIX.POINT
X _ (RAND 1 200)
Y _ (RAND 1 100)
QX _ (RAND 1 200)
QY _ (RAND 1 100)
VH _ (RAND 1 20)
VV _ (RAND 1 20)))
(SETQ P2 (|create| QIX.POINT
X _ (RAND 1 200)
Y _ (RAND 1 100)
QX _ (RAND 1 200)
QY _ (RAND 1 100)
VH _ (RAND 1 20)
VV _ (RAND 1 20)))
(* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and|
 |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's|
 |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)
(* |;;;| "L is the tail list. It starts out full of NILs and gets filled as the QIX moves. It is also inserted in it's own mouth so that the whole thing wraps around.")
(SETQ L (APPEND (|for| X |from| 1 |to| (RAND 5 25)
|collect| (COPY '(A S D F)))
(LIST (LIST (|fetch| X P)
(|fetch| Y P)
(|fetch| X P2)
(|fetch| Y P2)))))
(LIST (LIST (|fetch| (QIX.POINT QX)
P)
(|fetch| (QIX.POINT QY)
P)
(|fetch| (QIX.POINT QX)
P2)
(|fetch| (QIX.POINT QY)
P2)))))
(RPLACD (LAST L)
L)
LOOP
(COND
(*STOP.QIXS* (RPLACD L NIL)
(RETURN NIL)))
(* * |Draw| |the| |QIX's| |head| |line.|)
(MOVETO (|fetch| X P)
(|fetch| Y P)
(* |;;;| "Draw the QIX's head line.")
(MOVETO (|fetch| (QIX.POINT QX)
P)
(|fetch| (QIX.POINT QY)
P)
W)
(DRAWTO (|fetch| X P2)
(|fetch| Y P2)
(DRAWTO (|fetch| (QIX.POINT QX)
P2)
(|fetch| (QIX.POINT QY)
P2)
1
'REPLACE W)
(* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)
(* |;;;| "Move the points according to their QX and QY velocities.")
(QIX.MOVE.POINT P W)
(QIX.MOVE.POINT P2 W)
(* * |Take| \a |deep| |breath| |if| |the| |user| |asks| |you| |to.|
 |This| |slows| |things| |down.|)
(* |;;;| "Take a deep breath if the user asks you to. This slows things down.")
(OR DONTDISMISS (DISMISS))
(* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)
(* |;;;| "Delete the first object on the tail list.")
(COND
((EQ (CAAR L)
@@ -93,60 +96,63 @@
(CADDDR OLD)
1
'ERASE W))))
(* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which|
 |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we|
 |them| |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular|
 |list.|)
(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we them immediately move to the next elt in this circular list.")
(RPLACA (CAR L)
(|fetch| X P))
(|fetch| (QIX.POINT QX)
P))
(RPLACA (CDAR L)
(|fetch| Y P))
(|fetch| (QIX.POINT QY)
P))
(RPLACA (CDDAR L)
(|fetch| X P2))
(|fetch| (QIX.POINT QX)
P2))
(RPLACA (CDDDAR L)
(|fetch| Y P2))
(|fetch| (QIX.POINT QY)
P2))
(SETQ L (CDR L))
(GO LOOP))))
(QIX.IDLE
(LAMBDA (W) (* \; "Edited 24-Aug-2022 07:53 by larry")
(LAMBDA (W) (* \; "Edited 14-Jun-2024 14:49 by rmk")
(* \; "Edited 24-Aug-2022 07:53 by larry")
(* \;
 "Edited 1-Aug-87 16:58 by JEFF.SHRAGER")
(* * CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND
 (WASTING SPACE) FROM BEFORE.)
(* |;;;| "CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND (WASTING SPACE) FROM BEFORE.")
(AND (BOUNDP '*OLD-QIXS*)
(FOR Q IN *OLD-QIXS* DO (RPLACD Q NIL)))
(PROG (P P2 L QIXS)
(* * P |and| P2 |define| \a QIX.)
(* |;;;| "P and P2 define a QIX.")
(SETQ QIXS (|for| I |from| 1 |to| 5
|collect| (PROGN (SETQ P (|create| QIX.POINT
X _ (RAND 1 200)
Y _ (RAND 1 100)
QX _ (RAND 1 200)
QY _ (RAND 1 100)
VH _ (RAND 1 20)
VV _ (RAND 1 20)))
(SETQ P2 (|create| QIX.POINT
X _ (RAND 1 200)
Y _ (RAND 1 100)
QX _ (RAND 1 200)
QY _ (RAND 1 100)
VH _ (RAND 1 20)
VV _ (RAND 1 20)))
(* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and|
 |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's|
 |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)
(* |;;;| "L is the tail list. It starts out full of NILs and gets filled as the QIX moves. It is also inserted in it's own mouth so that the whole thing wraps around.")
(SETQ L
(APPEND (|for| X |from| 1 |to| (RAND 5 25)
|collect| (COPY '(A S D F)))
(LIST (LIST (|fetch| X P)
(|fetch| Y P)
(|fetch| X P2)
(|fetch| Y P2)))))
(LIST (LIST (|fetch| (QIX.POINT QX)
P)
(|fetch| (QIX.POINT QY)
P)
(|fetch| (QIX.POINT QX)
P2)
(|fetch| (QIX.POINT QY)
P2)))))
(RPLACD (LAST L)
L)
(LIST P P2 L))))
@@ -157,22 +163,26 @@
(SETQ P2 (CADR Q))
(SETQ L (CADDR Q))
(* * |Draw| |the| |QIX's| |head| |line.|)
(* |;;;| "Draw the QIX's head line.")
(MOVETO (|fetch| X P)
(|fetch| Y P)
(MOVETO (|fetch| (QIX.POINT QX)
P)
(|fetch| (QIX.POINT QY)
P)
W)
(DRAWTO (|fetch| X P2)
(|fetch| Y P2)
(DRAWTO (|fetch| (QIX.POINT QX)
P2)
(|fetch| (QIX.POINT QY)
P2)
1
'REPLACE W)
(* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)
(* |;;;| "Move the points according to their QX and QY velocities.")
(QIX.MOVE.POINT P W)
(QIX.MOVE.POINT P2 W)
(* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)
(* |;;;| "Delete the first object on the tail list.")
(COND
((EQ (CAAR L)
@@ -186,34 +196,36 @@
1
'ERASE W))))
(* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which|
 |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| THEN
 |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| |list.|)
(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we THEN immediately move to the next elt in this circular list.")
(RPLACA (CAR L)
(|fetch| X P))
(|fetch| (QIX.POINT QX)
P))
(RPLACA (CDAR L)
(|fetch| Y P))
(|fetch| (QIX.POINT QY)
P))
(RPLACA (CDDAR L)
(|fetch| X P2))
(|fetch| (QIX.POINT QX)
P2))
(RPLACA (CDDDAR L)
(|fetch| Y P2))
(|fetch| (QIX.POINT QY)
P2))
(RPLACA (CDDR Q)
(CDR L)))
(GO LOOP))))
(QIX.MOVE.POINT
(LAMBDA (P W) (* |edited:| "16-May-85 00:39")
(* * |This| |guy| |updates| |the| QIX |line| |endpoints| |according| |to|
 |their| |velocities| |in| |the| X |and| Y |directions.|
 I\f |we| |hit| \a |wall,| |then| |simply| |negate| |the| |relevant| |velocity|
 |vector.|)
(LAMBDA (P W) (* \; "Edited 14-Jun-2024 14:48 by rmk")
(* |edited:| "16-May-85 00:39")
(* |;;;| "This guy updates the QIX line endpoints according to their velocities in the X and Y directions. If we hit a wall, then simply negate the relevant velocity vector.")
(PROG ((VV (|fetch| VV P))
(VH (|fetch| VH P))
(X (|fetch| X P))
(Y (|fetch| Y P)))
(X (|fetch| (QIX.POINT QX)
P))
(Y (|fetch| (QIX.POINT QY)
P)))
(PROG ((NEWX (IPLUS X VH))
(NEWY (IPLUS Y VV)))
(COND
@@ -230,8 +242,10 @@
((GREATERP NEWX (WINDOWPROP W 'WIDTH))
(SETQ NEWX (WINDOWPROP W 'WIDTH))
(SETQ VH (ITIMES -1 VH))))
(|replace| Y P NEWY)
(|replace| X P NEWX)
(|replace| (QIX.POINT QY)
P NEWY)
(|replace| (QIX.POINT QX)
P NEWX)
(|replace| VV P VV)
(|replace| VH P VH)))))
@@ -249,13 +263,12 @@
)
(DECLARE\: EVAL@COMPILE
(RECORD QIX.POINT (X Y VH VV))
(RECORD QIX.POINT (QX QY VH VV))
)
(SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE)
IDLE.FUNCTIONS))
(PUTPROPS QIX COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (592 11044 (QIX.GROW 602 . 4158) (QIX.IDLE 4160 . 8972) (QIX.MOVE.POINT 8974 . 10356) (
QIX.PLAY 10358 . 11042)))))
(FILEMAP (NIL (544 12010 (QIX.GROW 554 . 4311) (QIX.IDLE 4313 . 9800) (QIX.MOVE.POINT 9802 . 11322) (
QIX.PLAY 11324 . 12008)))))
STOP

BIN
lispusers/QIX.LCOM
View File

Binary file not shown.

59
lispusers/SOLITAIRE
View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Aug-2022 08:54:17" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;2 26883
(FILECREATED "14-Jun-2024 15:48:55" {WMEDLEY}<lispusers>SOLITAIRE.;4 27251
:CHANGES-TO (FNS SOLO DEALDECK GETCARD)
(VARS SOLITAIRECOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "15-Jan-86 23:32:05" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;1)
:CHANGES-TO (RECORDS CARD)
(FNS GETCARD MOVECARD UPCARD NXTCARD)
:PREVIOUS-DATE "24-Aug-2022 08:54:17" {WMEDLEY}<lispusers>SOLITAIRE.;2)
(* ; "
Copyright (c) 1982, 1985-1986 by Xerox Corporation.
")
(PRETTYCOMPRINT SOLITAIRECOMS)
@@ -169,11 +167,12 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
else NIL])
(GETCARD
[LAMBDA (I) (* bas%: "30-JUL-82 19:04")
[LAMBDA (I) (* ; "Edited 14-Jun-2024 15:48 by rmk")
(* bas%: "30-JUL-82 19:04")
(PROG ((C (ELT DECK I)))
(if (fetch FACE of C)
else (replace FACE of C with (CARDIMAGE C))
(replace SAV of C with (BITMAPCREATE CardWidth CardHeight)))
(replace (CARD CDSAV) of C with (BITMAPCREATE CardWidth CardHeight)))
(replace CX of C with (replace CY of C with NIL))
(RETURN C])
@@ -192,13 +191,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
then (SEARCHSTACKS (TOP H])
(MOVECARD
[LAMBDA (C X Y) (* lmm " 6-Aug-85 00:04")
[LAMBDA (C X Y) (* ; "Edited 14-Jun-2024 15:46 by rmk")
(* lmm " 6-Aug-85 00:04")
(if (fetch CX of C)
then (DOMOVE (fetch FACE of C)
(fetch CX of C)
(fetch CY of C)
X Y (fetch SAV of C))
else (BITBLT SOLOW X Y (fetch SAV of C)
X Y (fetch (CARD CDSAV) of C))
else (BITBLT SOLOW X Y (fetch (CARD CDSAV) of C)
NIL NIL NIL NIL 'INPUT 'REPLACE)
(BITBLT (fetch FACE of C)
NIL NIL SOLOW X Y NIL NIL 'INPUT 'REPLACE))
@@ -264,7 +264,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
(PUSHCARD S2 (CAR L])
(UPCARD
[LAMBDA (X Y) (* lmm " 6-Aug-85 00:04")
[LAMBDA (X Y) (* ; "Edited 14-Jun-2024 15:46 by rmk")
(* lmm " 6-Aug-85 00:04")
(* Brings up X image which is assumed to be overlapped by Y image.
 Assumes YOFFSET only)
@@ -272,14 +273,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
(if Y
then (PROG [(DY (IDIFFERENCE (fetch CY of X)
(fetch CY of Y]
(BITBLT (fetch SAV of X)
0 0 (fetch SAV of Y)
(BITBLT (fetch (CARD CDSAV) of X)
0 0 (fetch (CARD CDSAV) of Y)
0 DY CardWidth (IDIFFERENCE CardHeight DY)
'INPUT
'REPLACE)
(BITBLT SOLOW (fetch CX of X)
(fetch CY of X)
(fetch SAV of X)
(fetch (CARD CDSAV) of X)
0 0 CardWidth (IDIFFERENCE CardHeight DY)
'INPUT
'REPLACE)
@@ -308,7 +309,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
(RETURN T])
(NXTCARD
[LAMBDA (S) (* bas%: "15-Jan-86 21:44")
[LAMBDA (S) (* ; "Edited 14-Jun-2024 15:46 by rmk")
(* bas%: "15-Jan-86 21:44")
(PROG1 (pop (fetch FACEDOWN of S))
[if (fetch FACEDOWN of S)
else
@@ -335,7 +337,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
'REPLACE)
(if (fetch FACEUP of S)
then (BLTSHADE (DSPTEXTURE NIL SOLOW)
(fetch SAV of (BOTTOM S))
(fetch (CARD CDSAV) of (BOTTOM S))
0
(IMINUS (fetch YO of S))
(IDIFFERENCE CardWidth (fetch XO of S))
@@ -531,7 +533,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(DATATYPE CARD (SUIT RANK FACE SAV CX CY)
(DATATYPE CARD (SUIT RANK FACE CDSAV CX CY)
(ACCESSFNS CARD (COLOR (ILESSP (fetch SUIT of DATUM)
Diamonds))))
@@ -642,15 +644,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
(RPAQ? SOLORESULTS )
(ADDTOVAR IDLE.FUNCTIONS ("Solitaire" 'SOLO))
(PUTPROPS SOLITAIRE COPYRIGHT ("Xerox Corporation" 1982 1985 1986))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1950 4087 (SOLO 1960 . 3297) (SOLITAIRE 3299 . 4085)) (4088 20454 (CARDIMAGE 4098 .
5754) (COUNTCARDS 5756 . 5969) (CREATEHAND 5971 . 6576) (CREATESTACK 6578 . 7427) (DEALDECK 7429 .
8012) (FLIPSTACK 8014 . 8249) (GETCARD 8251 . 8701) (GOODMOVE? 8703 . 9100) (HTOS? 9102 . 9269) (
MOVECARD 9271 . 9910) (DOMOVE 9912 . 11543) (MOVEHS 11545 . 11816) (MOVES 11818 . 12129) (MOVES1 12131
. 12433) (UPCARD 12435 . 13651) (MOVESSS 13653 . 14595) (NXTCARD 14597 . 16369) (PUSHCARD 16371 .
17033) (POSTVALUE 17035 . 18036) (SEARCHSTACKS 18038 . 18281) (SHOWCARDSTACK 18283 . 18912) (
SHUFFLEDECK 18914 . 19718) (STACKLOC 19720 . 20052) (STOS? 20054 . 20316) (TOPSUITSTACK 20318 . 20452)
) (20455 22457 (HIST 20465 . 22054) (ARRAYMAX 22056 . 22455)) (22479 24001 (SHOWCONFIG 22489 . 22951)
(PRINTCARDSTACK 22953 . 23305) (CARDNAME 23307 . 23999)))))
(FILEMAP (NIL (1885 4022 (SOLO 1895 . 3232) (SOLITAIRE 3234 . 4020)) (4023 20888 (CARDIMAGE 4033 .
5689) (COUNTCARDS 5691 . 5904) (CREATEHAND 5906 . 6511) (CREATESTACK 6513 . 7362) (DEALDECK 7364 .
7947) (FLIPSTACK 7949 . 8184) (GETCARD 8186 . 8754) (GOODMOVE? 8756 . 9153) (HTOS? 9155 . 9322) (
MOVECARD 9324 . 10090) (DOMOVE 10092 . 11723) (MOVEHS 11725 . 11996) (MOVES 11998 . 12309) (MOVES1
12311 . 12613) (UPCARD 12615 . 13967) (MOVESSS 13969 . 14911) (NXTCARD 14913 . 16803) (PUSHCARD 16805
. 17467) (POSTVALUE 17469 . 18470) (SEARCHSTACKS 18472 . 18715) (SHOWCARDSTACK 18717 . 19346) (
SHUFFLEDECK 19348 . 20152) (STACKLOC 20154 . 20486) (STOS? 20488 . 20750) (TOPSUITSTACK 20752 . 20886)
) (20889 22891 (HIST 20899 . 22488) (ARRAYMAX 22490 . 22889)) (22913 24435 (SHOWCONFIG 22923 . 23385)
(PRINTCARDSTACK 23387 . 23739) (CARDNAME 23741 . 24433)))))
STOP

BIN
lispusers/SOLITAIRE.LCOM
View File

Binary file not shown.