+- 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)
SystemRE: 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)
SystemI 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)
SystemRE: MazeRogue - SierraKen - 08-22-2024
This is really cool! I have no idea how you even made this. lol Good job!