Installation
The program will run with PEQB64 v4.2 or higher. Unzip the file and extract the folder “PE Clock Patience” into your QB64 folder. From the IDE, load the program “PE Clock Patience.bas” and make sure that you have the Run Option “Save EXE in source folder” checked. 3D (_MAPTRIANGLE) animations are used when the cards move.
PE Clock Patience.zip (Size: 8.48 MB / Downloads: 6)
Playing the Game
The game plays just as the card patience game. I give here the Wikipedia description.
On running the program there is a welcome screen. Click on 'Deal' to start playing. The program deals out the 52 cards into the 13 piles as per Wiki description. When the dealing is finished, the top card of the Kings' pile is turned over and is ready to be picked up. Picking up and placing cards is done by single clicking.
To pick up a card, move the mouse to centre of the uppermost card on the required pile: a green circle will appear to indicate that this is the correct pile. When a card is picked up, it will move with the mouse (drag-and-drop is not implemented in this program). Move the picked-up card to the correct pile – a blue circle will appear – and single click to place that card. The card will move to the bottom of the pile, and then you are then ready to pick up the top card on that pile.
When a card is placed at the bottom of a pile it is face-up (as in the actual patience game). Because of the space available in the display of this program, you can only see the top of the card jutting out from those above it. You can tell a face-up card from a face-down card as the edges of the backs are blue. When the last face-down card is removed from a pile, you can see the uppermost face-up card.
Continue until the last King is placed in its pile. This is a game of zero skill and is a purely mechanical process. The chances of winning are 1 in 13.
When the game has finished, you can click on 'New Game' for another go. You can click on 'Exit' at any time to quit.
Video of Running Program (without cursor)
The program will run with PEQB64 v4.2 or higher. Unzip the file and extract the folder “PE Clock Patience” into your QB64 folder. From the IDE, load the program “PE Clock Patience.bas” and make sure that you have the Run Option “Save EXE in source folder” checked. 3D (_MAPTRIANGLE) animations are used when the cards move.
PE Clock Patience.zip (Size: 8.48 MB / Downloads: 6)
Playing the Game
The game plays just as the card patience game. I give here the Wikipedia description.
- One pack of cards (minus jokers) is used. The pack is shuffled and twelve piles of four cards each are laid out, face down, in a circle. The remaining four cards are placed, also face down, in a pile in the centre of the circle.
- The twelve positions around the circle represent the 12-hour clock and the pile in the middle represents the hands.
- Play starts by turning over the top card of the central pile. When a card is revealed, it is placed face up under the pile at the corresponding hour (i.e. Ace = 1 o'clock, 2 = 2 o'clock, etc. The Jack is 11 o'clock and the Queen is 12 o'clock) and the top card of the pile of that hour is turned over. If a King is revealed, it is placed face up under the central pile.
- Play continues in this fashion and the game is won if all the cards (including four Kings) are revealed.
On running the program there is a welcome screen. Click on 'Deal' to start playing. The program deals out the 52 cards into the 13 piles as per Wiki description. When the dealing is finished, the top card of the Kings' pile is turned over and is ready to be picked up. Picking up and placing cards is done by single clicking.
To pick up a card, move the mouse to centre of the uppermost card on the required pile: a green circle will appear to indicate that this is the correct pile. When a card is picked up, it will move with the mouse (drag-and-drop is not implemented in this program). Move the picked-up card to the correct pile – a blue circle will appear – and single click to place that card. The card will move to the bottom of the pile, and then you are then ready to pick up the top card on that pile.
When a card is placed at the bottom of a pile it is face-up (as in the actual patience game). Because of the space available in the display of this program, you can only see the top of the card jutting out from those above it. You can tell a face-up card from a face-down card as the edges of the backs are blue. When the last face-down card is removed from a pile, you can see the uppermost face-up card.
Continue until the last King is placed in its pile. This is a game of zero skill and is a purely mechanical process. The chances of winning are 1 in 13.
When the game has finished, you can click on 'New Game' for another go. You can click on 'Exit' at any time to quit.
Video of Running Program (without cursor)
Code: (Select All)
': Clock Patience by Magdha 19th November 25 [from QB64v2 (ex Qwerkey)]
': This program uses
': InForm-PE for QB64-PE - v1.5.8 based upon InForm by Fellippe Heitor
': Copyright (c) 2025 QB64 Phoenix Edition Team
': https://github.com/QB64-Phoenix-Edition/InForm-PE
'-----------------------------------------------------------
': Controls' IDs: ------------------------------------------------------------------
DIM SHARED ClockPatience AS LONG
DIM SHARED ExitBT AS LONG
DIM SHARED NewGameBT AS LONG
CONST Offset%% = 7, Hours! = -_PI / 6, ZOffset! = -398, XImage% = 182, YImage% = 252
CONST Halfwidth%% = 50, Halfheight%% = Halfwidth%% * YImage% / XImage%, Radius% = 320, Tucked%% = 7
DIM SHARED CardsImg&(51), Obverse&, BlueHighlight&, GreenHighlight&, GameOver&, GameWon&, XM%, YM%
DIM SHARED PickedUp%%, PickedHour%%, PickedCard%%, CanPutDown%%, Orient!, Orient0!, OldHour%%
DIM SHARED Anime1%%, Anime2%%, DoPickUp%%, TurnOver%%, GreenValid%%, BlueValid%%, Cards%%(51)
DIM SHARED DoPatience%%, Stock%%, IsComplete%%, GotOut%%, Positions!(4, 12, 1, 4), Phi!(12)
REDIM SHARED Clock%%(12, 4, 2)
': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.bi'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'PE Clock Patience.frm'
': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit
'Initialisation
$EXEICON:'.\clubs.ico'
DoPatience%% = False
Anime1%% = 31
Anime2%% = 43
'Set Data
FOR N%% = 0 TO 6
Phi!(N%%) = N%% * Hours!
NEXT N%%
FOR N%% = 7 TO 11
Phi!(N%%) = (N%% - 12) * Hours!
NEXT N%%
FOR S%% = 0 TO 4
Positions!(S%%, 0, 0, 4) = 0
Positions!(S%%, 0, 1, 4) = Radius% - Tucked%% * S%%
Positions!(S%%, 0, 0, 3) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
Positions!(S%%, 0, 1, 3) = Positions!(S%%, 0, 1, 4) - Halfheight%%
Positions!(S%%, 0, 0, 2) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
Positions!(S%%, 0, 1, 2) = Positions!(S%%, 0, 1, 4) - Halfheight%%
Positions!(S%%, 0, 0, 1) = Positions!(S%%, 0, 0, 4) + Halfwidth%%
Positions!(S%%, 0, 1, 1) = Positions!(S%%, 0, 1, 4) + Halfheight%%
Positions!(S%%, 0, 0, 0) = Positions!(S%%, 0, 0, 4) - Halfwidth%%
Positions!(S%%, 0, 1, 0) = Positions!(S%%, 0, 1, 4) + Halfheight%%
NEXT S%%
FOR S%% = 0 TO 4
FOR N%% = 1 TO 11
FOR M%% = 0 TO 4
CALL Angle((Positions!(S%%, 0, 0, M%%)), (Positions!(S%%, 0, 1, M%%)), Positions!(S%%, N%%, 0, M%%), Positions!(S%%, N%%, 1, M%%), (Phi!(N%%)))
NEXT M%%
NEXT N%%
NEXT S%%
FOR S%% = 0 TO 4
Positions!(S%%, 12, 0, 0) = Tucked%% * (3 - S%%) - Halfwidth%%
Positions!(S%%, 12, 1, 0) = Halfheight%%
Positions!(S%%, 12, 0, 1) = Positions!(S%%, 12, 0, 0) + 2 * Halfwidth%%
Positions!(S%%, 12, 1, 1) = Halfheight%%
Positions!(S%%, 12, 0, 2) = Tucked%% * (3 - S%%) - Halfwidth%%
Positions!(S%%, 12, 1, 2) = -Halfheight%%
Positions!(S%%, 12, 0, 3) = Positions!(S%%, 12, 0, 2) + 2 * Halfwidth%%
Positions!(S%%, 12, 1, 3) = -Halfheight%%
Positions!(S%%, 12, 0, 4) = Tucked%% * (3 - S%%)
Positions!(S%%, 12, 1, 4) = 0
NEXT S%%
'Images
PlayingCards& = _LOADIMAGE("pack of cards.png", 32)
Corner& = _NEWIMAGE(33, 33, 32)
_DEST Corner&
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
CIRCLE (16, 16), 16
PAINT (16, 16)
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
FOR N%% = 0 TO 51
R1%% = N%% \ 13
C1%% = N%% MOD 13
R2%% = R1%% \ 2
C2%% = R1%% MOD 2
R3%% = C1%% \ 5
C3%% = C1%% MOD 5
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
_DEST TempImg&
COLOR _RGB32(247, 247, 247), _RGBA32(100, 100, 100, 0)
_PUTIMAGE (0, 0), Corner&
_PUTIMAGE (0, YImage% - 33), Corner&
_PUTIMAGE (XImage% - 33, 0), Corner&
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
X1! = 7 + 203 * C3%% + 996 * C2%%
X2! = 167 + X1!
Y1! = 13 + 267 * R3%% + 786 * R2%%
Y2! = Y1! + 222
_PUTIMAGE (6, 14)-(XImage% - 7, YImage% - 15), PlayingCards&, , (7 + 203 * C3%% + 996 * C2%%, Y1!)-(X2!, Y2!)
IF N%% = 23 THEN
F& = _LOADFONT("cyberbit.ttf", 14)
_FONT F&
COLOR _RGB32(226, 226, 226)
Q1$ = "PVDQJDX"
FOR M%% = 1 TO 7
Q2$ = Q2$ + CHR$(ASC(MID$(Q1$, M%%, 1)) + 1)
NEXT M%%
_PRINTSTRING (XImage% - 110, YImage% - 20), Q2$
_FONT 16
_FREEFONT F&
END IF
CardsImg&(N%%) = HardwareImage&(TempImg&, True)
NEXT N%%
_FREEIMAGE Corner&
Corner& = _NEWIMAGE(33, 33, 32)
_DEST Corner&
COLOR _RGB32(200, 200, 247), _RGBA32(100, 100, 100, 0)
CIRCLE (16, 16), 16
PAINT (16, 16)
CIRCLE (16, 16), 16, _RGB32(204, 119, 34)
TempImg& = _NEWIMAGE(XImage%, YImage%, 32)
_DEST TempImg&
COLOR _RGB32(200, 200, 247)
_PUTIMAGE (0, 0), Corner&
_PUTIMAGE (0, YImage% - 33), Corner&
_PUTIMAGE (XImage% - 33, 0), Corner&
_PUTIMAGE (XImage% - 33, YImage% - 33), Corner&
LINE (16, 0)-(XImage% - 17, YImage% - 1), , BF
LINE (0, 16)-(XImage% - 1, YImage% - 17), , BF
LINE (16, 0)-(XImage% - 17, 0), _RGB32(204, 119, 34)
LINE (16, YImage% - 1)-(XImage% - 17, YImage% - 1), _RGB32(204, 119, 34)
LINE (0, 16)-(0, YImage% - 17), _RGB32(204, 119, 34)
LINE (XImage% - 1, 16)-(XImage% - 1, YImage% - 17), _RGB32(204, 119, 34)
C3%% = 4
C2%% = 0
R3%% = 2
R2%% = 0
X1! = 7 + 203 * C3%% + 996 * C2%%
X2! = 167 + X1!
Y1! = 13 + 267 * R3%% + 786 * R2%%
Y2! = Y1! + 222
_PUTIMAGE (14, 14)-(XImage% - 15, YImage% - 15), PlayingCards&, , (14 + 203 * C3%% + 996 * C2%%, Y1!)-(X2! - 4, Y2!)
Obverse& = HardwareImage&(TempImg&, True)
_FREEIMAGE Corner&
_FREEIMAGE PlayingCards&
TempImg& = _NEWIMAGE(81, 81, 32)
_DEST TempImg&
COLOR _RGB32(0, 0, 200)
CIRCLE (40, 40), 40
CIRCLE (40, 40), 39
CIRCLE (40, 40), 38
BlueHighlight& = HardwareImage&(TempImg&, True)
TempImg& = _NEWIMAGE(81, 81, 32)
_DEST TempImg&
COLOR _RGB32(0, 200, 0)
CIRCLE (40, 40), 40
CIRCLE (40, 40), 39
CIRCLE (40, 40), 38
GreenHighlight& = HardwareImage&(TempImg&, True)
TempImg& = _NEWIMAGE(340, 80, 32)
_DEST TempImg&
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
F& = _LOADFONT("cyberbit.ttf", 70)
_FONT F&
_PRINTSTRING (5, 5), "Game End"
_FONT 16
_FREEFONT F&
GameOver& = HardwareImage&(TempImg&, True)
TempImg& = _NEWIMAGE(356, 80, 32)
_DEST TempImg&
COLOR _RGB32(0, 80, 32), _RGBA32(100, 100, 100, 0)
F& = _LOADFONT("cyberbit.ttf", 70)
_FONT F&
_PRINTSTRING (5, 5), "Completed"
_FONT 16
_FREEFONT F&
GameWon& = HardwareImage&(TempImg&, True)
FOR N%% = 0 TO 51
Cards%%(N%%) = N%% + 1 'Cards%%() values adjusted to 1 - 13: then value 0 is empty
NEXT N%%
FOR N%% = 1 TO 4
CALL Shuffle(Cards%%())
NEXT N%%
END SUB
SUB __UI_OnLoad
_SCREENMOVE 50, 0
Caption(NewGameBT) = "Deal"
SetFocus NewGameBT
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
STATIC Count%, InitDone%%, Grandad&, XStart%, YStart%
IF NOT InitDone%% THEN
InitDone%% = True
XStart% = -120
YStart% = 0
Grandad& = _LOADIMAGE("Clock1.png", 33)
END IF
IF NOT DoPatience%% THEN
_PUTIMAGE (201, 10), Grandad&
ELSE
'This is where we play the game
IF GreenValid%% THEN
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), GreenHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
ELSEIF BlueValid%% THEN
_MAPTRIANGLE (0, 0)-(80, 0)-(0, 80), BlueHighlight& TO(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)
_MAPTRIANGLE (80, 80)-(0, 80)-(80, 0), BlueHighlight& TO(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + -40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) - 40, Positions!(4, PickedHour%%, 1, 4) - 40, ZOffset!)-(Positions!(4, PickedHour%%, 0, 4) + 40, Positions!(4, PickedHour%%, 1, 4) + 40, ZOffset!)
END IF
IF Anime1%% < 31 THEN
'Display turning-over
IF OldHour%% = 12 THEN
IF Anime1%% > 15 THEN
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
X0! = Positions!(4, OldHour%%, 0, 0)
Y0! = Positions!(4, OldHour%%, 1, 0)
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
X1! = Positions!(4, OldHour%%, 0, 0) + Xtent!
Y1! = Positions!(4, OldHour%%, 1, 0)
Z1! = 0
X2! = Positions!(4, OldHour%%, 0, 2)
Y2! = Positions!(4, OldHour%%, 1, 2)
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
X3! = Positions!(4, OldHour%%, 0, 2) + Xtent!
Y3! = Positions!(4, OldHour%%, 1, 2)
Z3! = 0
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
ELSE
Psi! = Anime1%% * _PI / (2 * 15)
X0! = Positions!(4, OldHour%%, 0, 0)
Y0! = Positions!(4, OldHour%%, 1, 0)
Z0! = 0
X1! = X0! + 2 * Halfwidth%% * COS(Psi!)
Y1! = Y0!
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
X2! = Positions!(4, OldHour%%, 0, 2)
Y2! = Positions!(4, OldHour%%, 1, 2)
Z2! = 0
X3! = X2! + 2 * Halfwidth%% * COS(Psi!)
Y3! = Y2!
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
END IF
ELSE
IF Anime1%% > 15 THEN
Xtent! = 2 * Halfwidth%% * (Anime1%% - 15) / 15
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0)
Z0! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
XB! = Positions!(4, 0, 0, 0) + Xtent!
YB! = Positions!(4, 0, 1, 0)
Z1! = 0
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2)
Z2! = 0.7 * SQR((4 * Halfwidth%% * Halfwidth%%) - (Xtent! * Xtent!))
XD! = Positions!(4, 0, 0, 2) + Xtent!
YD! = Positions!(4, 0, 1, 2)
Z3! = 0
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
ELSE
Psi! = Anime1%% * _PI / (2 * 15)
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0)
Z0! = 0
XB! = XA! + 2 * Halfwidth%% * COS(Psi!)
YB! = YA!
Z1! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2)
Z2! = 0
XD! = XC! + 2 * Halfwidth%% * COS(Psi!)
YD! = YC!
Z3! = 0.7 * 2 * Halfwidth%% * SIN(Psi!)
CALL Angle((XA!), (YA!), X0!, Y0!, Orient0!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient0!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient0!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient0!)
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Z0! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Z3! + ZOffset!)-(X2!, Y2!, Z2! + ZOffset!)-(X1!, Y1!, Z1! + ZOffset!)
END IF
END IF
Anime1%% = Anime1%% + 1
IF Anime1%% = 31 THEN
TurnOver%% = False
Clock%%(PickedHour%%, 4, 0) = PickedCard%%
Clock%%(PickedHour%%, 4, 1) = True 'Temporary until picked up
END IF
ELSEIF Anime2%% < 43 THEN
'Display Tucking-in
IF PickedHour%% = 12 THEN
'Horizontal for Kings
IF Anime2%% > 22 THEN
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * (45 - Anime2%%) / 23
Y0! = Positions!(4, PickedHour%%, 1, 0)
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * (45 - Anime2%%) / 23
Y1! = Positions!(4, PickedHour%%, 1, 1)
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * (45 - Anime2%%) / 23
Y2! = Positions!(4, PickedHour%%, 1, 2)
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * (45 - Anime2%%) / 23
Y3! = Positions!(4, PickedHour%%, 1, 3)
Zpos! = -0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
ELSE
Xdelta% = Positions!(1, PickedHour%%, 0, 1) - Positions!(4, PickedHour%%, 0, 0) + Tucked%%
X0! = Positions!(4, PickedHour%%, 0, 0) + Xdelta% * Anime2%% / 22
Y0! = Positions!(4, PickedHour%%, 1, 0)
X1! = Positions!(4, PickedHour%%, 0, 1) + Xdelta% * Anime2%% / 22
Y1! = Positions!(4, PickedHour%%, 1, 1)
X2! = Positions!(4, PickedHour%%, 0, 2) + Xdelta% * Anime2%% / 22
Y2! = Positions!(4, PickedHour%%, 1, 2)
X3! = Positions!(4, PickedHour%%, 0, 3) + Xdelta% * Anime2%% / 22
Y3! = Positions!(4, PickedHour%%, 1, 3)
Zpos! = 0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
END IF
ELSE
'Vertical for others
IF Anime2%% > 22 THEN
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0) + Ydelta% * (45 - Anime2%%) / 23
XB! = Positions!(4, 0, 0, 1)
YB! = Positions!(4, 0, 1, 1) + Ydelta% * (45 - Anime2%%) / 23
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2) + Ydelta% * (45 - Anime2%%) / 23
XD! = Positions!(4, 0, 0, 3)
YD! = Positions!(4, 0, 1, 3) + Ydelta% * (45 - Anime2%%) / 23
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
Zpos! = -0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
ELSE
Ydelta% = Positions!(0, 0, 1, 0) - Positions!(4, 0, 1, 2) + Tucked%%
XA! = Positions!(4, 0, 0, 0)
YA! = Positions!(4, 0, 1, 0) + Ydelta% * Anime2%% / 22
XB! = Positions!(4, 0, 0, 1)
YB! = Positions!(4, 0, 1, 1) + Ydelta% * Anime2%% / 22
XC! = Positions!(4, 0, 0, 2)
YC! = Positions!(4, 0, 1, 2) + Ydelta% * Anime2%% / 22
XD! = Positions!(4, 0, 0, 3)
YD! = Positions!(4, 0, 1, 3) + Ydelta% * Anime2%% / 22
CALL Angle((XA!), (YA!), X0!, Y0!, Orient!)
CALL Angle((XB!), (YB!), X1!, Y1!, Orient!)
CALL Angle((XC!), (YC!), X2!, Y2!, Orient!)
CALL Angle((XD!), (YD!), X3!, Y3!, Orient!)
Zpos! = 0.5
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
END IF
END IF
Anime2%% = Anime2%% + 1
IF Anime2%% = 43 THEN CanPutDown%% = True
ELSEIF PickedUp%% THEN
'Display picked-up card
IF __UI_MouseLeft > 680 AND __UI_MouseTop > 738 THEN
'Do Nothing
ELSE
CALL Angle(-Halfwidth%%, Halfheight%, X0!, Y0!, Orient!)
CALL Angle(Halfwidth%%, Halfheight%, X1!, Y1!, Orient!)
CALL Angle(-Halfwidth%%, -Halfheight%, X2!, Y2!, Orient!)
CALL Angle(Halfwidth%%, -Halfheight%, X3!, Y3!, Orient!)
X0! = X0! + XM%
Y0! = Y0! + YM%
X1! = X1! + XM%
Y1! = Y1! + YM%
X2! = X2! + XM%
Y2! = Y2! + YM%
X3! = X3! + XM%
Y3! = Y3! + YM%
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(PickedCard%% - 1) TO(X0!, Y0!, ZOffset!)-(X1!, Y1!, ZOffset!)-(X2!, Y2!, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(PickedCard%% - 1) TO(X3!, Y3!, ZOffset!)-(X2!, Y2!, ZOffset!)-(X1!, Y1!, ZOffset!)
END IF
END IF
'Display Piles
FOR S%% = 4 TO 0 STEP -1 'Maptriangle order is backwards
FOR N%% = 0 TO 12
IF Clock%%(N%%, S%%, 0) <> 0 THEN
IF Clock%%(N%%, S%%, 1) THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), CardsImg&(Clock%%(N%%, S%%, 0) - 1) TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
ELSE
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(Positions!(S%%, N%%, 0, 0), Positions!(S%%, N%%, 1, 0), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(Positions!(S%%, N%%, 0, 3), Positions!(S%%, N%%, 1, 3), ZOffset!)-(Positions!(S%%, N%%, 0, 2), Positions!(S%%, N%%, 1, 2), ZOffset!)-(Positions!(S%%, N%%, 0, 1), Positions!(S%%, N%%, 1, 1), ZOffset!)
END IF
END IF
NEXT N%%
NEXT S%%
IF Stock%% > 0 THEN
'Display Stock
IF Stock%% > 1 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%%, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%%, ZOffset!)
END IF
IF Stock%% > 10 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 1, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 1, ZOffset!)
END IF
IF Stock%% > 20 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 2, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 2, ZOffset!)
END IF
IF Stock%% > 30 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 3, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 3, ZOffset!)
END IF
IF Stock%% > 41 THEN
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(XStart% - Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(XStart% + Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% - Halfwidth%%, YStart% - Halfheight%% - 4, ZOffset!)-(XStart% + Halfwidth%%, YStart% + Halfheight%% - 4, ZOffset!)
END IF
'Display dealt card
S%% = (52 - Stock%%) \ 13
N%% = (52 - Stock%%) MOD 13
Count% = Count% + 1
Zpos! = 50 * SIN(_PI * Count% / 15)
ActualAngle! = Phi!(N%%) * Count% / 15
XPos! = XStart% + (Positions!(S%%, N%%, 0, 4) - XStart%) * Count% / 15
YPos! = YStart% + (Positions!(S%%, N%%, 1, 4) - YStart%) * Count% / 15
CALL Angle((-Halfwidth%%), (Halfheight%%), X0!, Y0!, (ActualAngle!))
CALL Angle((Halfwidth%%), (Halfheight%%), X1!, Y1!, (ActualAngle!))
CALL Angle((-Halfwidth%%), (-Halfheight%%), X2!, Y2!, (ActualAngle!))
CALL Angle((Halfwidth%%), (-Halfheight%%), X3!, Y3!, (ActualAngle!))
X0! = XPos! + X0!
Y0! = YPos! + Y0!
X1! = XPos! + X1!
Y1! = YPos! + Y1!
X2! = XPos! + X2!
Y2! = YPos! + Y2!
X3! = XPos! + X3!
Y3! = YPos! + Y3!
_MAPTRIANGLE (0, 0)-(XImage% - 1, 0)-(0, YImage% - 1), Obverse& TO(X0!, Y0!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)
_MAPTRIANGLE (XImage% - 1, YImage% - 1)-(0, YImage% - 1)-(XImage% - 1, 0), Obverse& TO(X3!, Y3!, Zpos! + ZOffset!)-(X2!, Y2!, Zpos! + ZOffset!)-(X1!, Y1!, Zpos! + ZOffset!)
IF Count% = 15 THEN
Count% = 0
Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 0) = Clock%%((52 - Stock%%) MOD 13, 1 + ((52 - Stock%%) \ 13), 2)
Stock%% = Stock%% - 1
END IF
END IF
IF IsComplete%% THEN
_PUTIMAGE (230, 246), GameOver&
IF GotOut%% THEN _PUTIMAGE (222, 490), GameWon&
END IF
END IF
END SUB
SUB __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE ClockPatience
IF GreenValid%% THEN
DoPickUp%% = True
ELSEIF BlueValid%% THEN
Anime2%% = 0
END IF
CASE ExitBT
SYSTEM
CASE NewGameBT
IF NOT DoPatience%% THEN
Control(NewGameBT).Disabled = True
Control(NewGameBT).Hidden = True
Caption(NewGameBT) = "New Game"
SetFocus ExitBT
CALL Patience
ELSE
DoPatience%% = False
Caption(NewGameBT) = "Deal"
END IF
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
END SUB
SUB __UI_FocusOut (id AS LONG)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
END SUB
SUB __UI_MouseDown (id AS LONG)
END SUB
SUB __UI_MouseUp (id AS LONG)
END SUB
SUB __UI_KeyPress (id AS LONG)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
END SUB
SUB __UI_TextChanged (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB __UI_FormResized
END SUB
FUNCTION HardwareImage& (ImageName&, Scrap%%)
HardwareImage& = _COPYIMAGE(ImageName&, 33)
IF Scrap%% THEN _FREEIMAGE ImageName&
END FUNCTION
SUB Angle (Xin!, Yin!, Xout!, Yout!, Theta!)
Xout! = Xin! * COS(Theta!) - Yin! * SIN(Theta!)
Yout! = Xin! * SIN(Theta!) + Yin! * COS(Theta!)
END SUB
SUB Patience
RANDOMIZE (TIMER)
BadDeal%% = True
WHILE BadDeal%%
REDIM Clock%%(12, 4, 2)
CALL Shuffle(Cards%%())
'Deal Sim
FOR N%% = 0 TO 51
S%% = N%% \ 13
R%% = N%% MOD 13
Clock%%(R%%, S%% + 1, 2) = Cards%%(N%%)
NEXT N%%
BadDeal%% = False
FOR M%% = 0 TO 12 'Cards are in S 1 to 4
IF Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 2, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 3, 2) MOD 13 AND Clock%%(M%%, 1, 2) MOD 13 = Clock%%(M%%, 4, 2) MOD 13 THEN BadDeal%% = True
NEXT M%%
WEND
Stock%% = 52
Anime1%% = 31
Anime2%% = 43
TurnOver%% = True
DoPickUp%% = False
PickedUp%% = False
PickedCard%% = 0
PickedHour%% = 12
CanPutDown%% = False
IsComplete%% = False
DoPatience%% = True
HangOn%% = True
HangStop%% = 50
HCount%% = 0
WHILE DoPatience%%
_LIMIT 60
GreenValid%% = False
BlueValid%% = False
IF Stock%% = 0 AND HangOn%% THEN
HCount%% = HCount%% + 1
IF HCount%% = HangStop%% THEN
HangOn%% = False
HCount%% = 0
HangStop%% = 20
END IF
END IF
IF Stock%% = 0 AND NOT IsComplete%% AND Anime1%% = 31 AND Anime2%% = 43 AND NOT HangOn%% THEN
'In _MAPTRIANGLE3D, all distances relative to centre of screen
XM% = __UI_MouseLeft - _WIDTH / 2
YM% = _HEIGHT / 2 - __UI_MouseTop
IF TurnOver%% THEN
Orient0! = Phi!(PickedHour%%) 'Start orientation is from where the card is taken
PickedCard%% = Clock%%(PickedHour%%, 4, 0) 'From 1 to 52
Clock%%(PickedHour%%, 4, 0) = 0
OldHour%% = PickedHour%%
Anime1%% = 0
ELSEIF NOT DoPickUp%% AND NOT PickedUp%% THEN
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN GreenValid%% = True
ELSEIF DoPickUp%% THEN
IF PickedHour%% = 12 THEN
FOR R%% = 4 TO 2 STEP -1
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
NEXT R%%
Clock%%(PickedHour%%, 1, 0) = 0
ELSE
FOR R%% = 4 TO 1 STEP -1
Clock%%(PickedHour%%, R%%, 0) = Clock%%(PickedHour%%, R%% - 1, 0)
Clock%%(PickedHour%%, R%%, 1) = Clock%%(PickedHour%%, R%% - 1, 1)
NEXT R%%
Clock%%(PickedHour%%, 0, 0) = 0
END IF
PickedHour%% = PickedCard%% MOD 13
IF PickedHour%% = 0 THEN
PickedHour%% = 12
ELSEIF PickedHour%% = 12 THEN
PickedHour%% = 0
END IF
Orient1! = Phi!(PickedHour%%)
PickedUp%% = True
DoPickUp%% = False
ELSEIF PickedUp%% THEN
IF SQR((Positions!(4, PickedHour%%, 0, 4) - XM%) * (Positions!(4, PickedHour%%, 0, 4) - XM%) + (Positions!(4, PickedHour%%, 1, 4) - YM%) * (Positions!(4, PickedHour%%, 1, 4) - YM%)) < 40 THEN
IF NOT CanPutDown%% THEN BlueValid%% = True
Orient! = Orient1!
ELSEIF SQR((Positions!(4, OldHour%%, 0, 4) - XM%) * (Positions!(4, OldHour%%, 0, 4) - XM%) + (Positions!(4, OldHour%%, 1, 4) - YM%) * (Positions!(4, OldHour%%, 1, 4) - YM%)) < 40 THEN
Orient! = Orient0!
ELSE
Orient! = 0
END IF
IF CanPutDown%% THEN
CanPutDown%% = False
PickedUp%% = False
HangOn%% = True
IF PickedHour%% = 12 THEN
Clock%%(PickedHour%%, 1, 0) = PickedCard%%
Clock%%(PickedHour%%, 1, 1) = True
ELSE
Clock%%(PickedHour%%, 0, 0) = PickedCard%%
Clock%%(PickedHour%%, 0, 1) = True
END IF
PickedCard%% = 0
IF Clock%%(12, 4, 1) AND Clock%%(12, 1, 0) <> 0 THEN 'Game Finished
IsComplete%% = True
Control(NewGameBT).Disabled = False
Control(NewGameBT).Hidden = False
SetFocus NewGameBT
GotOut%% = True
M%% = 0
WHILE M%% <= 11 AND GotOut%%
IF NOT Clock%%(M%%, 4, 1) THEN GotOut%% = False
M%% = M%% + 1
WEND
END IF
IF NOT IsComplete%% THEN TurnOver%% = True
END IF
END IF
END IF
__UI_DoEvents
WEND
END SUB
SUB Shuffle (Pack%%()) 'Fisher Yates or Knuth shuffle
FOR S%% = 51 TO 1 STEP -1
R%% = INT(RND * S%%) '+ 1
SWAP Pack%%(R%%), Pack%%(S%%)
NEXT S%%
END SUB
'$INCLUDE:'InForm\InForm.ui'