Cube Game from scratch

[bplus]

Before I saw the correct version of Cube from Morristown I thought the game would benefit from a mapping display for "You are here." But the way input was setup with Morristown code it was clear where you've been and where you could go next. Anyway here is my version made from scratch.

Oh a couple of mods to game:
1. to make input as easy and simple as possible you only enter one letter for your move
2. that one letter increases player one step on x, y or z plane
3. Wager is out but when you succeed to 3,3,3 you earn 1000 first time and are offered the opportunity to play again to double your money or lose it all and end game.

Code: (Select All)

Option _Explicit ' best practice
DefLng A-Z '       all numbers are integers
Randomize Timer '  for different mining at start
_Title "Cube From Scratch" ' bplus 2023-10-17
' a demo of developing code from a commented text of code specs

' try standard demo screen for QB64
Const Xmax = 800, Ymax = 600 ' screen width and height
Screen _NewImage(Xmax, Ymax, 12) ' 12 is 16 color old QB system
_ScreenMove 240, 80

' Define all Shared variables here with caps
' So to do this game called Cube from scratch you need a Cube array (x, y, z)
' where each x, y, or z is a number from 1 to 3
Dim Shared Cube(1 To 3, 1 To 3, 1 To 3)
Dim Shared Px, Py, Pz ' players position
Dim Shared MoneyUnits ' points from success(es?)
Dim Shared GameOver '   player stepped on Mine flag
Dim Shared GameWin '    player made it to 3,3,3

Intro
Do ' how many times can you make it to 3,3,3 and double your money?
    InitGame
    Do '                game round
        DisplayCube 0 ' display cube but not the mines
        HandleRound '   <<< game ends in here
        If GameWin Then Exit Do
        _Limit 30
    Loop
Loop

Sub DisplayCube (showMines) ' flags both GameOver and GameWin
    Dim x, y, z, zz, yy, xx, rn
    Cls
    ' 3 grids one for each z level
    ' x ascends going right
    ' y ascends going down
    ' z ascends going right
    _PrintString (179, 170), "z = 1"
    drawGrid 150, 50, 50, 50, 2, 2
    _PrintString (379, 170), "z = 2"
    drawGrid 350, 50, 50, 50, 2, 2
    _PrintString (579, 170), "z = 3"
    drawGrid 550, 50, 50, 50, 2, 2
    For z = 1 To 3
        zz = 150 + 200 * (z - 1)
        For y = 1 To 3
            yy = 50 + 50 * (y - 1)
            For x = 1 To 3
                xx = zz + 50 * (x - 1)
                If Px = x And Py = y And Pz = z Then ' draw player
                    For rn = 0 To 6
                        Circle (xx, yy), rn, 9
                    Next
                    If Px = 3 And Py = 3 And Pz = 3 Then GameWin = -1 'celebrate!
                End If
                If Cube(x, y, z) Then ' a mine is here
                    If showMines Then
                        For rn = 1 To 10 Step 2
                            Circle (xx, yy), rn, 12
                        Next
                    End If
                    If Px = x And Py = y And Pz = z Then GameOver = -1 'doomed
                End If
            Next
        Next
    Next
End Sub

Sub HandleRound
    Dim ok$, plane$
    If GameOver Then ' Round ender
        DisplayCube -1 ' show where mines were
        Beep
        Color 14
        yCP 23, "BOOM!"
        yCP 25, "Player you stepped on a mine."
        yCP 27, "Game Over!"
        Sleep
        End
    ElseIf GameWin Then ' Round ender
        ' made it! award 1000 or double money and offer to double it
        DisplayCube -1 ' show where mines were
        If MoneyUnits Then MoneyUnits = 2 * MoneyUnits Else MoneyUnits = 1000
        yCP 12, "You have earned" + Str$(MoneyUnits)
        yCP 14, "Do you want to play again for chance to double your money?"
        yCP 16, "Just press y + enter or just enter for yes, any other + enter = quit."
        Locate 23, 50: Input ok$
        If ok$ = "" Or ok$ = "y" Then Else End
    Else ' still going round get next move, get player move
        Locate 20, 32
        Input "Enter x, y, or z for the next step "; plane$
        plane$ = LCase$(plane$)
        If Px < 3 And plane$ = "x" Then
            Px = Px + 1
        ElseIf Py < 3 And plane$ = "y" Then
            Py = Py + 1
        ElseIf Pz < 3 And plane$ = "z" Then
            Pz = Pz + 1
        End If
    End If
End Sub

Sub Intro ' Start with clear description of the Game as Intro:
    Dim ok$
    yCP 5, "*** Cube from scratch ***"
    yCP 6, "bplus 2023-10-17"
    yCP 10, "You, the player, are starting at position 1,1,1 on wire frame cube 3x3x3"
    yCP 11, "and your objective is to reach 3,3,3 in single step moves."
    yCP 12, "You move on x, y, or z planes by 1 step forward no side or back stepping."
    yCP 14, "A Miner has preceeded you from 1,1,1 to 3,3,3 and laid mines down his path."
    yCP 16, "If you step on a mine, BOOM Game Over, so sorry this is a stupid game of pure luck!"
    yCP 18, "If you make it to 3,3,3 you will be awarded 1000 money units PLUS"
    yCP 19, "you will be offered opportunity to double your money units and play again."
    yCP 22, "Press enter to play, any other + enter quits..."
    Locate 30, 50: Input ; ok$
    If ok$ <> "" Then System
End Sub

Sub InitGame ' Reset variables and mine cube
    Dim mx, my, mz ' Minor's position
    Dim rn ' random number
    Erase Cube
    Px = 1: Py = 1: Pz = 1
    mx = 1: my = 1: mz = 1
    GameWin = 0
    ' Mine the cube by making one path from start to goal
    ' So where cube(x,y,z) = 0 it is safe for player to go ie move into.
    While mx <> 3 Or my <> 3 Or mz <> 3
        rn = rndI&(1, 3)
        If rn = 1 Then
            If mx < 3 Then
                mx = mx + 1
            ElseIf my < 3 Then
                my = my + 1
            Else
                mz = mz + 1
            End If
        ElseIf rn = 2 Then
            If my < 3 Then
                my = my + 1
            ElseIf mz < 3 Then
                mz = mz + 1
            Else
                mx = mx + 1
            End If
        Else
            If mz < 3 Then
                mz = mz + 1
            ElseIf mx < 3 Then
                mx = mx + 1
            Else
                my = my + 1
            End If
        End If
        If mx = 3 And my = 3 And mz = 3 Then Else Cube(mx, my, mz) = 1 ' mined
    Wend
End Sub

Sub yCP (RowNum&, s$) ' for graphics screen Center Print rowNum * 20 per row = y
    _PrintString ((_Width - _PrintWidth(s$)) / 2, RowNum& * 20), s$
End Sub

Function rndI& (n1 As Long, n2 As Long) 'return an integer between 2 numbers
    Dim As Long l, h
    If n1 > n2 Then l = n2: h = n1 Else l = n1: h = n2
    rndI& = Int(Rnd * (h - l + 1)) + l
End Function

Sub drawGrid (x, y, xs, ys, xn, yn) ' top left x, y, x side, y side, number of x, nmber of y
    Dim As Long i, dx, dy
    dx = xs * xn: dy = ys * yn
    For i = 0 To xn
        _PrintString (x + xs * i - 4, y - 24), _Trim$(Str$(i + 1))
        Line (x + xs * i, y)-(x + xs * i, y + dy)
    Next
    For i = 0 To yn
        _PrintString (x - 20, y + ys * i - 8), _Trim$(Str$(i + 1))
        Line (x, y + ys * i)-(x + dx, y + ys * i)
    Next
End Sub

[James D Jarvis]

made it to $4000 



upload photo get link

[bplus]

I made it to 16000 but it was before I was showing the mines in the final shot.
   

Of course I never came close since. Nope, but I bet I hold the record for most take a step and BOOM! 's.

I was meaning to show a snap of the game, so thanks James.