(FILECREATED " 6-Aug-85 00:04:43" {ERIS}<LISPUSERS>SOLITAIRE.;4 22271
changes to: (FNS SOLO DEALDECK MOVECARD DOMOVE UPCARD NXTCARD POSTVALUE SHOWCARDSTACK HIST)
(VARS SOLITAIRECOMS)
previous date: " 5-Aug-85 23:56:40" {ERIS}<LISPUSERS>SOLITAIRE.;3)
(* Copyright (c) 1982, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SOLITAIRECOMS)
(RPAQQ SOLITAIRECOMS [(FNS CARDIMAGE COUNTCARDS CREATEHAND CREATESTACK DEALDECK FLIPSTACK GETCARD
GOODMOVE? HTOS? MOVECARD DOMOVE MOVEHS MOVES MOVES1 UPCARD MOVESSS NXTCARD
PUSHCARD POSTVALUE SEARCHSTACKS SHOWCARDSTACK SHUFFLEDECK SOLITAIRE STOS?
TOPSUITSTACK)
(FNS SOLO 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 3)
(Overlap .667)
(CardWidth 30)
(CardHeight 45))
(GLOBALVARS STACKS HAND SUITSTACKS DECK SOLORESULTS)
(GLOBALVARS MaxCardMove WaitBetweenMoves))
(INITRECORDS CARD CARDSTACK)
(BITMAPS SpadesBits ClubsBits DiamondsBits HeartsBits 10Bits)
(VARS (MaxCardMove 8)
(WaitBetweenMoves 10)
(DECK)
(SOLITAIREWINDOW))
(ADDVARS (IDLE.FUNCTIONS ("Solitaire" (QUOTE SOLO])
(DEFINEQ
(CARDIMAGE
[LAMBDA (C) (* bas: " 6-AUG-82 11:04")
(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 RANK of C))
then 10Bits
else (GETCHARBITMAP (SELECTQ (fetch RANK of C)
(13 (CHARCODE K))
(12 (CHARCODE Q))
(11 (CHARCODE J))
(IPLUS (fetch RANK of C)
(CHARCODE 0)))
(FONTCREATE (QUOTE HELVETICA)
18]
(BITBLT NIL NIL NIL BM NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL BM 1 1 (IDIFFERENCE CardWidth 2)
(IDIFFERENCE CardHeight 2)
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(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: " 4-JAN-81 01:45")
(for S from Spades to Hearts sum (fetch RANK of (TOPSUITSTACK S])
(CREATEHAND
[LAMBDA (F) (* bas: "30-JUL-82 19:08")
(FLIPSTACK (SHOWCARDSTACK (create CARDSTACK
FACEUP ← NIL
FACEDOWN ←(for I from F to TotalCards collect (GETCARD I))
CSX ←(ITIMES CardWidth BetweenStacks)
CSY ← CardHeight
XO ←(FIX (FTIMES CardWidth Overlap))
YO ← 0])
(CREATESTACK
[LAMBDA (N) (* bas: "30-JUL-82 19:04")
(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 ←[ITIMES CardWidth (SUB1 (ITIMES N (ADD1 BetweenStacks]
CSY ←(ITIMES CardHeight (IPLUS 3 (FTIMES CardsPerSuit Overlap)))
XO ← 0
YO ←(FIX (FTIMES CardHeight (FMINUS Overlap])
(DEALDECK
[LAMBDA (REDEAL) (* lmm " 6-Aug-85 00:04")
(OR (AND REDEAL (ARRAYP DECK))
(SHUFFLEDECK))
[CLEARW (OR SOLOW (SETQ SOLOW SOLITAIREWINDOW)
(PROG1 (SETQ SOLOW (SETQ SOLITAIREWINDOW
(CREATEW [create REGION
LEFT ← 32
BOTTOM ← 64
WIDTH ← (CONSTANT (ITIMES (ADD1 NStacks)
(ADD1 BetweenStacks)
CardWidth))
HEIGHT ← (CONSTANT (ITIMES CardHeight
(IPLUS 7 (FTIMES CardsPerSuit
Overlap]
"Just waiting Patiently...")))
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
18)
SOLOW)
(DSPTEXTURE 1088 SOLOW]
(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: " 7-JAN-81 21:52")
(if TOP
then (AND (EQ (fetch RANK of TOP)
(ADD1 (fetch RANK of BOT)))
(NEQ (fetch COLOR of TOP)
(fetch 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: " 6-AUG-82 11:18")
(PROG (STS (TS (TOP S)))
(DECLARE (USEDFREE GAMEVALUE))
(AND TS [EQ (fetch RANK of TS)
(ADD1 (fetch RANK of (TOPSUITSTACK (SETQ STS (fetch SUIT of TS]
(PROGN (SETA SUITSTACKS STS (MOVECARD (pop (fetch FACEUP of S))
(ITIMES 2 BetweenStacks CardWidth (ADD1 STS))
(IPLUS (fetch CSY of (STACK NStacks))
CardHeight CardHeight)))
(OR (TOP S)
(FLIPSTACK S))
(POSTVALUE (add GAMEVALUE PayForCard))
(RETURN T])
(NXTCARD
[LAMBDA (S) (* lmm " 6-Aug-85 00:04")
(PROG1 (pop (fetch FACEDOWN of S))
(if (fetch FACEDOWN of S)
else (BITBLT NIL NIL NIL SOLOW (fetch CSX of S)
(IPLUS (fetch CSY of S)
(if (fetch FACEUP of S)
then (IPLUS CardHeight (fetch YO of S))
else 0))
CardWidth
(IMINUS (fetch YO of S))
(QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL SOLOW))
(BITBLT NIL NIL NIL SOLOW (fetch CSX of S)
(fetch CSY of S)
(if (fetch FACEUP of S)
then (fetch XO of S)
else CardWidth)
CardHeight
(QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL SOLOW])
(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) (* lmm " 6-Aug-85 00:04")
(MOVETO (CONSTANT (FIX (FTIMES 25 Overlap CardWidth)))
(CONSTANT (FIX (FTIMES CardHeight 1.25)))
SOLOW)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
18)
SOLOW)
(BITBLT NIL NIL NIL SOLOW (DSPXPOSITION NIL SOLOW)
(IDIFFERENCE (DSPYPOSITION NIL SOLOW)
(FONTPROP (DSPFONT NIL SOLOW)
(QUOTE DESCENT)))
200
(FONTPROP (DSPFONT NIL SOLOW)
(QUOTE HEIGHT))
(QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL SOLOW))
(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])
(SOLITAIRE
[LAMBDA (REPLAY) (* bas: " 6-AUG-82 11:24")
(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])
(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
(SOLO
[LAMBDA (SOLOW) (* lmm " 6-Aug-85 00:04")
(if (AND (BOUNDP (QUOTE SOLORESULTS))
(ARRAYP SOLORESULTS))
then (for I from 0 to TotalCards do (SETA SOLORESULTS I 0))
else (SETQ SOLORESULTS (ARRAY (ADD1 TotalCards)
(QUOTE FIXP)
0 0)))
(bind X
do (SETQ X (SOLITAIRE))
(DISMISS 1200)
(SETA SOLORESULTS X (ADD1 (ELT SOLORESULTS X)))
(HIST SOLORESULTS SOLOW "Number of cards up")
(DISMISS 1200])
(HIST
[LAMBDA (A DS L) (* lmm " 6-Aug-85 00:04")
(BITBLT NIL NIL NIL SOLOW 0 0 (WINDOWPROP DS (QUOTE WIDTH))
(WINDOWPROP DS (QUOTE HEIGHT))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(PROG [(HS (IQUOTIENT (IDIFFERENCE (WINDOWPROP DS (QUOTE WIDTH))
40)
(ARRAYSIZE A)))
(VS (IQUOTIENT (IDIFFERENCE (WINDOWPROP DS (QUOTE HEIGHT))
40)
(ARRAYMAX A]
(for I from (ARRAYORIG A) to (IPLUS (ARRAYSIZE A)
(ARRAYORIG A)
-1)
do (BITBLT NIL NIL NIL DS (IPLUS (ITIMES I HS)
20)
20 HS (ITIMES VS (ELT A I))
(QUOTE TEXTURE)
(QUOTE REPLACE)
23130)))
(BITBLT NIL NIL NIL DS 20 20 (IDIFFERENCE (WINDOWPROP DS (QUOTE WIDTH))
40)
2
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL DS 20 20 2 (IDIFFERENCE (WINDOWPROP DS (QUOTE HEIGHT))
40)
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
12)
DS)
(MOVETO (IDIFFERENCE (WINDOWPROP DS (QUOTE WIDTH))
(IPLUS (STRINGWIDTH L (DSPFONT NIL DS))
20))
8 DS)
(PRIN1 L DS])
(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: " 6-JAN-81 16:43")
(if (ZEROP (fetch RANK of C))
then "None"
else (PACK (LIST (SELECTQ (fetch SUIT of C)
(0 (QUOTE S))
(1 (QUOTE C))
(2 (QUOTE D))
(3 (QUOTE H))
(SHOULDNT))
(SELECTQ (fetch RANK of C)
(1 (QUOTE A))
(11 (QUOTE J))
(12 (QUOTE Q))
(13 (QUOTE K))
(fetch 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 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 3)
(RPAQQ Overlap .667)
(RPAQQ CardWidth 30)
(RPAQQ CardHeight 45)
(CONSTANTS (BACKSHADE 52275)
(BetweenStacks 3)
(Overlap .667)
(CardWidth 30)
(CardHeight 45))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS STACKS HAND 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@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")
(RPAQQ MaxCardMove 8)
(RPAQQ WaitBetweenMoves 10)
(RPAQQ DECK NIL)
(RPAQQ SOLITAIREWINDOW NIL)
(ADDTOVAR IDLE.FUNCTIONS ("Solitaire" (QUOTE SOLO)))
(PUTPROPS SOLITAIRE COPYRIGHT ("Xerox Corporation" 1982 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1546 15777 (CARDIMAGE 1556 . 2895) (COUNTCARDS 2897 . 3101) (CREATEHAND 3103 . 3523) (
CREATESTACK 3525 . 4085) (DEALDECK 4087 . 5256) (FLIPSTACK 5258 . 5478) (GETCARD 5480 . 5908) (
GOODMOVE? 5910 . 6228) (HTOS? 6230 . 6389) (MOVECARD 6391 . 7013) (DOMOVE 7015 . 8443) (MOVEHS 8445 .
8680) (MOVES 8682 . 8951) (MOVES1 8953 . 9194) (UPCARD 9196 . 10213) (MOVESSS 10215 . 10891) (NXTCARD
10893 . 11768) (PUSHCARD 11770 . 12324) (POSTVALUE 12326 . 13341) (SEARCHSTACKS 13343 . 13568) (
SHOWCARDSTACK 13570 . 14183) (SHUFFLEDECK 14185 . 14773) (SOLITAIRE 14775 . 15400) (STOS? 15402 .
15641) (TOPSUITSTACK 15643 . 15775)) (15778 18149 (SOLO 15788 . 16393) (HIST 16395 . 17831) (ARRAYMAX
17833 . 18147)) (18170 19385 (SHOWCONFIG 18180 . 18590) (PRINTCARDSTACK 18592 . 18914) (CARDNAME 18916
. 19383)))))
STOP