(FILECREATED "15-Jan-86 23:32:05" {ERIS}<LISPUSERS>KOTO>SOLITAIRE.;5 23494
changes to: (VARS SOLITAIRECOMS)
(FNS SOLO DEALDECK NXTCARD CARDIMAGE COUNTCARDS GOODMOVE? MOVESSS CARDNAME
CREATEHAND CREATESTACK STACKLOC POSTVALUE)
(MACROS KINGP)
previous date: "15-Dec-85 22:01:18" {ERIS}<LISPUSERS>KOTO>SOLITAIRE.;3)
(* Copyright (c) 1982, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SOLITAIRECOMS)
(RPAQQ SOLITAIRECOMS [(FNS SOLO SOLITAIRE)
(FNS CARDIMAGE COUNTCARDS CREATEHAND CREATESTACK DEALDECK FLIPSTACK GETCARD GOODMOVE? HTOS?
MOVECARD DOMOVE MOVEHS MOVES MOVES1 UPCARD MOVESSS NXTCARD PUSHCARD POSTVALUE
SEARCHSTACKS SHOWCARDSTACK SHUFFLEDECK STACKLOC STOS? TOPSUITSTACK)
(FNS HIST ARRAYMAX)
(DECLARE: DONTCOPY (FNS SHOWCONFIG PRINTCARDSTACK CARDNAME))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS BOTTOM KINGP STACK TOP)
(RECORDS CARD CARDSTACK)
(CONSTANTS (Spades 0)
(Clubs 1)
(Diamonds 2)
(Hearts 3)
(CostOfDeck 50)
(PayForCard 5)
(NStacks 7)
(NSuits 4)
(CardsPerSuit 13)
(TotalCards 52))
(CONSTANTS (BACKSHADE 52275)
(BetweenStacks 2)
(Overlap .667)
(CardWidth 30)
(CardHeight 45))
(GLOBALVARS HAND STACKS SUITSTACKS DECK SOLORESULTS)
(GLOBALVARS MaxCardMove WaitBetweenMoves))
(INITRECORDS CARD CARDSTACK)
(BITMAPS SpadesBits ClubsBits DiamondsBits HeartsBits 10Bits)
(INITVARS (MaxCardMove 8)
(WaitBetweenMoves 10)
(DECK)
(SOLORESULTS))
(ADDVARS (IDLE.FUNCTIONS ("Solitaire" (QUOTE SOLO])
(DEFINEQ
(SOLO
[LAMBDA (W) (* bas: "15-Jan-86 23:31")
(if (AND (BOUNDP (QUOTE SOLORESULTS))
(ARRAYP SOLORESULTS))
else (SETQ SOLORESULTS (ARRAY (ADD1 TotalCards)
(QUOTE FIXP)
0 0)))
(if (WINDOWP W)
else (SETQ W (CREATEW [GETREGION (CONSTANT (ITIMES (IPLUS BetweenStacks
(ITIMES NStacks
(ADD1
BetweenStacks)))
CardWidth))
(CONSTANT (ITIMES CardHeight
(IPLUS 5 (FTIMES
CardsPerSuit
Overlap]
"Just waiting Patiently..."))
(DSPTEXTURE 1088 W)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
18)
W))
(bind X
do (SETQ X (SOLITAIRE W))
(DISMISS 1500)
(SETA SOLORESULTS X (ADD1 (ELT SOLORESULTS X)))
(HIST SOLORESULTS W "Number of cards up")
(DISMISS 1500])
(SOLITAIRE
[LAMBDA (SOLOW REPLAY) (* bas: "15-Dec-85 21:33")
(DECLARE (SPECVARS SOLOW))
(CLEARW SOLOW)
(DEALDECK REPLAY)
(PROG ((GAMEVALUE (IMINUS CostOfDeck)))
(DECLARE (SPECVARS GAMEVALUE))
(POSTVALUE GAMEVALUE)
(while (OR [for I from NStacks to 1 by -1 thereis
(MOVES (STACK I)
(STOS? (STACK I]
(MOVESSS HAND)
(MOVEHS HAND (HTOS? HAND))
(for I to NStacks thereis (MOVESSS (STACK I)))
(FLIPSTACK HAND))
do (DISMISS WaitBetweenMoves)))
(COUNTCARDS])
)
(DEFINEQ
(CARDIMAGE
[LAMBDA (C) (* bas: "15-Jan-86 21:37")
(PROG [(BM (BITMAPCREATE CardWidth CardHeight))
(SUITBM (SELECTQ (fetch SUIT of C)
(0 SpadesBits)
(1 ClubsBits)
(2 DiamondsBits)
(3 HeartsBits)
(SHOULDNT)))
(RANKBM (if (EQ 10 (fetch (CARD RANK) of C))
then 10Bits
else (GETCHARBITMAP (SELECTQ (fetch (CARD RANK) of C)
(13 (CHARCODE K))
(12 (CHARCODE Q))
(11 (CHARCODE J))
(IPLUS (fetch (CARD RANK) of C)
(CHARCODE 0)))
(FONTCREATE (QUOTE HELVETICA)
18]
(BLTSHADE BLACKSHADE BM 0 0 CardWidth CardHeight (QUOTE REPLACE))
(BLTSHADE WHITESHADE BM 1 1 (IDIFFERENCE CardWidth 2)
(IDIFFERENCE CardHeight 2)
(QUOTE REPLACE))
(BITBLT SUITBM 0 0 BM 2 32 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT RANKBM 0 0 BM (IQUOTIENT (IDIFFERENCE CardWidth (fetch BITMAPWIDTH
of RANKBM))
2)
(IQUOTIENT (IDIFFERENCE CardHeight (fetch BITMAPHEIGHT of RANKBM))
2)
NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT SUITBM 0 0 BM 17 3 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN BM])
(COUNTCARDS
[LAMBDA NIL (* bas: "15-Jan-86 21:37")
(for S from Spades to Hearts sum (fetch (CARD RANK) of (TOPSUITSTACK S])
(CREATEHAND
[LAMBDA (F) (* bas: "15-Jan-86 23:25")
(FLIPSTACK (SHOWCARDSTACK (create CARDSTACK
FACEUP ← NIL
FACEDOWN ←(for I from F to TotalCards
collect (GETCARD I))
CSX ←(fetch CSX of (STACK 1))
CSY ←(FIX (FTIMES CardHeight .6))
XO ←(FIX (FTIMES CardWidth Overlap))
YO ← 0])
(CREATESTACK
[LAMBDA (N) (* bas: "15-Jan-86 23:00")
(FLIPSTACK (SHOWCARDSTACK (create CARDSTACK
FACEUP ← NIL
FACEDOWN ←(for I
from (ADD1 (IQUOTIENT
(ITIMES N (SUB1 N))
2))
as J to N collect (GETCARD I))
CSX ←(STACKLOC N NStacks)
CSY ←(ITIMES CardHeight (IPLUS 2 (FTIMES
CardsPerSuit
Overlap)))
XO ← 0
YO ←(FIX (FTIMES CardHeight (FMINUS Overlap])
(DEALDECK
[LAMBDA (REDEAL) (* bas: "11-Jan-86 20:14")
(OR (AND REDEAL (ARRAYP DECK))
(SHUFFLEDECK))
(SETQ SUITSTACKS (ARRAY NSuits (QUOTE POINTER)
(create CARD
RANK ← 0)
0))
(SETQ STACKS (ARRAY NStacks (QUOTE POINTER)))
(for I to NStacks do (SETA STACKS I (CREATESTACK I)))
(SETQ HAND (CREATEHAND (CONSTANT (ADD1 (IQUOTIENT (ITIMES NStacks (ADD1 NStacks))
2])
(FLIPSTACK
[LAMBDA (H) (* bas: "29-JUL-82 15:07")
(if (fetch FACEDOWN of H)
then (PUSHCARD H (NXTCARD H))
H
else NIL])
(GETCARD
[LAMBDA (I) (* 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 CX of C with (replace CY of C with NIL))
(RETURN C])
(GOODMOVE?
[LAMBDA (TOP BOT) (* bas: "15-Jan-86 21:38")
(if TOP
then (AND (EQ (fetch (CARD RANK) of TOP)
(ADD1 (fetch (CARD RANK) of BOT)))
(NEQ (fetch (CARD COLOR) of TOP)
(fetch (CARD COLOR) of BOT)))
else (KINGP BOT])
(HTOS?
[LAMBDA (H) (* bas: "30-JUL-82 19:30")
(if (TOP H)
then (SEARCHSTACKS (TOP H])
(MOVECARD
[LAMBDA (C X Y) (* 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)
NIL NIL NIL NIL (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT (fetch FACE of C)
NIL NIL SOLOW X Y NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)))
(replace CX of C with X)
(replace CY of C with Y)
C])
(DOMOVE
[LAMBDA (IMAGE LEFT BOTTOM NX NY SAVE) (* lmm " 6-Aug-85 00:04")
(PROG (N YWP YFP XWP XFP)
(SETQ N (IQUOTIENT (IPLUS (IMAX (ABS (IDIFFERENCE NX LEFT))
(ABS (IDIFFERENCE NY BOTTOM)))
(SUB1 MaxCardMove))
MaxCardMove)) (* Number of steps)
(SETQ XWP (IQUOTIENT (IDIFFERENCE NX LEFT)
N))
(SETQ XFP (IREMAINDER (IDIFFERENCE NX LEFT)
N))
(SETQ YWP (IQUOTIENT (IDIFFERENCE NY BOTTOM)
N))
(SETQ YFP (IREMAINDER (IDIFFERENCE NY BOTTOM)
N))
(bind OLDLEFT OLDLOW (XFC ← 0)
(YFC ← 0) until (AND (EQ LEFT NX)
(EQ BOTTOM NY))
do (SETQ OLDLEFT LEFT)
(SETQ OLDLOW BOTTOM)
[add LEFT XWP (PROG1 (IQUOTIENT (add XFC XFP)
N)
(SETQ XFC (IREMAINDER XFC N]
[add BOTTOM YWP (PROG1 (IQUOTIENT (add YFC YFP)
N)
(SETQ YFC (IREMAINDER YFC N]
(BITBLT SAVE 0 0 SOLOW OLDLEFT OLDLOW CardWidth CardHeight (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT SOLOW LEFT BOTTOM SAVE 0 0 CardWidth CardHeight (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT IMAGE 0 0 SOLOW LEFT BOTTOM CardWidth CardHeight (QUOTE INPUT)
(QUOTE REPLACE])
(MOVEHS
[LAMBDA (H SN) (* bas: "30-JUL-82 19:30")
(if SN
then (PUSHCARD SN (pop (fetch FACEUP of H)))
(OR (TOP H)
(FLIPSTACK H))
SN])
(MOVES
[LAMBDA (S1 S2) (* bas: "30-JUL-82 12:47")
(if S2
then (MOVES1 (fetch FACEUP of S1)
NIL S2)
(replace FACEUP of S1 with NIL)
(FLIPSTACK S1)
S2])
(MOVES1
[LAMBDA (L P S2) (* bas: "30-JUL-82 19:12")
(if L
then (MOVES1 (CDR L)
(CAR L)
S2)
(UPCARD (CAR L)
P)
(PUSHCARD S2 (CAR L])
(UPCARD
[LAMBDA (X Y) (* lmm " 6-Aug-85 00:04")
(* Brings up X image which is assumed to be overlapped
by Y image. Assumes YOFFSET only)
(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)
0 DY CardWidth (IDIFFERENCE CardHeight DY)
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT SOLOW (fetch CX of X)
(fetch CY of X)
(fetch SAV of X)
0 0 CardWidth (IDIFFERENCE CardHeight DY)
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT (fetch FACE of X)
0 0 SOLOW (fetch CX of X)
(fetch CY of X)
CardWidth
(IDIFFERENCE CardHeight DY)
(QUOTE INPUT)
(QUOTE REPLACE])
(MOVESSS
[LAMBDA (S) (* bas: "15-Jan-86 23:23")
(PROG (STS (TS (TOP S)))
(DECLARE (USEDFREE GAMEVALUE))
(AND TS [EQ (fetch (CARD RANK) of TS)
(ADD1 (fetch (CARD RANK) of (TOPSUITSTACK (SETQ STS
(fetch SUIT
of TS]
(PROGN [SETA SUITSTACKS STS (MOVECARD (pop (fetch FACEUP of S))
(STACKLOC (ADD1 STS)
NSuits)
(IPLUS (fetch CSY
of (STACK NStacks))
(FTIMES CardHeight 1.5]
(OR (TOP S)
(FLIPSTACK S))
(POSTVALUE (add GAMEVALUE PayForCard))
(RETURN T])
(NXTCARD
[LAMBDA (S) (* bas: "15-Jan-86 21:44")
(PROG1 (pop (fetch FACEDOWN of S))
(if (fetch FACEDOWN of S)
else (* Last card up, replace surface of card table and
adjust saved image for possibly overlapping exposed
card in the pile)
(BLTSHADE (DSPTEXTURE NIL SOLOW)
SOLOW
(fetch CSX of S)
[IPLUS (fetch CSY of S)
(if (OR (NULL (fetch FACEUP of S))
(ZEROP (fetch YO of S)))
then 0
else (IPLUS CardHeight (fetch YO of S]
(if (OR (NULL (fetch FACEUP of S))
(ZEROP (fetch XO of S)))
then CardWidth
else (fetch XO of S))
(if (OR (NULL (fetch FACEUP of S))
(ZEROP (fetch YO of S)))
then CardHeight
else (IMINUS (fetch YO of S)))
(QUOTE REPLACE))
(if (fetch FACEUP of S)
then (BLTSHADE (DSPTEXTURE NIL SOLOW)
(fetch SAV of (BOTTOM S))
0
(IMINUS (fetch YO of S))
(IDIFFERENCE CardWidth (fetch XO of S))
CardHeight
(QUOTE REPLACE])
(PUSHCARD
[LAMBDA (S C) (* bas: "30-JUL-82 14:37")
[MOVECARD C (IPLUS (fetch XO of S)
(if (fetch FACEUP of S)
then (fetch CX of (CAR (fetch FACEUP of S)))
else (fetch CSX of S)))
(IPLUS (fetch YO of S)
(if (fetch FACEUP of S)
then (fetch CY of (CAR (fetch FACEUP of S)))
else (fetch CSY of S]
(push (fetch FACEUP of S)
C])
(POSTVALUE
[LAMBDA (V) (* bas: "15-Jan-86 23:25")
(MOVETO (CONSTANT (FIX (FTIMES 25 Overlap CardWidth)))
CardHeight SOLOW)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
18)
SOLOW)
(BLTSHADE (DSPTEXTURE NIL SOLOW)
SOLOW
(DSPXPOSITION NIL SOLOW)
(IDIFFERENCE (DSPYPOSITION NIL SOLOW)
(FONTPROP (DSPFONT NIL SOLOW)
(QUOTE DESCENT)))
1000
(FONTPROP (DSPFONT NIL SOLOW)
(QUOTE HEIGHT))
(QUOTE REPLACE))
(DSPOPERATION (PROG1 (DSPOPERATION (QUOTE PAINT)
SOLOW)
(if (ILESSP V 0)
then (printout SOLOW "Down by $" (IMINUS V)
" ")
elseif (ZEROP V)
then (printout SOLOW "Dead even! ")
else (printout SOLOW "Ahead by $" V " ")))
SOLOW])
(SEARCHSTACKS
[LAMBDA (K) (* bas: "30-JUL-82 19:19")
(for I to NStacks when (GOODMOVE? (TOP (STACK I))
K)
do (RETURN (STACK I])
(SHOWCARDSTACK
[LAMBDA (S) (* lmm " 6-Aug-85 00:04")
(if (fetch FACEDOWN of S)
then (BITBLT NIL NIL NIL SOLOW (fetch CSX of S)
(fetch CSY of S)
CardWidth CardHeight (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL SOLOW (ADD1 (fetch CSX of S))
(ADD1 (fetch CSY of S))
(IDIFFERENCE CardWidth 2)
(IDIFFERENCE CardHeight 2)
(QUOTE TEXTURE)
(QUOTE REPLACE)
BACKSHADE))
S])
(SHUFFLEDECK
[LAMBDA NIL (* bas: "30-JUL-82 14:08")
[if (AND (BOUNDP (QUOTE DECK))
(ARRAYP DECK))
else (SETQ DECK (ARRAY TotalCards (QUOTE POINTER)))
(bind (I ← 0) for S from Spades to Hearts
do (for R to CardsPerSuit do (SETA DECK (add I 1)
(create CARD
SUIT ← S
RANK ← R]
(bind Y for I to TotalCards do (SETQ Y (RAND 1 TotalCards))
(SETA DECK I (PROG1 (ELT DECK Y)
(SETA DECK Y (ELT DECK I])
(STACKLOC
[LAMBDA (I N) (* bas: "15-Jan-86 22:21")
(IPLUS [ITIMES I (FIXR (FQUOTIENT (IDIFFERENCE (WINDOWPROP SOLOW (QUOTE WIDTH))
(ITIMES N CardWidth))
(ADD1 N]
(ITIMES CardWidth (SUB1 I])
(STOS?
[LAMBDA (SN) (* bas: " 7-JAN-81 22:01")
(AND (fetch FACEUP of SN)
[OR (fetch FACEDOWN of SN)
(NOT (KINGP (BOTTOM SN]
(SEARCHSTACKS (BOTTOM SN])
(TOPSUITSTACK
[LAMBDA (I) (* bas: " 4-JAN-81 01:39")
(ELT SUITSTACKS I])
)
(DEFINEQ
(HIST
[LAMBDA (A W L) (* bas: "15-Dec-85 20:22")
(PROG ((WH (WINDOWPROP W (QUOTE HEIGHT)))
(WW (WINDOWPROP W (QUOTE WIDTH)))
(HM NIL)
(VM (IPLUS (FONTPROP (DSPFONT NIL W)
(QUOTE HEIGHT))
4)))
(SETQ HM VM) (* Margins could be different eg if Y labels were
used)
(BLTSHADE WHITESHADE W 0 0 WW WH (QUOTE REPLACE))
[PROG [(HS (IQUOTIENT (IDIFFERENCE WW (ITIMES HM 2))
(ARRAYSIZE A)))
(VS (FQUOTIENT (IDIFFERENCE WH (ITIMES VM 2))
(ARRAYMAX A]
(for I from (ARRAYORIG A) to (IPLUS (ARRAYSIZE A)
(ARRAYORIG A)
-1)
do (BLTSHADE GRAYSHADE W (IPLUS HM (ITIMES I HS))
VM HS (FIX (FTIMES VS (ELT A I)))
(QUOTE REPLACE]
(DRAWLINE HM VM (IDIFFERENCE WW HM)
VM 2 (QUOTE REPLACE)
W)
(DRAWLINE HM VM HM (IDIFFERENCE WH VM)
2
(QUOTE REPLACE)
W)
(MOVETO (IDIFFERENCE (IDIFFERENCE WW HM)
(STRINGWIDTH L (DSPFONT NIL W)))
(IPLUS (FONTPROP (DSPFONT NIL W)
(QUOTE DESCENT))
2)
W)
(PRIN1 L W])
(ARRAYMAX
[LAMBDA (A) (* bas: " 5-AUG-82 14:59")
(bind (M ← 0) for I from (ARRAYORIG A) to (IPLUS (ARRAYSIZE A)
(ARRAYORIG A)
-1)
when (LESSP M (ELT A I)) do (SETQ M (ELT A I)) finally (RETURN M])
)
(DECLARE: DONTCOPY
(DEFINEQ
(SHOWCONFIG
[LAMBDA NIL (* bas: "30-JUL-82 19:20")
(printout NIL "Suits: " 10)
(for I from Spades to Hearts do (printout NIL (CARDNAME (TOPSUITSTACK I))
,))
(TERPRI)
(for I to NStacks do (PRINTCARDSTACK (STACK I)
(CONCAT "Stack " I)))
(PRINTCARDSTACK HAND "Hand"])
(PRINTCARDSTACK
[LAMBDA (X S) (* bas: " 6-JAN-81 16:47")
(printout NIL S ":" 10 .I2 (LENGTH (fetch FACEDOWN X))
" down. Up: ")
(for J in (fetch FACEUP of X) do (printout NIL (CARDNAME J)
,))
(TERPRI])
(CARDNAME
[LAMBDA (C) (* bas: "15-Jan-86 21:40")
(if (ZEROP (fetch (CARD RANK) of C))
then "None"
else (PACK (LIST (SELECTQ (fetch (CARD SUIT) of C)
(0 (QUOTE S))
(1 (QUOTE C))
(2 (QUOTE D))
(3 (QUOTE H))
(SHOULDNT))
(SELECTQ (fetch (CARD RANK) of C)
(1 (QUOTE A))
(11 (QUOTE J))
(12 (QUOTE Q))
(13 (QUOTE K))
(fetch (CARD RANK) of C])
)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS BOTTOM MACRO ((S)
(CAR (LAST (fetch FACEUP of S]
[PUTPROPS KINGP MACRO ((C)
(EQ CardsPerSuit (fetch (CARD RANK)
of C]
(PUTPROPS STACK MACRO ((N)
(ELT STACKS N)))
[PUTPROPS TOP MACRO ((S)
(CAR (fetch FACEUP of S]
)
[DECLARE: EVAL@COMPILE
(DATATYPE CARD (SUIT RANK FACE SAV CX CY)
(ACCESSFNS CARD (COLOR (ILESSP (fetch SUIT of DATUM)
Diamonds))))
(RECORD CARDSTACK (FACEUP FACEDOWN CSX CSY XO YO))
]
(/DECLAREDATATYPE (QUOTE CARD)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((CARD 0 POINTER)
(CARD 2 POINTER)
(CARD 4 POINTER)
(CARD 6 POINTER)
(CARD 8 POINTER)
(CARD 10 POINTER)))
(QUOTE 12))
(DECLARE: EVAL@COMPILE
(RPAQQ Spades 0)
(RPAQQ Clubs 1)
(RPAQQ Diamonds 2)
(RPAQQ Hearts 3)
(RPAQQ CostOfDeck 50)
(RPAQQ PayForCard 5)
(RPAQQ NStacks 7)
(RPAQQ NSuits 4)
(RPAQQ CardsPerSuit 13)
(RPAQQ TotalCards 52)
(CONSTANTS (Spades 0)
(Clubs 1)
(Diamonds 2)
(Hearts 3)
(CostOfDeck 50)
(PayForCard 5)
(NStacks 7)
(NSuits 4)
(CardsPerSuit 13)
(TotalCards 52))
)
(DECLARE: EVAL@COMPILE
(RPAQQ BACKSHADE 52275)
(RPAQQ BetweenStacks 2)
(RPAQQ Overlap .667)
(RPAQQ CardWidth 30)
(RPAQQ CardHeight 45)
(CONSTANTS (BACKSHADE 52275)
(BetweenStacks 2)
(Overlap .667)
(CardWidth 30)
(CardHeight 45))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HAND STACKS SUITSTACKS DECK SOLORESULTS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MaxCardMove WaitBetweenMoves)
)
)
(/DECLAREDATATYPE (QUOTE CARD)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((CARD 0 POINTER)
(CARD 2 POINTER)
(CARD 4 POINTER)
(CARD 6 POINTER)
(CARD 8 POINTER)
(CARD 10 POINTER)))
(QUOTE 12))
(RPAQ SpadesBits (READBITMAP))
(11 11
"@D@@"
"@N@@"
"AO@@"
"COH@"
"GOL@"
"GOL@"
"GOL@"
"COH@"
"@D@@"
"AO@@"
"COH@")
(RPAQ ClubsBits (READBITMAP))
(11 11
"@D@@"
"@N@@"
"AO@@"
"@N@@"
"BDH@"
"GEL@"
"OON@"
"GEL@"
"BDH@"
"@N@@"
"COH@")
(RPAQ DiamondsBits (READBITMAP))
(11 11
"@D@@"
"@N@@"
"AK@@"
"CAH@"
"F@L@"
"L@F@"
"F@L@"
"CAH@"
"AK@@"
"@N@@"
"@D@@")
(RPAQ HeartsBits (READBITMAP))
(11 11
"@@@@"
"CAH@"
"GKL@"
"DND@"
"D@D@"
"F@L@"
"CAH@"
"AK@@"
"@N@@"
"@D@@"
"@@@@")
(RPAQ 10Bits (READBITMAP))
(20 18
"@@@@@@@@"
"@F@GL@@@"
"@N@ON@@@"
"GNALG@@@"
"GNAHC@@@"
"@FAHC@@@"
"@FAHC@@@"
"@FAHC@@@"
"@FAHC@@@"
"@FAHC@@@"
"@FAHC@@@"
"@FALG@@@"
"@F@ON@@@"
"@F@GL@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")
(RPAQ? MaxCardMove 8)
(RPAQ? WaitBetweenMoves 10)
(RPAQ? DECK )
(RPAQ? SOLORESULTS )
(ADDTOVAR IDLE.FUNCTIONS ("Solitaire" (QUOTE SOLO)))
(PUTPROPS SOLITAIRE COPYRIGHT ("Xerox Corporation" 1982 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1624 3406 (SOLO 1634 . 2699) (SOLITAIRE 2701 . 3404)) (3407 17559 (CARDIMAGE 3417 .
4854) (COUNTCARDS 4856 . 5068) (CREATEHAND 5070 . 5525) (CREATESTACK 5527 . 6136) (DEALDECK 6138 .
6687) (FLIPSTACK 6689 . 6909) (GETCARD 6911 . 7339) (GOODMOVE? 7341 . 7706) (HTOS? 7708 . 7867) (
MOVECARD 7869 . 8491) (DOMOVE 8493 . 9921) (MOVEHS 9923 . 10158) (MOVES 10160 . 10429) (MOVES1 10431
. 10672) (UPCARD 10674 . 11691) (MOVESSS 11693 . 12456) (NXTCARD 12458 . 13928) (PUSHCARD 13930 .
14484) (POSTVALUE 14486 . 15427) (SEARCHSTACKS 15429 . 15654) (SHOWCARDSTACK 15656 . 16269) (
SHUFFLEDECK 16271 . 16859) (STACKLOC 16861 . 17182) (STOS? 17184 . 17423) (TOPSUITSTACK 17425 . 17557)
) (17560 19275 (HIST 17570 . 18957) (ARRAYMAX 18959 . 19273)) (19296 20605 (SHOWCONFIG 19306 . 19716)
(PRINTCARDSTACK 19718 . 20040) (CARDNAME 20042 . 20603)))))
STOP