QB64 Phoenix Edition
MazeRogue - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: MazeRogue (/showthread.php?tid=1010)



MazeRogue - James D Jarvis - 10-28-2022

A micro rogue-like game. 
Navigate with arrow keys.
Collect gems, health potions, and power runes.
Monsters are just window dressing for now.

Code: (Select All)
'mazerogue
' a micro rogue by James D. Jarvis October 2022
'navigate with arrow keys
Screen _NewImage(81, 30, 0)
Randomize Timer
Dim T$
Dim crn$(4)
_ControlChr Off
_Scrolllock Off
Dim mz(0 To 80, 1 To 25) As String
Dim crnr(4, 2), loot(3), monst(3)
loot(1) = 4: loot(2) = 3: loot(3) = 15
monst(1) = 132: monst(2) = 42: monst(3) = 111
crnr(1, 1) = 1: crnr(1, 2) = 1
crnr(2, 1) = 79: crnr(2, 2) = 1
crnr(3, 1) = 1: crnr(3, 2) = 25
crnr(4, 1) = 79: crnr(4, 2) = 25
maxx = 80: maxy = 25: mlevel = 0
herox = Int(_Width / 2): heroy = Int(_Height / 2)
php = 10: ppow = 0: pgems = 0
newlevel:
mlevel = mlevel + 1
mlabel$ = "MazeRogue Level " + Str$(mlevel)
_Title mlabel$
For y = 1 To maxy
    For x = 0 To maxx
        mz(x, y) = Chr$(219)
    Next
Next
nx = 3: ny = 3: done = 0
Do While done = 0
    _Limit 1000
    For reps = 0 To 99
        ox = nx: oy = ny
        Rem move in random direction
        Select Case Int(Rnd * 4)
            Case 0
                If nx + 2 <= maxx Then nx = nx + 2
            Case 1
                If ny + 2 <= maxy Then ny = ny + 2
            Case 2
                If nx - 2 > 0 Then nx = nx - 2
            Case 3
                If ny - 2 > 0 Then ny = ny - 2
        End Select
        If mz(nx, ny) = Chr$(219) Then
            mz(nx, ny) = ".": If 1 + Int(Rnd * 50) = 1 Then mz(nx, ny) = Chr$(loot(1 + Int(Rnd * 3)))
            If mz(nx, ny) = "." And 1 + Int(Rnd * 50) <= mlevel Then mz(nx, ny) = Chr$(monst(1 + Int(Rnd * 3)))
            mz(Int((nx + ox) / 2), ((ny + oy) / 2)) = "."
        End If
    Next
    done = 1
    For x = 1 To maxx - 1 Step 2
        For y = 1 To maxy - 1 Step 2
            If mz(x, y) = Chr$(219) Then done = 0
        Next y
    Next x
Loop
cr = 1 + Int(Rnd * 4) 'set a corner for the exit
If herox = crnr(cr, 1) And heroy = crnr(cr, 2) Then cr = 5 - cr
mz(crnr(cr, 1), crnr(cr, 2)) = Chr$(239)
T$ = "" 'load the maze into t$
For y = 1 To 25: For x = 0 To 80: T$ = T$ + mz$(x, y): Next x: Next y
ll$ = String$(81, 219) 'top and botton maze display edges becasue I didn't want to fix the maze generator to account for top and bottom edge
lastX = herox: lasty = heroy
Do 'game play loop
    _Limit 20
    Mid$(T$, (heroy) * 81 + herox - 81) = Chr$(1)
    _PrintString (1, 1), ll$: _PrintString (1, 27), ll$: _PrintString (1, 2), T$
    _PrintString (1, 28), String$(80, " ")
    pcc$ = "Hit Points: " + Str$(php) + "  Power: " + Str$(ppow) + "   Gems: " + Str$(pgems)
    _PrintString (3, 28), pcc$
    If _KeyDown(19200) Then herox = herox - 1
    If _KeyDown(19712) Then herox = herox + 1
    If _KeyDown(18432) Then heroy = heroy - 1
    If _KeyDown(20480) Then heroy = heroy + 1
    If herox < 1 Then herox = 1
    If herox > _Width Then herox = _Width
    If heroy < 1 Then heroy = 1
    If heroy > 25 Then heroy = 25
    Mid$(T$, (lasty) * 81 + lastX - 81) = "."
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(219) Then
        herox = lastX: heroy = lasty
    End If
    For lp = 1 To 3
        If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(loot(lp)) Then
            Select Case lp
                Case 1
                    pgems = pgems + 1
                Case 2
                    php = php + 3
                Case 3
                    ppow = ppow + 2
            End Select
        End If
    Next lp
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(239) Then
        Beep: Cls: Print: Print "Continue to Next Level ?": Print: Input "Yes or No", ask$
        If Left$(UCase$(ask$), 1) = "N" Then
            heroy = lasty: herox = lastX
        Else
            Cls: GoTo newlevel
        End If
    End If

    lastX = herox: lasty = heroy
    k$ = InKey$
Loop Until k$ = Chr$(27)
System



RE: MazeRogue - bplus - 10-28-2022

What a great maze maker the bulk of a game in around 100 LOC, nice.

I did not care for key action and find the following fix much better:
Code: (Select All)
'mazerogue
' a micro rogue by James D. Jarvis October 2022
'navigate with arrow keys
Screen _NewImage(81, 30, 0)
Randomize Timer
Dim T$
Dim crn$(4)
_ControlChr Off
_Scrolllock Off
Dim mz(0 To 80, 1 To 25) As String
Dim crnr(4, 2), loot(3), monst(3)
loot(1) = 4: loot(2) = 3: loot(3) = 15
monst(1) = 132: monst(2) = 42: monst(3) = 111
crnr(1, 1) = 1: crnr(1, 2) = 1
crnr(2, 1) = 79: crnr(2, 2) = 1
crnr(3, 1) = 1: crnr(3, 2) = 25
crnr(4, 1) = 79: crnr(4, 2) = 25
maxx = 80: maxy = 25: mlevel = 0
herox = Int(_Width / 2): heroy = Int(_Height / 2)
php = 10: ppow = 0: pgems = 0
newlevel:
mlevel = mlevel + 1
mlabel$ = "MazeRogue Level " + Str$(mlevel)
_Title mlabel$
For y = 1 To maxy
    For x = 0 To maxx
        mz(x, y) = Chr$(219)
    Next
Next
nx = 3: ny = 3: done = 0
Do While done = 0
    _Limit 1000
    For reps = 0 To 99
        ox = nx: oy = ny
        Rem move in random direction
        Select Case Int(Rnd * 4)
            Case 0
                If nx + 2 <= maxx Then nx = nx + 2
            Case 1
                If ny + 2 <= maxy Then ny = ny + 2
            Case 2
                If nx - 2 > 0 Then nx = nx - 2
            Case 3
                If ny - 2 > 0 Then ny = ny - 2
        End Select
        If mz(nx, ny) = Chr$(219) Then
            mz(nx, ny) = ".": If 1 + Int(Rnd * 50) = 1 Then mz(nx, ny) = Chr$(loot(1 + Int(Rnd * 3)))
            If mz(nx, ny) = "." And 1 + Int(Rnd * 50) <= mlevel Then mz(nx, ny) = Chr$(monst(1 + Int(Rnd * 3)))
            mz(Int((nx + ox) / 2), ((ny + oy) / 2)) = "."
        End If
    Next
    done = 1
    For x = 1 To maxx - 1 Step 2
        For y = 1 To maxy - 1 Step 2
            If mz(x, y) = Chr$(219) Then done = 0
        Next y
    Next x
Loop
cr = 1 + Int(Rnd * 4) 'set a corner for the exit
If herox = crnr(cr, 1) And heroy = crnr(cr, 2) Then cr = 5 - cr
mz(crnr(cr, 1), crnr(cr, 2)) = Chr$(239)
T$ = "" 'load the maze into t$
For y = 1 To 25: For x = 0 To 80: T$ = T$ + mz$(x, y): Next x: Next y
ll$ = String$(81, 219) 'top and botton maze display edges becasue I didn't want to fix the maze generator to account for top and bottom edge
lastX = herox: lasty = heroy
Do 'game play loop
    _Limit 20
    Mid$(T$, (heroy) * 81 + herox - 81) = Chr$(1)
    _PrintString (1, 1), ll$: _PrintString (1, 27), ll$: _PrintString (1, 2), T$
    _PrintString (1, 28), String$(80, " ")
    pcc$ = "Hit Points: " + Str$(php) + "  Power: " + Str$(ppow) + "   Gems: " + Str$(pgems)
    _PrintString (3, 28), pcc$
    KH& = _KeyHit
    If KH& = 19200 Then herox = herox - 1
    If KH& = 19712 Then herox = herox + 1
    If KH& = 18432 Then heroy = heroy - 1
    If KH& = 20480 Then heroy = heroy + 1
    If herox < 1 Then herox = 1
    If herox > _Width Then herox = _Width
    If heroy < 1 Then heroy = 1
    If heroy > 25 Then heroy = 25
    Mid$(T$, (lasty) * 81 + lastX - 81) = "."
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(219) Then
        herox = lastX: heroy = lasty
    End If
    For lp = 1 To 3
        If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(loot(lp)) Then
            Select Case lp
                Case 1
                    pgems = pgems + 1
                Case 2
                    php = php + 3
                Case 3
                    ppow = ppow + 2
            End Select
        End If
    Next lp
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(239) Then
        Beep: Cls: Print: Print "Continue to Next Level ?": Print: Input "Yes or No", ask$
        If Left$(UCase$(ask$), 1) = "N" Then
            heroy = lasty: herox = lastX
        Else
            Cls: GoTo newlevel
        End If
    End If

    lastX = herox: lasty = heroy
    k$ = InKey$
Loop Until k$ = Chr$(27)
System
Does it work better for you?

I request a Legend to explain the the symbols in maze. Hate to mistake a gem or magic potion for Yosemite Sam.


RE: MazeRogue - James D Jarvis - 10-28-2022

I'll be slapping in a help screen or an intro screen eventually. the diamonds are gems, the hearts are health potions , and the starbursts are power runes. the monsters are ants, spiders, and orklins. probably changing the whole input scheme so it's more properly "roguelike" whit one turn per key press. 1st test of my monster code and most run into a corner or even worse tunnel off the screen in about a second. Already killed the ant tunnelling code. If I can squeeze some time in this weekend I hope to get the monsters working.


RE: MazeRogue - bplus - 10-28-2022

(10-28-2022, 03:36 PM)James D Jarvis Wrote: I'll be slapping in a help screen or an intro screen eventually.      the diamonds are gems, the hearts are health potions , and the starbursts are power runes.      the monsters are ants, spiders, and orklins.  probably changing the whole input scheme so it's more properly "roguelike" whit one turn per key press. 1st test of my monster code and most run into a corner or even worse tunnel off the screen in about a second. Already killed the ant tunnelling code.  If I can squeeze some time in this weekend I hope to get the monsters working.

Hi @James D Jarvis, did you try the alternate key action I posted? For me, it is much easy to step only once to turn a corner and go a different passage way. Originally in your code with _Keydown() I jump past, too far one way then too far the other, not fun.

A monster could go same direction it is already headed (80%) or reverse -dx or -dy (20%), or any avail direction if at intersect of passage way (25% maybe).
A smarter one would head towards hero's x, y at every possible opportunity.


RE: MazeRogue - James D Jarvis - 10-28-2022

Haven't had a chance yet. I might be able to get to it later tonight or tomorrow. Thanks for the input.


RE: MazeRogue - James D Jarvis - 10-29-2022

Okay so _keyhit as opposed to keydown does seem to work better in a tight maze, thanks for that.


RE: MazeRogue - James D Jarvis - 10-30-2022

gosh darn... I'm messing something up big time.  might have to strip this down and rebuild from scratch. More happens in this listing just not like I wanted it to, posting this failure as an example of what no to do:

Code: (Select All)
'mazerogue the bad code... doesn't work like it is suposed to... bad code...bad
' a micro rogue by James D. Jarvis October 2022
'navigate with arrow ke
Screen _NewImage(81, 30, 0)
'$dynamic
Randomize Timer
Dim T$
Dim crn$(4)
_ControlChr Off
_Scrolllock Off
Dim mz(0 To 80, 1 To 25) As String
Dim crnr(4, 2), loot(3), monst(3), mcount, mpos(0, 2), mnd(0, 4)
'mnd(n,1)= asc code, mnd(n,2)= monster toughness  , mnd(n,3)= behavior flag, mn(n,4)= behavior record
loot(1) = 4: loot(2) = 3: loot(3) = 15
monst(1) = 132: monst(2) = 42: monst(3) = 111
crnr(1, 1) = 1: crnr(1, 2) = 1
crnr(2, 1) = 79: crnr(2, 2) = 1
crnr(3, 1) = 1: crnr(3, 2) = 25
crnr(4, 1) = 79: crnr(4, 2) = 25
maxx = 80: maxy = 25: mlevel = 0: mcount = 0
herox = Int(_Width / 2): heroy = Int(_Height / 2)
php = 10: ppow = 0: pgems = 0
newlevel:
mlevel = mlevel + 1
mlabel$ = "MazeRogue Level " + Str$(mlevel)
_Title mlabel$
For y = 1 To maxy
    For x = 0 To maxx
        mz(x, y) = Chr$(219)
    Next
Next
nx = 3: ny = 3: done = 0: mcount = 0
Do While done = 0
    _Limit 1000
    For reps = 0 To 99
        ox = nx: oy = ny
        Rem move in random direction
        Select Case Int(Rnd * 4)
            Case 0
                If nx + 2 <= maxx Then nx = nx + 2
            Case 1
                If ny + 2 <= maxy Then ny = ny + 2
            Case 2
                If nx - 2 > 0 Then nx = nx - 2
            Case 3
                If ny - 2 > 0 Then ny = ny - 2
        End Select
        If mz(nx, ny) = Chr$(219) Then
            mz(nx, ny) = ".": If 1 + Int(Rnd * 50) = 1 Then mz(nx, ny) = Chr$(loot(1 + Int(Rnd * 3)))
            If mz(nx, ny) = "." And 1 + Int(Rnd * 50) <= mlevel Then
                mr = 1 + Int(Rnd * 3): mz(nx, ny) = Chr$(monst(mr)): mcount = mcount + 1
                ReDim _Preserve mpos(mcount, 2)
                ReDim _Preserve mnd(mcount, 4)
                mnd(mcount, 1) = monst(mr): mnd(mcount, 2) = 1 + Int(Rnd * ((4 * mr / 2) + ((mlevel) / 2)))
                mnd(mcount, 3) = 0: mnd(mcount, 4) = 0
                mpos(mcount, 1) = nx: mpos(mcount, 2) = ny
            End If
            mz(Int((nx + ox) / 2), ((ny + oy) / 2)) = "."

        End If
    Next
    done = 1
    For x = 1 To maxx - 1 Step 2
        For y = 1 To maxy - 1 Step 2
            If mz(x, y) = Chr$(219) Then done = 0
        Next y
    Next x
Loop
cr = 1 + Int(Rnd * 4) 'set a corner for the exit
If herox = crnr(cr, 1) And heroy = crnr(cr, 2) Then cr = 5 - cr
mz(crnr(cr, 1), crnr(cr, 2)) = Chr$(239)
T$ = "" 'load the maze into t$
For y = 1 To 25: For x = 0 To 80: T$ = T$ + mz$(x, y): Next x: Next y
ll$ = String$(81, 219) 'top and botton maze display edges becasue I didn't want to fix the maze generator to account for top and bottom edge
lastX = herox: lasty = heroy
Do 'game play loop
    _Limit 20
    Mid$(T$, (heroy) * 81 + herox - 81) = Chr$(1)
    _PrintString (1, 1), ll$: _PrintString (1, 27), ll$: _PrintString (1, 2), T$
    _PrintString (1, 28), String$(80, " ")
    pcc$ = "Hit Points: " + Str$(php) + "  Power: " + Str$(ppow) + "   Gems: " + Str$(pgems)
    _PrintString (3, 28), pcc$
    nk& = 0
    Do: _Limit 60: KH& = _KeyHit: nk& = KH&: Loop Until nk& > 0

    If KH& = 19200 Then herox = herox - 1
    If KH& = 19712 Then herox = herox + 1
    If KH& = 18432 Then heroy = heroy - 1
    If KH& = 20480 Then heroy = heroy + 1
    If herox < 1 Then herox = 1
    If herox > _Width Then herox = _Width
    If heroy < 1 Then heroy = 1
    If heroy > 25 Then heroy = 25
    Mid$(T$, (lasty) * 81 + lastX - 81) = "."
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(219) Then
        herox = lastX: heroy = lasty
    End If
    For lp = 1 To 3
        If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(loot(lp)) Then
            Select Case lp
                Case 1
                    pgems = pgems + 1
                Case 2
                    php = php + 3
                Case 3
                    ppow = ppow + 2
            End Select
        End If
    Next lp
    If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(239) Then
        Beep: Cls: Print: Print "Continue to Next Level ?": Print: Input "Yes or No", ask$
        If Left$(UCase$(ask$), 1) = "N" Then
            heroy = lasty: herox = lastX
        Else
            Cls: GoTo newlevel
        End If
    End If
    If mcount > 0 Then
        For m = 1 To mcount
            If mpos(m, 1) > -1 Then
                mny = mpos(m, 2): mnx = mpos(m, 1)
                Mid$(T$, (mny * 81 + mnx - 81), 1) = "."
                If mnd(m, 3) = 0 Then mact = Int(Rnd * 9) Else mact = mnd(m, 4)
                dth = Sqr((herox - mpos(m, 1)) ^ 2 + (heroy - mpos(m, 2)) ^ 2): If dth < 5 Then mact = Int(Rnd * 4) + 4
                Select Case mact
                    Case 0 'east
                        If Mid$(T$, (mpos(m, 2) * 81 + mpos(m, 1) + 1 - 81), 1) = "." Then mnx = mpos(m, 1) + 1
                    Case 1 'south
                        If Mid$(T$, ((mpos(m, 2) + 1) * 81 + mpos(m, 1) - 81), 1) = "." Then mny = mpos(m, 2) + 1
                    Case 2 'west
                        If Mid$(T$, (mpos(m, 2) * 81 + mpos(m, 1) - 1 - 81), 1) = "." Then mnx = mpos(m, 1) - 1
                    Case 3 'north
                        If Mid$(T$, ((mpos(m, 2) - 1) * 81 + mpos(m, 1) - 81), 1) = "." Then mny = mpos(m, 2) - 1
                    Case 4, 5
                        If heroy = mpos(m, 2) Then
                            If herox < mpos(m, 1) Then
                                If Mid$(T$, (mpos(m, 2) * 81 + mpos(m, 1) - 1 - 81), 1) = "." Then mnx = mpos(m, 1) - 1
                            Else
                                If Mid$(T$, (mpos(m, 2) * 81 + mpos(m, 1) + 1 - 81), 1) = "." Then mnx = mpos(m, 1) + 1
                            End If
                        End If
                    Case 6, 7 ' go player vert
                        If herox = mpos(m, 1) Then
                            If heroy < mpos(m, 2) Then
                                If Mid$(T$, ((mpos(m, 2) - 1) * 81 + mpos(m, 1) - 1 - 81), 1) = "." Then mny = mpos(m, 2) - 1
                            Else
                                If Mid$(T$, ((mpos(m, 2) + 1) * 81 + mpos(m, 1) - 1 - 81), 1) = "." Then mny = mpos(m, 2) + 1
                            End If
                        End If
                    Case 8 ' do nothing
                End Select
                mpos(m, 1) = mnx: mpos(m, 2) = mny
                Mid$(T$, (mpos(m, 2) * 81 + mpos(m, 1) - 81), 1) = Chr$(mnd(m, 1))
                mnd(m, 4) = mact
                If Rnd * 6 < 2 Then mnd(m, 3) = 0 Else mnd(m, 3) = 1
            End If

        Next m
    End If
    lastX = herox: lasty = heroy
    k$ = InKey$
Loop Until k$ = Chr$(27)
System



RE: MazeRogue - SierraKen - 08-22-2024

This is really cool! I have no idea how you even made this. lol Good job!