06-20-2023, 05:41 PM
(06-20-2023, 02:44 PM)James D Jarvis Wrote: Version 2 of course.Is the '_title' the way you want it? It don't match 1st comment. I might be mistaken.
The only differences here are in the shuffle routine, it's a little bit quicker and slightly more robust.
Code: (Select All)'drawcards v2
'ascii playing cards but for 32 bit graphics
'by James D. Jarvis
'use as you wish
Screen _NewImage(480, 288, 32)
_Font 8
_FullScreen
Color _RGB32(5, 5, 5), _RGB32(250, 250, 250)
_ControlChr Off
Dim Shared card$(0 To 52)
_Title "DRAWCARDS v1.0"
buildcards 'got to build the deck
Do
shuffledeck 'shuffle the whole deck
'just a demo of the first 21 cards laid out after shuffling the deck
drawcard 0, 10, card$(1)
drawcard 50, 10, card$(2)
drawcard 100, 10, card$(3)
drawcard 150, 10, card$(4)
drawcard 200, 10, card$(5)
drawcard 250, 10, card$(6)
drawcard 300, 10, card$(7)
drawcard 50, 110, card$(8)
drawcard 80, 115, card$(9)
drawcard 110, 120, card$(10)
drawcard 140, 125, card$(11)
drawcard 170, 120, card$(12)
drawcard 200, 115, card$(13)
drawcard 230, 110, card$(14)
drawcard 300, 90, card$(15)
drawcard 320, 105, card$(16)
drawcard 340, 120, card$(17)
drawcard 360, 135, card$(18)
drawcard 380, 150, card$(19)
drawcard 400, 165, card$(20)
drawcard 420, 180, card$(21)
_PrintString (10, 250), "Press any key to reshuffle, <esc> to quit"
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
Loop Until kk$ = Chr$(27)
Sub buildcards
'build a deck of cards
Dim cc$(13)
Dim st$(4)
cc$(1) = "A": cc$(10) = "T": cc$(11) = "J": cc$(12) = "Q": cc$(13) = "K"
cc$(2) = "2": cc$(3) = "3": cc$(4) = "4": cc$(5) = "5": cc$(6) = "6": cc$(7) = "7": cc$(8) = "8": cc$(9) = "9"
st$(1) = "H": st$(2) = "C": st$(3) = "S": st$(4) = "D"
c = 0
For ss = 1 To 4
For rr = 1 To 13
c = c + 1
card$(c) = cc$(rr) + st$(ss)
Next rr
Next ss
End Sub
Sub shuffledeck
'shuffle the whole deck by randomly swapping pairs of cards
sortsize = UBound(card$)
For x = 1 To sortsize
Do
a = Int(1 + Rnd * sortsize)
Loop Until a <> x 'let's make sure the cards change position
Swap card$(x), card$(a)
Next x
End Sub
Sub drawcard (cx, cy, card$)
'draws a ascii graphics card using the 8x8 fonts
Dim klr As _Unsigned Long
suit$ = Mid$(card$, 2, 1)
rank$ = Mid$(card$, 1, 1)
st = 0
_PrintString (cx, cy), Chr$(201) + Chr$(205) + Chr$(205) + Chr$(205) + Chr$(187)
_PrintString (cx, cy + 8), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 16), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 24), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 32), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 40), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 48), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 56), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)
_PrintString (cx, cy + 64), Chr$(200) + Chr$(205) + Chr$(205) + Chr$(205) + Chr$(188)
Select Case suit$
Case "H"
st = 3
klr = _RGB32(250, 0, 0)
Case "C"
st = 5
klr = _RGB32(50, 50, 50)
Case "S"
st = 6
klr = _RGB32(50, 50, 50)
Case "D"
st = 4
klr = _RGB32(250, 0, 0)
End Select
Color klr, _RGB32(250, 250, 250)
Select EveryCase rank$
Case "2", "3"
_PrintString (cx + 8, cy + 8), Chr$(Asc(rank$))
_PrintString (cx + 8, cy + 48), Chr$(st)
_PrintString (cx + 24, cy + 16), Chr$(st)
_PrintString (cx + 24, cy + 56), Chr$(Asc(rank$))
Case "4", "5"
_PrintString (cx + 8, cy + 16), Chr$(st)
_PrintString (cx + 8, cy + 48), Chr$(st)
_PrintString (cx + 24, cy + 16), Chr$(st)
_PrintString (cx + 24, cy + 48), Chr$(st)
Case "6", "7"
_PrintString (cx + 8, cy + 16), Chr$(st)
_PrintString (cx + 8, cy + 32), Chr$(st)
_PrintString (cx + 8, cy + 48), Chr$(st)
_PrintString (cx + 24, cy + 16), Chr$(st)
_PrintString (cx + 24, cy + 32), Chr$(st)
_PrintString (cx + 24, cy + 48), Chr$(st)
Case "8", "9"
_PrintString (cx + 8, cy + 16), Chr$(st)
_PrintString (cx + 8, cy + 24), Chr$(st)
_PrintString (cx + 8, cy + 40), Chr$(st)
_PrintString (cx + 8, cy + 48), Chr$(st)
_PrintString (cx + 24, cy + 16), Chr$(st)
_PrintString (cx + 24, cy + 24), Chr$(st)
_PrintString (cx + 24, cy + 40), Chr$(st)
_PrintString (cx + 24, cy + 48), Chr$(st)
Case "T"
_PrintString (cx + 8, cy + 8), "10"
_PrintString (cx + 8, cy + 16), Chr$(st)
_PrintString (cx + 8, cy + 24), Chr$(st)
_PrintString (cx + 8, cy + 32), Chr$(st)
_PrintString (cx + 8, cy + 40), Chr$(st)
_PrintString (cx + 8, cy + 48), Chr$(st)
_PrintString (cx + 24, cy + 16), Chr$(st)
_PrintString (cx + 24, cy + 24), Chr$(st)
_PrintString (cx + 24, cy + 32), Chr$(st)
_PrintString (cx + 24, cy + 40), Chr$(st)
_PrintString (cx + 24, cy + 48), Chr$(st)
_PrintString (cx + 16, cy + 56), "10"
Case "A", "3", "5", "7", "9"
_PrintString (cx + 16, cy + 32), Chr$(st)
Case "J"
_PrintString (cx + 12, cy + 26), Chr$(192) + Chr$(217)
_PrintString (cx + 16, cy + 26), Chr$(193)
Case "Q"
_PrintString (cx + 8, cy + 26), Chr$(192) + Chr$(st) + Chr$(217)
_PrintString (cx + 10, cy + 32), Chr$(40)
_PrintString (cx + 24, cy + 32), Chr$(41)
Case "K"
_PrintString (cx + 16, cy + 18), Chr$(215)
_PrintString (cx + 8, cy + 26), Chr$(200) + Chr$(202) + Chr$(188)
_PrintString (cx + 16, cy + 38), Chr$(31)
Case "J", "Q", "K"
_PrintString (cx + 8, cy + 8), Chr$(Asc(rank$)) + Chr$(st)
_PrintString (cx + 16, cy + 32), Chr$(1)
Case "2", "3", "4", "5", "6", "7", "8", "9", "A", "J", "Q", "K"
_PrintString (cx + 8, cy + 8), Chr$(Asc(rank$))
_PrintString (cx + 24, cy + 56), Chr$(Asc(rank$))
End Select
Color _RGB32(5, 5, 5), _RGB32(250, 250, 250)
End Sub