Solitary BINGO Game

I was curious how fast I could come up with a BINGO game one can just play on their own. Just under 4 hours.

You are presented with 5 BINGO cards you pick one, it costs a point. Then press any key to call up the next number, continue until winner(s) are yellow boxed. If your card won and no other card also won at same time you get 5 points. If 2 or more cards won on same number you split the 5 points with the number of winners, eg 2.5 points if your card and another wins, 1.66... points if you and 2 other cards win...


Yeah no Free Space in middle yet, nor B-I-N-G-O letters called out with number but computer finds and marks all the cards and calc's the winner(s).

Without Randomize Timer, the winning cards are 1, 2, 1, 3, 3 what's nice is the wins are a horizontal, a diagonal down left to right, a vertical and a diagonal the other way up from left to right. Sweet because I caught an error with last diagonal calc.



_Title "BINGO" 'b+ start 2021-09-23
DefLng A-Z
Screen _NewImage(648, 150, 32)
_Delay .3
_ScreenMove _Middle
Dim Shared n75(1 To 75)
Dim Shared cards(1 To 5) As String
Dim Shared hits(1 To 5) As String
Dim Shared n15(1 To 15) As Integer
Dim Shared gameOver$
Dim player As Single
For i = 1 To 15 ' make 15 deck for shuffling
   n15(i) = i
Next
For i = 1 To 75 ' make 75 deck for shuffling
   n75(i) = i
Next
While _KeyDown(27) = 0
   makeCards
   showCards
   _KeyClear
   Locate 2, 24: Input "Player please pick your card 1-5 "; pick$
   Cls
   showCards
   shuff75
   idx = 1: gameOver$ = "0"
   While gameOver$ = "0"
       n = n75(idx): idx = idx + 1
       If idx > 75 Then gameOn = 0: GoTo skip
       If Len(drawn$) Then drawn$ = drawn$ + "," + ts$(n) Else drawn$ = ts$(n)
       Color &HFFFFFFFF: Locate 1, 1: Print drawn$
       checkCards n
       showCards
       Sleep
       skip:
   Wend
   If InStr(gameOver$, pick$) Then
       player = player + 5 / (Len(gameOver$) - 1)
   Else
       player = player - 1
   End If
   Color &HFFFFFFFF: Cls: drawn$ = ""
   Print "Player has"; player; "points."
   _Delay 2
Wend

Sub checkCards (n)
   col = Int((n - 1) / 15) + 1
   For card = 1 To 5
       For row = 1 To 5
           If Val(_Trim$(Mid$(cards$(card), (col - 1) * 15 + (row - 1) * 3 + 1, 3))) = n Then
               Mid$(hits(card), (col - 1) * 5 + row) = "1"
               If Bingo(card) Then
                   Beep: gameOver$ = gameOver$ + ts$(card)
                   Line ((card - 1) * 16 * 8 + 7, 4 * 16 - 1)-Step(15 * 8 + 2, 5 * 16 + 3), &HFFFFFF00, B
               End If
               Exit For
           End If
       Next
   Next
End Sub

Function Bingo (card)
   For col = 1 To 5
       h = 0
       For row = 1 To 5
           h = h + Val(Mid$(hits(card), (col - 1) * 5 + row, 1))
       Next
       If h = 5 Then Bingo = 1: Exit Function
   Next
   For row = 1 To 5
       h = 0
       For col = 1 To 5
           h = h + Val(Mid$(hits(card), (col - 1) * 5 + row, 1))
       Next
       If h = 5 Then Bingo = 1: Exit Function
   Next
   h = 0
   For i = 1 To 5
       h = h + Val(Mid$(hits(card), (i - 1) * 5 + i, 1))
   Next
   If h = 5 Then Bingo = 1: Exit Function
   h = 0: j = 5
   For i = 1 To 5
       h = h + Val(Mid$(hits(card), j, 1))
       j = j + 4
   Next
   If h = 5 Then Bingo = 1: Exit Function
End Function

Sub showCards
   For card = 1 To 5
       For col = 1 To 5
           For row = 1 To 5
               If Mid$(hits(card), (col - 1) * 5 + row, 1) = "0" Then Color &HFFFFFFFF Else Color &HFF0000FF
               Locate row + 4, (card - 1) * 16 + (col - 1) * 3 + 2: Print Mid$(cards$(card), (col - 1) * 15 + (row - 1) * 3 + 1, 3);
           Next
       Next
   Next
End Sub

Sub makeCards
   For card = 1 To 5
       cards(card) = "": hits(card) = ""
       For col = 1 To 5
           shuff15
           For row = 1 To 5
               cards(card) = cards(card) + Right$("  " + ts$(n15(row) + (col - 1) * 15), 3)
               hits(card) = hits(card) + "0"
           Next
       Next
   Next
End Sub

Sub shuff15
   For i = 15 To 2 Step -1
       Swap n15(i), n15(Int(Rnd * i) + 1)
   Next
End Sub

Sub shuff75
   For i = 75 To 2 Step -1
       Swap n75(i), n75(Int(Rnd * i) + 1)
   Next
End Sub

Function ts$ (n)
   ts$ = _Trim$(Str$(n))
End Function