Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SMcNeill on November 03, 2019, 03:17:28 am

Title: Flip It
Post by: SMcNeill on November 03, 2019, 03:17:28 am
A simple little solitaire style card game which I was playing around with: Flip It

Code: [Select]
$COLOR:32
DEFLNG A-Z
RANDOMIZE TIMER
SCREEN _NEWIMAGE(1024, 720, 32) '720p screen
_TITLE "Flip It"
DIM SHARED CardImage AS LONG: CardImage = _LOADIMAGE("Cards.bmp", 32)
DIM SHARED CardWide, CardHigh: CardWide = 72: CardHigh = 96
DIM SHARED Deck(51) AS INTEGER 'an array to hold the cards
REDIM SHARED Visible(0) AS INTEGER 'an array to see if the cards are visible or hidden
DIM SHARED OldEnglish, NumOfCards
OldEnglish = _LOADFONT("OLDENGL.TTF", 32)
_PRINTMODE _KEEPBACKGROUND

DO
    NumOfCards = ChooseDifficulty
    Shuffle
    DisplayCards

    SLEEP
LOOP

SUB DisplayCards
    CLS
    _FONT 16
    xstep = _WIDTH / NumOfCards
    scale = xstep / CardWide
    ystart = _HEIGHT / 2 - CardHigh * scale / 2

    FOR i = 0 TO NumOfCards - 1
        IF Visible(i) THEN
            suit = Deck(i) \ 13: value = Deck(i) MOD 13
            _PUTIMAGE (xstep * i, ystart)-STEP(xstep, CardHigh * scale), CardImage, 0, (value * CardWide, suit * CardHigh)-STEP(CardWide, CardHigh)
        ELSE
            LINE (xstep * i, ystart)-STEP(xstep, CardHigh * scale), White, BF
            LINE (xstep * i + 2, ystart + 2)-STEP(xstep - 4, CardHigh * scale - 4), Blue, BF
        END IF
    NEXT
END SUB



FUNCTION ChooseDifficulty
    CLS
    _FONT OldEnglish
    COLOR White
    CenterText 0, 200, _WIDTH, 300, "Choose Difficulty"
    COLOR Black

    FOR i = 0 TO 9
        x = 5 + 102 * i
        y = 300
        LINE (x, y)-STEP(100, 100), Yellow, BF
        CenterText x, y, x + 100, y + 100, _TRIM$(STR$(i + 6))
    NEXT

    oldmouse = -1 'cycle one to make certain mouse is up before we count a down event
    DO
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF oldmouse = 0 AND mb THEN
            IF _MOUSEY >= 300 AND _MOUSEY <= 400 THEN 'we're in the right rows for a valid mouse clice
                choice = (_MOUSEX - 5) \ 102
                IF choice >= 0 AND choice <= 9 THEN finished = -1
            END IF
        END IF
        oldmouse = mb
        _LIMIT 30
    LOOP UNTIL finished
    COLOR White
    ChooseDifficulty = choice + 6
END FUNCTION

SUB CenterText (x1, y1, x2, y2, text$)
    pw = _PRINTWIDTH(text$)
    px = x1 + (x2 - x1) / 2 - pw / 2
    py = y1 + (y2 - y1) / 2 - _FONTHEIGHT / 2
    _PRINTSTRING (px, py), text$
END SUB

SUB Shuffle
    STATIC InitDeck
    IF NOT InitDeck THEN
        InitDeck = -1
        FOR i = 0 TO 51: Deck(i) = i: NEXT 'put the cards in the deck
    END IF
    FOR i = 0 TO 51
        SWAP Deck(i), Deck(INT(RND * 52)) 'shuffle the deck
    NEXT
    REDIM Visible(NumOfCards) AS INTEGER
    FOR i = 0 TO NumOfCards - 1
        Visible(i) = INT(RND * 2)
    NEXT
END SUB
All we do at this point is get some cards and display them on the screen, but I thought I'd go ahead and share just for folks who might be interested in seeing the centering/resizing routines before they get lost in the rest of the game.

All that's left at this point is to add a screen so the user can make a bet on whether they can win or not (Larger hands have a higher return payout, though not a lot higher -- there's a secret to this game, which our math nerds might enjoy figuring out..), and then to add the "Flip It" routine to see if the user can win.

The point of this game is rather simple:
1) Only cards which are face up and visible can be removed from the game.
2) The user can only choose 1 card per turn.
3) When a card is removed from the game, the cards adjacent to it are "flipped".  Cards face up are turned down; cards down are turned up.
4) You play until all cards are removed (a win!), or until all cards left are face down (loser!).

I figure to add a little extra pizzazz to it, I'll make this a gambling solitaire game where you can make bets on whether you can win with a hand or not -- and that's the point where the game is currently up to.  Once you set your bet, gameplay starts, and you go until you win or lose, and you'll be able to play until you go broke...

Currently, it's an incomplete version of the game, but the logic behind everything is rather simple and easy to follow, so I thought I'd go ahead and share it in case anybody is interested in the scaling/positioning/mousehandling and such which is going on in it already before it gets any longer or more complicated.  ;)


*NOTE: You’ll need the QB64-Development version to compile and run this, as Petr pointed out below.  (Or my personal test QB64 version, downloadable via my repo link in my signature.)
Title: Re: Flip It
Post by: Petr on November 03, 2019, 04:44:01 am
Hi Steve. Very nice font, nice workmanship, but I had to use your IDE version (or I already have an outdated version and your $COLOR: 32 metacommand is already part of the IDE developer version?
I have one question to shuffle cards: on row 87 you have a command:

SWAP Deck (i), Deck (INT (RND * 52))

 What if INT (RND * 52)) returns the same value more than once?  I'm afraid this may cause the card OLD Deck (i)  to fall out of the deck.
Title: Re: Flip It
Post by: SMcNeill on November 03, 2019, 05:44:27 am
Quote from: Petr on November 03, 2019, 04:44:01 am
Hi Steve. Very nice font, nice workmanship, but I had to use your IDE version (or I already have an outdated version and your $COLOR: 32 metacommand is already part of the IDE developer version?
I have one question to shuffle cards: on row 87 you have a command:

SWAP Deck (i), Deck (INT (RND * 52))

 What if INT (RND * 52)) returns the same value more than once?  I'm afraid this may cause the card OLD Deck (i)  to fall out of the deck.

$COLOR:32 should already be in the dev version.  ;)

As for the RND question, it’s fine as it.

Let’s say we have a deck of 4 cards...  0, 1, 2, 3 are their values, and the initial order.

Now, we shuffle:

FOR I = 0 TO 3
   SWAP Deck(I), Deck(INT(RND * 4))
NEXT

With I = 0, we generate a random number of 3...  This makes the order 3, 1, 2, 0
With I = 1, we get that same random number 3...  The order is now 3, 0, 2, 1

Even if it’s the same number generated, the spot we swap it with incremented, so it’s never going to “fall out of deck”.

Each swap just shuffles the values back and forth in the deck so the cards go somewhere else, and since we run the loop once for each card there’s no chance of repeating the same sequence. 

It’s the simplest way I know to quickly implement a shuffle style routine for an array.  ;)

Title: Re: Flip It
Post by: Petr on November 03, 2019, 06:29:35 am
Now that I read your answer, I get it. You're right. I don't know, why I didn't realize it right away. Thanks for the explanation.
Title: Re: Flip It
Post by: bplus on November 03, 2019, 01:25:31 pm
Hi Steve,

I did find the reason this sort of sort is a little bit off, probably have to be a statistician to "see" it, but I am wondering if you saw that reason in F-Y discussion, said "f*** mathematics and started this game to show defiance? ;-))

Maybe you missed it: https://www.qb64.org/forum/index.php?topic=1800.msg110521#msg110521
Title: Re: Flip It
Post by: SMcNeill on November 03, 2019, 02:05:45 pm
Quote from: bplus on November 03, 2019, 01:25:31 pm
Hi Steve,

I did find the reason this sort of sort is a little bit off, probably have to be a statistician to "see" it, but I am wondering if you saw that reason in F-Y discussion, said "f*** mathematics and started this game to show defiance? ;-))

I saw the link you posted, but I’m a simple fellow.  Games don’t need perfect randomization to work.  (Good thing too, since RND itself isn’t truly random!)  The method I used is just what I’m used to plugging in to shuffle things, and I just popped it in there automatically.

What made me think of doing a little game like this was a video I saw on YouTube with some math lady talking about binary values and making a game with cards to flip them, and I thought, “Heck, that’d be easy enough to simulate.”  If I can hunt down the link again later, I’ll share it after the game is completed.  (I don’t want to share it early, as it gives several clues to solving the patterns, deciphering what’s not winnable at all, and which games you can win, unless you play stupidly...).

Sunday is family time around here, so I’m hoping to get it sit and finish this little project up tomorrow.  It’s simple enough to code, in my opinion, so just an hour or so of free time and I can knock it out, I think.  ;)
Title: Re: Flip It
Post by: bplus on November 03, 2019, 02:27:40 pm
LOL, I just realized if it's about binary tricks then it doesn't matter the cards are shuffled or not, all we should be worried about is if the card is turned over or not and where in the whole pattern the 1 or 0 sits.

Title: Re: Flip It
Post by: SMcNeill on November 03, 2019, 02:33:22 pm
Quote from: bplus on November 03, 2019, 02:27:40 pm
LOL, I just realized if it's about binary tricks then it doesn't matter the cards are shuffled or not, all we should be worried about is if the card is turned over or not and where in the whole pattern the 1 or 0 sits.

Which is why I didn’t think it’d matter if I had statistically accurate shuffling.  The cards are just a graphical representation of our bits — Face up (1) or face down (0).  ;)
Title: Re: Flip It
Post by: bplus on November 03, 2019, 05:15:32 pm
I am intrigued, trying the game with cards, small sets, haven't ended up with all face down yet...
Title: Re: Flip It
Post by: SMcNeill on November 04, 2019, 02:17:56 pm
Here's a version where you should be able to actually flip the cards and enjoy some basic cardplay:

Code: QB64: [Select]
  2. DEFLNG A-Z
  4. SCREEN _NEWIMAGE(1024, 720, 32) '720p screen
  5. _TITLE "Flip It"
  6. DIM SHARED CardImage AS LONG: CardImage = _LOADIMAGE("Cards.bmp", 32)
  7. DIM SHARED CardWide, CardHigh: CardWide = 72: CardHigh = 96
  8. DIM SHARED Deck(51) AS INTEGER 'an array to hold the cards
  9. REDIM SHARED Visible(0) AS INTEGER 'an array to see if the cards are visible or hidden
  10. DIM SHARED Result
  11. DIM SHARED OldEnglish, NumOfCards
  12. OldEnglish = _LOADFONT("OLDENGL.TTF", 32)
  14.  
  16.     NumOfCards = ChooseDifficulty
  17.     Shuffle
  18.     FOR i = 1 TO NumOfCards
  19.         DisplayCards
  20.         IF Result = 0 THEN EXIT FOR
  21.     NEXT
  22.     IF i = NumOfCards + 1 THEN DisplayCards: Result = -1 'flip the last card and win
  23.     WinOrLose
  25.  
  26. SUB WinOrLose
  27.     _FONT OldEnglish
  28.     IF Result THEN
  29.         PRINT "YOU WIN!!!"
  30.     ELSE
  31.         PRINT "YOU LOSE!!!"
  32.     END IF
  33.     _DELAY 3
  35.  
  36. SUB DisplayCards
  37.     CLS
  38.     _FONT 16
  39.     xstep = _WIDTH / NumOfCards
  40.     scale = xstep / CardWide
  41.     ystart = _HEIGHT / 2 - CardHigh * scale / 2
  42.  
  43.     FOR i = 0 TO NumOfCards - 1
  44.         IF Visible(i) = -1 THEN
  45.             suit = Deck(i) \ 13: value = Deck(i) MOD 13
  46.             _PUTIMAGE (xstep * i, ystart)-STEP(xstep, CardHigh * scale), CardImage, 0, (value * CardWide, suit * CardHigh)-STEP(CardWide, CardHigh)
  47.         ELSEIF Visible(i) = 0 THEN
  48.             LINE (xstep * i, ystart)-STEP(xstep, CardHigh * scale), White, BF
  49.             LINE (xstep * i + 2, ystart + 2)-STEP(xstep - 4, CardHigh * scale - 4), Blue, BF
  50.         ELSE
  51.             'We don't draw squat.  The card has been removed from play
  52.         END IF
  53.     NEXT
  54.  
  55.     Result = 0
  56.     FOR i = 0 TO NumOfCards - 1
  57.         IF Visible(i) < 0 THEN Result = -1: EXIT FOR 'there's still visible cards to play with
  58.     NEXT
  59.     IF Result = 0 THEN EXIT SUB
  60.  
  61.  
  62.  
  63.     oldmouse = -1 'cycle one to make certain mouse is up before we count a down event
  64.     DO
  65.         WHILE _MOUSEINPUT: WEND
  66.         mb = _MOUSEBUTTON(1)
  67.         IF oldmouse = 0 AND mb THEN
  68.             IF _MOUSEY >= ystart AND _MOUSEY <= ystart + CardHigh * scale THEN 'we're in the right rows for a valid mouse click
  69.                 choice = _MOUSEX \ xstep
  70.                 IF choice >= 0 AND choice <= NumOfCards AND Visible(choice) = -1 THEN finished = -1
  71.             END IF
  72.         END IF
  73.         oldmouse = mb
  74.         _LIMIT 30
  75.     LOOP UNTIL finished
  76.     Visible(choice) = 1
  77.     IF choice > 0 THEN
  78.         IF Visible(choice - 1) < 1 THEN Visible(choice - 1) = NOT Visible(choice - 1)
  79.     END IF
  80.     IF choice < NumOfCards THEN
  81.         IF Visible(choice + 1) < 1 THEN Visible(choice + 1) = NOT Visible(choice + 1)
  82.     END IF
  84.  
  85.  
  86.  
  87. FUNCTION ChooseDifficulty
  88.     CLS
  89.     _FONT OldEnglish
  90.     COLOR White
  91.     CenterText 0, 200, _WIDTH, 300, "Choose Difficulty"
  92.     COLOR Black
  93.  
  94.     FOR i = 0 TO 9
  95.         x = 5 + 102 * i
  96.         y = 300
  97.         LINE (x, y)-STEP(100, 100), Yellow, BF
  98.         CenterText x, y, x + 100, y + 100, _TRIM$(STR$(i + 6))
  99.     NEXT
  100.  
  101.     oldmouse = -1 'cycle one to make certain mouse is up before we count a down event
  102.     DO
  103.         WHILE _MOUSEINPUT: WEND
  104.         mb = _MOUSEBUTTON(1)
  105.         IF oldmouse = 0 AND mb THEN
  106.             IF _MOUSEY >= 300 AND _MOUSEY <= 400 THEN 'we're in the right rows for a valid mouse clice
  107.                 choice = (_MOUSEX - 5) \ 102
  108.                 IF choice >= 0 AND choice <= 9 THEN finished = -1
  109.             END IF
  110.         END IF
  111.         oldmouse = mb
  112.         _LIMIT 30
  113.     LOOP UNTIL finished
  114.     COLOR White
  115.     ChooseDifficulty = choice + 6
  117.  
  118. SUB CenterText (x1, y1, x2, y2, text$)
  119.     pw = _PRINTWIDTH(text$)
  120.     px = x1 + (x2 - x1) / 2 - pw / 2
  121.     py = y1 + (y2 - y1) / 2 - _FONTHEIGHT / 2
  122.     _PRINTSTRING (px, py), text$
  124.  
  125. SUB Shuffle
  126.     STATIC InitDeck
  127.     IF NOT InitDeck THEN
  128.         InitDeck = -1
  129.         FOR i = 0 TO 51: Deck(i) = i: NEXT 'put the cards in the deck
  130.     END IF
  131.     FOR i = 0 TO 51
  132.         SWAP Deck(i), Deck(INT(RND * 52)) 'shuffle the deck
  133.     NEXT
  134.     REDIM Visible(NumOfCards) AS INTEGER
  135.     FOR i = 0 TO NumOfCards - 1
  136.         Visible(i) = -INT(RND * 2)
  137.     NEXT
  139.  

Note:You'll either need the Dev build of QB64 to compile this, or else you'll need to manually swap in some color values in place of the $COLOR:32 statement.

I don't have this where it tracks money, or any form of betting yet, but it generates the game for us and lets us go about flipping our cards until we either get to a win or a loss with the game.

Some questions for all the math addicts out there:

1) What's the odds of generating a winnable game vs generating one which can't be won no matter how well we play?  Is there some trick to knowing instantly if a game is winnable or not?

2) What's the trick to always win, if the game does have a winnable solution?

I'll give you guys a few days to play around with things, and then I'll try and hunt down the youtube video which explains the theory and all behind the game and its mechanics.  (And, if I get a little extra free time after cleaning up the mess Halloween left all around the farm, I'll go in and finish this little "game" by adding in a small betting system so you can play and try and win an imaginary fortune on Flip It!)
Title: Re: Flip It
Post by: bplus on November 04, 2019, 04:34:14 pm
All that's needed (if you dont have Dev Build) is to replace first line with this:
Code: QB64: [Select]
  1. CONST white = &HFFFFFFFF, black = &HFF000000, yellow = &HFFFFFF00, blue = &HFF0000FF    

Oh! I guess I had invented my own game of Flip It, not like this one, mine was N x M array of cards and the play was a little different thanks to my misunderstanding of Steve's rules above :D
Title: Re: Flip It
Post by: TempodiBasic on November 04, 2019, 05:51:32 pm
Thanks Bplus
I'm just asking if using
Code: QB64: [Select]
  1. '$COLOR:32
  2. CONST White = _RGBA32(255, 255, 255, 255), Black = _RGBA32(0, 0, 0, 255)
  3. CONST Yellow = _RGBA32(255, 255, 0, 255), Blue = _RGBA32(0, 0, 255, 255)
  4.  
I got the same result.
(PS I have loosen a color ! :-)  )
Title: Re: Flip It
Post by: bplus on November 04, 2019, 08:10:56 pm
Well I know one thing, if you have one card up, you have a sure win!

Two things, if you have two cards up at an end you are dead meat, wait it might be 2 cards up anywhere.
Title: Re: Flip It
Post by: bplus on November 05, 2019, 03:52:20 pm
OK I've got the read of win or no way, and a strategy to assure the win when possible, very simple from some experiments starting with one or two cards face up, here is code for such experiments:
Code: QB64: [Select]
  1. _TITLE "Quick Flip It experiments" 'b+ started 2019-11-05
  2. ' inspired by Steve's recent QB64 thread:
  3. ' https://www.qb64.org/forum/index.php?topic=1831.msg110717#msg110717
  4. ' "experiments" allows control over number of face cards you want to test.
  5.  
  6. CONST yOff = 50, cw = 50, ch = 100, spacer = 10, nCards = 10 'should be enough to get the gist of what is going on
  7. CONST cardUp = &HFFBBBBBB, cardDown = &HFF000066, cardOut = &HFF000000
  8. CONST xmax = 610, ymax = 200
  9.  
  10. TYPE card
  11.     x AS INTEGER
  12.     y AS INTEGER
  13.     state AS INTEGER ' up = 1, down = 0, gone = -1
  15. DIM SHARED cards(1 TO nCards) AS card, gameOver
  16.  
  18. SCREEN _NEWIMAGE(xmax, ymax, 32)
  19. _SCREENMOVE 300, 100
  21.  
  22. gameOver = 1
  23. WHILE _KEYDOWN(27) = 0
  24.     IF gameOver THEN initRound
  25.     i = getCardClicked 'this card is removed and cards on either side (if any) are toggled up/down
  26.     IF i THEN
  27.         IF cards(i).state = 1 THEN
  28.             IF i > 1 THEN
  29.                 IF cards(i - 1).state <> -1 THEN cards(i - 1).state = 1 - cards(i - 1).state
  30.             END IF
  31.             IF i < nCards THEN
  32.                 IF cards(i + 1).state <> -1 THEN cards(i + 1).state = 1 - cards(i + 1).state
  33.             END IF
  34.             cards(i).state = -1
  35.         END IF
  36.     END IF
  37.     updateScreen
  38.     _DISPLAY
  39.     _LIMIT 60
  41.  
  42. FUNCTION getCardClicked
  44.     mb = _MOUSEBUTTON(1) '            left button down
  45.     IF mb THEN '                      get last place mouse button was down
  46.         WHILE mb '                    wait for mouse button release as a "click"
  47.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  48.         WEND
  49.         FOR i = 1 TO nCards '         now find which box was clicked
  50.             IF mx > cards(i).x AND mx < cards(i).x + cw THEN
  51.                 IF my > cards(i).y AND my < cards(i).y + ch THEN
  52.                     getCardClicked = i: EXIT FUNCTION
  53.                 END IF
  54.             END IF
  55.         NEXT
  56.     END IF
  58.  
  59. SUB updateScreen 'and count the ups and downs of cards
  60.     CLS
  61.     ups = 0: downs = 0 'count cards while displaying
  62.     FOR i = 1 TO nCards
  63.         IF cards(i).state = 1 THEN
  64.             ups = ups + 1: clr~& = cardUp
  65.         ELSEIF cards(i).state = 0 THEN
  66.             downs = downs + 1: clr~& = cardDown
  67.         ELSEIF cards(i).state = -1 THEN
  68.             clr~& = cardOut
  69.         END IF
  70.         LINE (cards(i).x, cards(i).y)-STEP(cw, ch), clr~&, BF
  71.     NEXT
  72.     'check win
  73.     IF ups = 0 THEN
  74.         gameOver = 1
  75.         IF downs > 0 THEN
  76.             _PRINTSTRING (270, 10), "No win"
  77.         ELSE
  78.             _PRINTSTRING (290, 10), "Win"
  79.         END IF
  80.         _DISPLAY: _DELAY 5
  81.     END IF
  83.  
  84. SUB initRound 'reassign letters and hide them all
  85.     CLS
  86.     INPUT "Enter the amount of cards (of 10) to show as up (lighter color), 0 quits "; upStart
  87.     IF upStart > 0 AND upStart <= nCards THEN
  88.         FOR i = 1 TO nCards  ' yeah I know x, y doesn't have to be redone each round
  89.             cards(i).x = spacer + (i - 1) * (cw + spacer): cards(i).y = yOff
  90.             IF i <= upStart THEN cards(i).state = 1 ELSE cards(i).state = 0
  91.         NEXT
  92.         FOR i = nCards TO 2 STEP -1 ' shuffle stuff in array
  93.             SWAP cards(i).state, cards(INT(i * RND) + 1).state
  94.         NEXT
  95.         gameOver = 0: updateScreen
  96.     ELSEIF upStart = 0 THEN  '<< EDIT: added in else
  97.         END
  98.     END IF
  100.  

EDIT: oops, forgot the 0 signal to quit, fixed now.
Title: Re: Flip It
Post by: SMcNeill on November 05, 2019, 03:58:12 pm
Here’s the video where I first say the lady explaining this little exercise:
&t=381s

Title: Re: Flip It
Post by: bplus on November 05, 2019, 04:42:07 pm
Quote from: SMcNeill on November 05, 2019, 03:58:12 pm
Here’s the video where I first say the lady explaining this little exercise:
&t=381s

Oh man! my strategy for play for guaranteed win is S+0! much simpler than that (hers in the video).

I am pretty sure it will never fail PLUS it has a symmetric opposite.
Title: Re: Flip It
Post by: bplus on November 05, 2019, 09:27:49 pm
Flip It Squared, same read, same guaranteed strategy for success when possible, only now it is symmetric 4 ways:
Code: QB64: [Select]
  2. _TITLE "Flip It Squared" 'b+ started 2019-11-05
  3. ' inspired by Steve's recent QB64 thread:
  4. ' https://www.qb64.org/forum/index.php?topic=1831.msg110717#msg110717
  5. ' from Quick Flip It experiments, add another dimemsion for complexity.
  6.  
  7. 'Objective: to remove all cards from board
  8. 'Play: can only remove face up cards (lighter color), cards adjacent to removed card will be toggled up/down (dark/light).
  9.  
  10. CONST across = 10, down = 7, sqSide = 50, sqSpace = 60, marg = 30 'should be enough to get the gist of what is going on
  11. CONST cardUp = &HFFBBBBBB, cardDown = &HFF000066, cardOut = &HFF000000
  13. xmax = across * sqSpace + 2 * marg: ymax = down * sqSpace + 2 * marg
  14.  
  15. DIM SHARED state(1 TO across, 1 TO down) AS INTEGER, gameover AS INTEGER, ups AS INTEGER, downs AS INTEGER
  17. SCREEN _NEWIMAGE(xmax, ymax, 32)
  18. _SCREENMOVE 300, 100
  21. gameover = 1
  22. WHILE _KEYDOWN(27) = 0
  23.     IF gameover THEN initRound
  24.     c = 0: r = 0
  25.     getCardClicked c, r 'this card is removed and cards adjacent (if any) are toggled up/down
  26.     IF c > 0 AND r > 0 THEN
  27.         LOCATE 1, 1: PRINT c, r
  28.         IF state(c, r) = 1 THEN
  29.             IF c > 1 THEN
  30.                 IF state(c - 1, r) <> -1 THEN state(c - 1, r) = 1 - state(c - 1, r)
  31.             END IF
  32.             IF c < across THEN
  33.                 IF state(c + 1, r) <> -1 THEN state(c + 1, r) = 1 - state(c + 1, r)
  34.             END IF
  35.             IF r > 1 THEN
  36.                 IF state(c, r - 1) <> -1 THEN state(c, r - 1) = 1 - state(c, r - 1)
  37.             END IF
  38.             IF r < down THEN
  39.                 IF state(c, r + 1) <> -1 THEN state(c, r + 1) = 1 - state(c, r + 1)
  40.             END IF
  41.             state(c, r) = -1
  42.         END IF
  43.     END IF
  44.     updateScreen
  45.     _DISPLAY
  46.     _LIMIT 60
  48.  
  49. SUB getCardClicked (col AS INTEGER, row AS INTEGER)
  50.     DIM mb AS INTEGER, m AS INTEGER, mx AS INTEGER, my AS INTEGER
  52.     mb = _MOUSEBUTTON(1) '            left button down
  53.     IF mb THEN '                      get last place mouse button was down
  54.         WHILE mb '                    wait for mouse button release as a "click"
  55.             m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  56.         WEND
  57.         FOR row = 1 TO down
  58.             FOR col = 1 TO across
  59.                 IF mx > (col - 1) * sqSpace + marg AND mx < (col - 1) * sqSpace + marg + sqSide THEN
  60.                     IF my > (row - 1) * sqSpace + marg AND my < (row - 1) * sqSpace + marg + sqSide THEN
  61.                         EXIT SUB 'found it
  62.                     END IF
  63.                 END IF
  64.             NEXT
  65.         NEXT
  66.         col = 0: row = 0
  67.     END IF
  69.  
  70. SUB updateScreen 'and count the ups and downs of cards
  71.     DIM ups AS INTEGER, downs AS INTEGER, y AS INTEGER, x AS INTEGER, clr~&
  72.     CLS
  73.     ups = 0: downs = 0 'count cards while displaying
  74.     FOR y = 1 TO down
  75.         FOR x = 1 TO across
  76.             IF state(x, y) = 1 THEN
  77.                 ups = ups + 1: clr~& = cardUp
  78.             ELSEIF state(x, y) = 0 THEN
  79.                 downs = downs + 1: clr~& = cardDown
  80.             ELSEIF state(x, y) = -1 THEN
  81.                 clr~& = cardOut
  82.             END IF
  83.             LINE ((x - 1) * sqSpace + marg, (y - 1) * sqSpace + marg)-STEP(sqSide, sqSide), clr~&, BF
  84.         NEXT
  85.     NEXT
  86.     yCP 10, SPACE$(60): yCP 10, "Ups, Downs: " + TS$(ups) + ", " + TS$(downs)
  87.     'check win
  88.     IF ups = 0 THEN
  89.         gameover = 1
  90.         IF downs > 0 THEN
  91.             yCP 10, SPACE$(60): yCP 10, "No win"
  92.         ELSE
  93.             yCP 10, SPACE$(60): yCP 10, "Win"
  94.         END IF
  95.         _DISPLAY: SLEEP 5
  96.     END IF
  98.  
  99. SUB initRound 'reassign letters and hide them all
  100.     DIM x AS INTEGER, y AS INTEGER
  101.     FOR y = 1 TO down
  102.         FOR x = 1 TO across
  103.             IF RND < .5 THEN state(x, y) = 1 ELSE state(x, y) = 0
  104.         NEXT
  105.     NEXT
  106.     gameover = 0: updateScreen
  108.  
  109. SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
  110.     _PRINTSTRING ((_WIDTH - LEN(s$) * 8) / 2, y), s$
  112.  
  114.     TS$ = _TRIM$(STR$(n))
  116.  
  117.  
Text Only | Text with Attachments