github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-25 20:06:44 +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

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