06-11-2025, 05:49 AM
This is my version of the card-game Snap, that most of us have played at some time.
I've made a few changes from the original; I think that's called poetic licence.
I've made a few changes from the original; I think that's called poetic licence.
Code: (Select All)
ASW = 1040: SH = 720
Screen _NewImage(SW, SH, 32)
SetFont: F& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 20, "monospace"): _Font F&
Common Shared CPL, Ctr, GCtr, OK$, Bad$, Finish$, Name$(), HandSize(), Card$(), NumStacks, LHS, WinScore, place, Place$, Dely
Common Shared Card(), StackNum, Stack(), StackHoriz, FrameHoriz(), SetNum, NumFlips, Winr, Claimer, Claim, Winner, Score()
CPL = Int(SW / _PrintWidth("X")): Ctr = Int((CPL + 1) / 2)
_ScreenMove (_DesktopWidth - SW) / 2, 90
GCtr = SW / 2 - 7 ' horiz centre of graphics screen
_ScreenMove (_DesktopWidth - SW) / 2, 90
Randomize Timer
' Ctr is text horiz centre of screen
' GCtr is pixel horiz centre of screen
' OK$,Bad$ and Finish$ are sound strings
' NumStacks is selected number of stacks
' StackHoriz() is horiz pixel position of each stack
' Place is flag for Random or Sequential flip positions
' Place$ is text of flip position type
' stacknum is number of the stack addressed
' Stack() holds number of each stack's last flipped card
' FlipNum is current number of flips (used for value of claims)
' Flip is number of the card being flipped, 1 to 20
' Card$(20) is array of card pics (4 sets of 20)
' Claimer is number of the player claiming (swapped to opponent if claim fails)
' Match is flag for match success (1) or fail (0)
' Place is o for random, 1 for sequential stacks for flips
' Dely is delay time between flips
OK$ = "o4l32cde": Bad$ = "o2l32edc": Finish$ = "o2l32cego3cego4c"
SetNum = 1: NumStacks = 3: Dely = 1: WinScore = 50: place = 1: Place$ = "Sequential"
Dim Name$(2), Score(2), Card$(20)
Types:
Data "Animals","Letters","Shapes","Objects"
Instructions
Options:
Centre "To toggle the setting for any option, press the Option Number (1 to 5)", 12: White
WIPE "14"
Restore
For a = 1 To SetNum: Read settype$: Next
txt$ = "1 Image Set: Set" + Str$(SetNum) + "(" + settype$ + ")"
Locate 14, 22: Print txt$
WIPE "15"
txt$ = "2 Number of Stacks: " + Str$(NumStacks) + " Stacks"
Locate 15, 22: Print txt$
WIPE "16"
txt$ = "3 Delay between Flips: "
If Dely < 1 Then txt$ = txt$ + "0"
txt$ = txt$ + LTrim$(Str$(Dely)) + " sec"
Locate 16, 22: Print txt$
WIPE "17"
txt$ = "4 Winning Score: " + Str$(WinScore) + " points"
Locate 17, 22: Print txt$
WIPE "18"
txt$ = "5 Flip Position: " + Place$
Locate 18, 22: Print txt$
Yellow: Centre "Press any other key when all options are ok", 20
While InKey$ <> "": Wend
k$ = ""
While k$ = "": k$ = InKey$: Wend
Select Case k$
Case "1"
ChooseSet
Case "2"
ChooseNumStacks
Case "3"
ChooseSpeed
Case "4"
ChooseWinScore
Case "5"
ChooseRandStack
Case Else
GoTo GetNames
End Select
GoTo Options
_KeyClear: Play OK$
GetNames:
Cls
_KeyClear
Centre "Name for player 1", 15
Locate 16, 38
Input Name$(1)
Name$(1) = UCase$(Name$(1))
If Name$(1) < "A" Then Name$(1) = "PLAYER1"
WIPE "16"
If Len(Name$(1)) > 7 Then Name$(1) = Left$(Name$(1), 7)
Centre Name$(1), 16
_Delay .5: WIPE "16"
_KeyClear
Centre "Name for player 2", 15
Locate 16, 38
Input Name$(2)
Name$(2) = UCase$(Name$(2))
If Name$(2) < "A" Then Name$(2) = "PLAYER2"
WIPE "16"
If Len(Name$(2)) > 7 Then Name$(2) = Left$(Name$(2), 7)
Centre Name$(2), 16
_Delay .5: Cls
If Name$(1) = Name$(2) Then Name$(1) = Name$(1) + "1": Name$(2) = Name$(2) + "2" ' if same name, separate them
Cls
SetStackPositions:
Dim FrameHoriz(NumStacks), Stack(NumStacks), Card(NumStacks)
LHS = GCtr - NumStacks * 27 ' LHS of first stack
match = 0: k = 0
FlipLoop:
Yellow: Centre "Press your Shift key when you see a matching pair", 20
Yellow: For a = 1 To NumStacks
FrameHoriz(a) = LHS + a * 54 - 54 '
PSet (FrameHoriz(a), 198): Draw "r54d54l54u54"
Next
_KeyClear: Claim = 0
While Claim < 1
StackNum = StackNum + 1: If StackNum > NumStacks Then StackNum = 1 ' inc stack (cycloic)
If place = 0 Then StackNum = Int(Rnd * NumStacks) + 1
NumFlips = NumFlips + 1
StackHoriz = FrameHoriz(StackNum) + 2
Card(StackNum) = Int(Rnd * 20) + 1
Tile = _LoadImage("recpics" + LTrim$(Chr$(SetNum + 48)) + "/" + Chr$(64 + Card(StackNum)) + ".jpg")
_PutImage (StackHoriz, 200)-(StackHoriz + 50, 250), Tile
_Delay Dely
Claimer = 100305 - _KeyHit ' leftshift 1, rightshift 2
If Claimer = 1 Or Claimer = 2 Then Exit While
' Locate 1, 1: Print "claimer is"; Claimer: Sleep 2
WIPE "27"
txt$ = "Flipped:" + Str$(NumFlips)
Centre txt$, 27
Centre "Scores", 1
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 2
Wend
CheckMatch
GoTo FlipLoop
Sub ChooseSet ' returns with next setnum
WIPE "14"
SetNum = SetNum + 1: If SetNum > 4 Then SetNum = 1
Restore Types
For a = 1 To SetNum: Read settype$: Next
txt$ = "1 Image Set: Set" + Str$(SetNum) + "(" + settype$ + ")"
Locate 14, 22: Print txt$
End Sub
Sub ChooseNumStacks
WIPE "15"
NumStacks = NumStacks + 1: If NumStacks > 5 Then NumStacks = 2
txt$ = "2 Number of Stacks: " + Str$(NumStacks) + " Stacks"
Locate 15, 22: Print txt$
End Sub
Sub ChooseSpeed
WIPE "16"
Dely = Int(Dely * 10 + 2) / 10: If Dely > 2 Then Dely = .2
txt$ = "3 Delay between Flips: " + Str$(Dely) + " sec"
Locate 16, 22: Print txt$
End Sub
Sub ChooseWinScore
WIPE "17"
WinScore = WinScore + 50: If WinScore > 250 Then WinScore = 50
txt$ = "4 Winning Score: " + Str$(WinScore) + " points"
Locate 17, 22: Print txt$
End Sub
Sub ChooseRandStack
WIPE "18"
If place = 1 Then
place = 0
Place$ = "Random"
Else
place = 1
Place$ = "Sequential"
End If
txt$ = "5 Flip Position: " + Place$
Locate 18, 22: Print txt$
End Sub
Sub CheckMatch ' a claim has been made by Claimer
match = 0
For a = 1 To NumStacks ' check each card against every other card for a match
For b = 1 To NumStacks
If Card(a) = Card(b) And a <> b And Card(a) <> 0 Then match = 1: Exit For ' if same card for A and B (or if empty), ignore match
Next
Next
If match = 0 Then ' if no matches
Play Bad$: Centre "No Match!", 18
If Claimer = 1 Then Claimer = 2 Else Claimer = 1 ' switch claim to other player
Else
Play OK$: Centre "A Match!", 18 ' (if a match was found, no switch is made)
End If
txt$ = Str$(NumFlips) + " points awarded to " + Name$(Claimer)
Centre txt$, 16
Score(Claimer) = Score(Claimer) + NumFlips ' award Claimer with cards flipped
Centre "Scores", 1
WIPE "02"
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 2
If Score(Claimer) >= 50 Then EndGame
NumFlips = 0: StackNum = 0 ' reset Flips count and reset to stack 1
Sleep 2: WIPE "1618"
Black
For a = 1 To NumStacks
StackHoriz = FrameHoriz(a) + 2
Line (StackHoriz, 200)-(StackHoriz + 50, 250), , BF ' clear the satck displays
Card(a) = 0: Claimer = 0
Next
End Sub
Sub EndGame
Cls
Play Finish$
Centre "Scores", 13
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 15
txt$ = "Congratulations, " + Name$(Claimer)
Centre txt$, 17
Sleep: System
End Sub
Sub Yellow
Color _RGB(255, 255, 0)
End Sub
Sub White
Color _RGB(255, 255, 255)
End Sub
Sub Red
Color _RGB(255, 0, 0)
End Sub
Sub Black
Color _RGB(0, 0, 0)
End Sub
Sub WIPE (LN$)
If Len(LN$) = 1 Then LN$ = "0" + LN$
For A = 1 To Len(LN$) - 1 Step 2
WL = Val(Mid$(LN$, A, 2))
' Locate WL, 1: Print String$(5, "X"): _Delay .5 (test line)
Locate WL, 1: Print Space$(CPL - 1)
Next
End Sub
Sub Centre (Txt$, LineNum)
Locate LineNum, Ctr - Len(Txt$) / 2
Print Txt$;
End Sub
Sub Instructions
Yellow: Centre "Snap - a Reflex game for two Players", 7
txt$ = "based on the card game of " + Chr$(34) + "Snap" + Chr$(34)
Centre txt$, 8: White: Print: Print
Print " This game uses a large pack of cards, each holding one of 20 images. Before"
Print " the game begins, players choose to have the cards ";: Yellow: Print "Flipped";: White: Print " onto either two,"
Print " three, four or five";: Yellow: Print " stacks";: White: Print "; the type of images they prefer (Animals, Letters,"
Print " Shapes, or Objects); and several other options.": Print
Print " One of the cards is Flipped onto each of the Stacks in turn, but only the"
Print " last card flipped to each stack remains visible. Players wait for any two of"
Print " the visible cards to match, and when they do, they press their key (Left or"
Print " Right Shift) to ";: Yellow: Print "Snap";: White: Print " them.": Print
Print " If the cards match, the player who snapped first has the number of flipped"
Print " cards added to their score. If they don't match, their opponent scores the"
Print " points. The stacks are then cleared, and the game continues. When a player"
Print " has scored the selected winning number of points, the game ends.": Print
Yellow: Centre "Press a key to begin", 25
Sleep: Cls
End Sub
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Please visit my Website at: http://oldendayskids.blogspot.com/