HP Prime for All
English
Русский
Name | Solitaire - Baker's Game |
Description | Solitaire game. Build up suits top left to win. Touch a card to pick it, then tap a destination to move it. Cards can only be moved onto the same suit and in sequence. |
Author | Mark Power |
Source code formatted by website engine
BEGIN
TEXTOUT_P(s+" ", G0, 15, 210, 3, white, 300, board);
WAIT(0.5);
WAIT(0);
END;
WaitForRelease()
BEGIN
REPEAT
UNTIL STRING(MOUSE) = "{{}, {}}";
END;
WaitForTap()
BEGIN
// Wait for touch
REPEAT
UNTIL STRING(MOUSE) ≠ "{{}, {}}";
WaitForRelease();
END;
DisplayHelp()
BEGIN
LOCAL t, I, m;
{"Baker's Game by Mark Power v1.27",
"",
"Build up suits top left to win. Touch a card to",
"pick it, then tap a destination to move it.",
"Double tap to move a card to its suit on a",
"destination pile. Cards can only be moved",
"onto the same suit and in sequence.",
"",
"Press A for Auto, U for Undo, Esc to exit, ",
"Menu for more options, and Help for this",
"screen.",
"",
"Touch the screen to continue."}▶t;
RECT_P(G0, 10, 10, 310, 230, black, white);
FOR I FROM 1 TO SIZE(t) DO
TEXTOUT_P(t(I), G0, 15, I*15+5, 3, black);
END;
WaitForTap();
END;
GetCardColour(c)
BEGIN
LOCAL colour;
IF (c < 14) OR (c > 39) THEN
black▶colour;
ELSE
red▶colour;
END;
RETURN colour;
END;
GetCardName(c)
BEGIN
LOCAL names;
{"A", "2", "3", "4", "5", "6", "7", "8", "9", "10", "J", "Q", "K"}▶names;
RETURN names(((c-1) MOD 13) + 1);
END;
GetCardSuit(c)
BEGIN
LOCAL suit, suits;
{"♣", "♦", "♥", "♠"}▶suits;
IP((c-1) / 13) + 1▶suit;
RETURN suits(suit);
END;
DrawCard(c, x, y)
BEGIN
DIMGROB_P(G1, 38, 20);
RECT_P(G1, 0, 0, 37, 19, black, white);
TEXTOUT_P(GetCardName(c), G1, 3, 2, 2, GetCardColour(c));
TEXTOUT_P(GetCardSuit(c), G1, 25, 2, 2, GetCardColour(c));
BLIT_P(G2, x, y, G1, 0, 0, 38, 20);
END;
DrawHolder(c, x, y)
BEGIN
DIMGROB_P(G1, 38, 20);
RECT_P(G1, 0, 0, 37, 19, black, RGB(204, 102, 51));
TEXTOUT_P(c, G1, 16, 4, 2, black);
BLIT_P(G2, x, y, G1, 0, 0, 38, 20);
END;
DrawPart(column, n)
BEGIN
LOCAL c, s;
IF SIZE(column) > 10 THEN
12▶s;
ELSE
20▶s;
END;
IF SIZE(column) THEN
FOR c FROM 1 TO SIZE(column) DO
DrawCard(column(c), (n-1) * 40+1, (c-1) * s+31);
END;
END;
END;
DrawMiddle(columns)
BEGIN
LOCAL c;
FOR c FROM 1 TO 8 DO
DrawPart(columns(c), c);
END;
END;
NewDeckN(top)
BEGIN
RETURN MAKELIST(I, I, 1, top, 1);
END;
NewDeck()
BEGIN
RETURN NewDeckN(52);
END;
Shuffle()
BEGIN
LOCAL c, l1, l2, l3, n;
NewDeck()▶l1;
FOR c FROM 1 TO 52 DO
RANDINT(1, SIZE(l1) - 2)▶n;
SUB(l1, n+2, SIZE(l1))▶l2;
SUB(l1, 1, n)▶l3;
CONCAT(l2, l1(n+1), l3)▶l1;
END;
RETURN l1;
END;
WaitForTouch()
BEGIN
LOCAL m, ml, mx, my, k;
LOCAL ms := 0;
LOCAL kd := 0;
REPEAT
MOUSE▶m;
GETKEY▶k;
CASE
IF k = 13 THEN
DRAWMENU({"Deal", "Again", "Help", "Time", "Auto", "Undo"});
1▶ms;
END;
IF k = 3 THEN kd := 22; END;
IF k = 4 THEN kd := 26; END;
IF k = 14 THEN kd := 24; END;
IF k = 37 THEN kd := 25; END;
END;
UNTIL (STRING(m) ≠ "{{}, {}}") OR (kd);
IF kd = 0 THEN
m(1)▶ml;
ml(1)▶mx;
ml(2)▶my;
IF my < 30 THEN
FLOOR(mx/320*8) + 10▶kd;
ELSE
IF (ms) AND (my > 220) THEN
FLOOR(mx/320*6) + 20▶kd;
ELSE
FLOOR(mx/320*8) + 1▶kd;
END;
END;
WaitForRelease();
END;
RETURN (kd);
END;
DrawScreen()
BEGIN
RECT(G2, board);
FOR I FROM 0 TO 3 DO
IF finals(I+1) > 0 THEN
DrawCard(finals(I+1), I*40+1, 1);
ELSE
DrawHolder("A", I*40+1, 1);
END;
END;
FOR I FROM 4 TO 7 DO
IF reserves(I-3) > 0 THEN
DrawCard(reserves(I-3), I*40+1, 1);
ELSE
DrawHolder("R", I*40+1, 1);
END;
END;
DrawMiddle(columns);
END;
Highlight(thisKey)
BEGIN
LOCAL x, y, column, lastCard, depth, s;
IF thisKey < 9 THEN
// Highlight in main deck
SIZE(columns(thisKey))▶depth;
IF depth THEN
IF depth > 10 THEN
12▶s;
ELSE
20▶s;
END;
(thisKey-1) * 40+1▶x;
columns(thisKey)▶column;
column(depth)▶lastCard;
(depth-1) * s+31▶y;
INVERT_P(G0, x, y, x+37, y+19);
END;
ELSE
// Highlight in top row
IF reserves(thisKey-13) THEN
(thisKey-10) * 40+1▶x;
INVERT_P(G0, x, 1, x+37, 20);
END;
END;
END;
GetLastCard(p)
BEGIN
LOCAL column, value;
0▶value;
CASE
IF p < 10 THEN
columns(p)▶column;
IF SIZE(column) THEN
column(SIZE(column))▶value;
END;
END;
IF p < 14 THEN
finals(p-9)▶value;
END;
DEFAULT
reserves(p-13)▶value;
END;
RETURN(value);
END;
RemoveLastCard(p)
BEGIN
LOCAL column, c1;
CASE
IF p < 10 THEN
columns(p)▶column;
IF SIZE(column) > 1 THEN
SUB(column, 1, SIZE(column) - 1)▶c1;
c1▶columns(p);
ELSE
{}▶columns(p);
END;
END;
IF p < 14 THEN
0▶finals(p-9);
END;
DEFAULT
0▶reserves(p-13);
END;
END;
PlaceLastCard(p, value)
BEGIN
LOCAL column;
CASE
IF p < 10 THEN
CONCAT(columns(p), value)▶column;
column▶columns(p);
END;
IF p < 14 THEN
value▶finals(p-9);
END;
DEFAULT
value▶reserves(p-13);
END;
END;
Move(fromPos, toPos)
BEGIN
LOCAL fromValue, toValue, doMove;
0▶doMove;
GetLastCard(fromPos)▶fromValue;
GetLastCard(toPos)▶toValue;
CASE
IF (toPos > 13) AND (toValue = 0) THEN 1▶doMove END;
IF (toPos < 9) AND (toValue = 0) THEN 1▶doMove END;
IF (toPos < 9) AND (toValue = fromValue+1) AND (GetCardSuit(toValue) = GetCardSuit(fromValue)) THEN 1▶doMove END;
IF (toPos > 9) AND (toPos < 14) AND (toValue = 0) AND (GetCardName(fromValue) = "A") THEN 1▶doMove END;
IF (toPos > 9) AND (toPos < 14) AND (toValue+1 = fromValue) AND (GetCardSuit(toValue) = GetCardSuit(fromValue)) THEN 1▶doMove END;
END;
IF (doMove) THEN
// Save Undo
CONCAT({{columns, finals, reserves}}, undo)▶undo;
IF SIZE(undo) > 10 THEN
SUB(undo, 1, 10)▶undo;
END;
// Undo
RemoveLastCard(fromPos);
PlaceLastCard(toPos, fromValue);
END;
END;
Auto(n)
BEGIN
LOCAL fv, fs, I, doMove := 0;
GetLastCard(n)▶fv;
GetCardSuit(fv)▶fs;
FOR I FROM 1 TO 4 DO
IF ((finals(I) + 1) = fv) AND (GetCardSuit(finals(I)) = fs) THEN
doMove := I+9;
BREAK;
END;
END;
IF doMove = 0 THEN
FOR I FROM 1 TO 4 DO
IF (finals(I) = 0) THEN
doMove := I+9;
BREAK;
END;
END;
END;
IF doMove THEN
Move(n, doMove);
END;
END;
AutoAll()
BEGIN
LOCAL N, fi;
REPEAT
finals▶fi;
FOR N FROM 1 TO 8 DO
Auto(N);
END;
FOR N FROM 14 TO 17 DO
Auto(N);
END;
DrawScreen();
BLIT_P(G0, G2);
UNTIL (ΣLIST(fi) = ΣLIST(finals));
END;
QuitGame()
BEGIN
LOCAL q, m, ml;
DRAWMENU({"Cancel", "", "", "", "", "Quit"});
REPEAT
MOUSE▶m;
UNTIL STRING(m) ≠ "{{}, {}}";
m(1)▶ml;
IF (ml(2) > 220) AND (ml(1) > 267) THEN
1▶q;
ELSE
0▶q;
END;
WaitForRelease();
RETURN(q);
END;
DisplayStats(t)
BEGIN
LOCAL s;
"Time so far "+STRING(Time-t) + "s"▶s;
RECT_P(G0, 10, 80, 310, 160, RGB(0, 0, 0), RGB(255, 255, 255));
TEXTOUT_P(s, G0, 15, 95, 3, RGB(0, 0, 0));
TEXTOUT_P("Touch the screen to continue", G0, 15, 135, 3, RGB(0, 0, 0));
WaitForTap();
END;
Congrats(t)
BEGIN
LOCAL s;
"Congratulations! Solved in "+STRING(Time-t) + "s"▶s;
RECT_P(G0, 10, 80, 310, 160, RGB(0, 0, 0), RGB(255, 255, 255));
TEXTOUT_P(s, G0, 15, 95, 3, RGB(0, 0, 0));
TEXTOUT_P("Touch the screen to finish", G0, 15, 135, 3, RGB(0, 0, 0));
WaitForTap();
END;
EXPORT SOL_BG()
BEGIN
DIMGROB_P(G2, 320, 240);
LOCAL lastTime;
LOCAL thisKey;
LOCAL thisTime;
LOCAL exit;
LOCAL again;
LOCAL newDeal;
LOCAL highlight;
LOCAL u2;
LOCAL u3;
IF running THEN
DrawScreen();
BLIT_P(G0, G2);
ELSE
1▶newDeal;
1▶running;
END;
REPEAT
IF newDeal OR again THEN
{}▶undo;
{{}, {}, {}, {}, {}, {}, {}, {}}▶columns;
{0, 0, 0, 0}▶finals;
{0, 0, 0, 0}▶reserves;
IF newDeal THEN
Shuffle()▶deck;
// For debugging use
// REVERSE(NewDeck())▶deck;
END;
SUB(deck, 1, 7)▶columns(1);
SUB(deck, 8, 14)▶columns(2);
SUB(deck, 15, 21)▶columns(3);
SUB(deck, 22, 28)▶columns(4);
SUB(deck, 29, 34)▶columns(5);
SUB(deck, 35, 40)▶columns(6);
SUB(deck, 41, 46)▶columns(7);
SUB(deck, 47, 52)▶columns(8);
DrawScreen();
BLIT_P(G0, G2);
0▶newDeal;
0▶again;
0▶thisKey;
0▶thisTime;
0▶exit;
0▶highlight;
Time▶startTime;
END;
thisTime▶lastTime;
WaitForTouch()▶thisKey;
TICKS▶thisTime;
CASE
IF thisKey = 26 THEN
QuitGame()▶exit;
BLIT_P(G0, G2);
0▶highlight;
END;
IF thisKey = 20 THEN
1▶newDeal;
END;
IF thisKey = 21 THEN
1▶again;
END;
IF thisKey = 22 THEN
DisplayHelp();
BLIT_P(G0, G2);
0▶highlight;
END;
IF thisKey = 23 THEN
DisplayStats(startTime);
BLIT_P(G0, G2);
0▶highlight;
END;
IF thisKey = 24 THEN
AutoAll();
DrawScreen();
BLIT_P(G0, G2);
0▶highlight;
END;
IF thisKey = 25 THEN
IF SIZE(undo) THEN
undo(1)▶u3;
u3(1)▶columns;
u3(2)▶finals;
u3(3)▶reserves;
tail(undo)▶u2;
u2▶undo;
{}▶u2;
{}▶u3;
DrawScreen();
END;
BLIT_P(G0, G2);
0▶highlight;
END;
IF (highlight = 0) AND (thisKey < 9) THEN
IF (SIZE(columns(thisKey))) THEN
Highlight(thisKey);
thisKey▶highlight;
END;
END;
IF (highlight = 0) AND (thisKey > 13) AND (thisKey < 18) THEN
IF (reserves(thisKey-13)) THEN
Highlight(thisKey);
thisKey▶highlight;
END;
END;
IF (highlight) AND (highlight = thisKey) AND ((thisTime-lastTime) > 600) THEN
BLIT_P(G0, G2);
0▶highlight;
END;
IF (highlight) AND (highlight = thisKey) THEN
Auto(thisKey);
DrawScreen();
BLIT_P(G0, G2);
0▶highlight;
END;
IF (highlight) THEN
Move(highlight, thisKey);
DrawScreen();
BLIT_P(G0, G2);
0▶highlight;
END;
END;
// Check for completion
IF ΣLIST(finals) = 130 THEN
Congrats(startTime);
1▶exit;
0▶running;
END;
UNTIL exit;
END;