A QB64 roguelike in 50 lines prettified (now 625 lines)

[madscijr]

Here's a program I came across at nippycodes.com which I cleaned up a little, maybe to expand in the future.
I'm not sure who the original author is, so I just cited the web site.
I thought I would post it as it might help aspiring RPG creators like it helped me.
Enjoy...

Title screen:
 

Gameplay:
 

Code:

Code: QB64: [Select]

1. ' #############################################################################
2. ' This game is from:
3. '
4. '     A QB64 roguelike in 50 lines
5. '     https://nippycodes.com/coding/a-qb64-roguelike-in-50-lines/
6. '
7. ' cleaned up and made prettier.
8.  
9. ' ================================================================================================================================================================
10. ' NOTES
11. ' ================================================================================================================================================================
12. ' The CSRLIN function returns the current text row position of the PRINT cursor.
13. ' The POS function returns the current print cursor text column position.
14. ' The SCREEN function returns the ASCII code of a text character or the color attribute at a set text location on the screen.
15. ' codeorcolor% = SCREEN (row%, column% [, colorflag%])
16. ' row and column are the INTEGER text coordinates of the SCREEN mode used.
17. ' Optional colorflag INTEGER value can be omitted or 0 for ASCII code values or 1 for color attributes.
18.  
19. ' ================================================================================================================================================================
20. ' TO DO
21. ' ================================================================================================================================================================
22. ' Code improvements:
23. ' * Remove GOTO statements and make code more modular.
24. ' * Store terrain, players, objects, etc. in different arrays/layers for more complex interaction
25. ' * Include a level editor (not just random levels).
26. ' * Add combat and RPG features similar to Ultima 1-5
27. ' * Quests
28. ' * Towns, Castles, etc.
29.  
30. ' Weapons:
31. ' * Hands & Feet (default)
32. ' * Club
33. ' * Mace
34. ' * Staff
35. ' * Dagger
36. ' * Sword
37. ' * Great Sword
38. ' * Spear
39. ' * Bow / Arrow - player needs to find arrows
40. ' * Sling - unlimited stones, can buy lead sling bullets for more damage
41.  
42. ' Armor:
43. ' * Skin (default)
44. ' * Cloth
45. ' * Leather
46. ' * Chain Mail
47. ' * Plate
48.  
49. ' Armor (shields):
50. ' * Leather Shield
51. ' * Wood Shield
52. ' * Small Metal Shield
53. ' * Great Shield
54.  
55. ' Objects:
56. ' * Healing Potion - restore HP
57. ' * Torches - allow player to see in dark areas
58.  
59. ' Stats:
60. ' * Food - decreases every n turns, if out of food player starves (loses HP)
61. ' * Max HP - increases with higher levels
62.  
63. ' Attributes that affect combat, etc.:
64. ' * Strength
65. ' * Agility
66. ' * Stamina
67. ' * Intelligence
68. ' * Wisdom
69. ' * Charisma
70. ' * weapon attack skill (increases per weapon type as you use it)
71. ' * weapon defense skill (increases per weapon each time you fight someone with it)
72.  
73. ' Magic:
74. ' ???
75.  
76. ' Monsters / NPCs:
77. ' * different races
78. ' * have their own inventory of items, food, etc.
79. ' * have different HP, attributes, etc.
80. ' * can be interacted with or yell things
81.  
82. ' Map:
83. ' * include screens that are towns, not just random dungeons
84.  
85. ' Store:
86. ' * buy weapons/armor/food/healing
87. ' * located in certain "civilized" areas
88.  
89. ' ================================================================================================================================================================
90. ' OPTIONS
91. ' ================================================================================================================================================================
92. Option _Explicit
93.  
94. ' ================================================================================================================================================================
95. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
96. ' ================================================================================================================================================================
97. Const FALSE = 0
98. Const TRUE = Not FALSE
99.  
100. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
101. ' UDFs
102. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
103. Type PlayerType
104.     X As Integer
105.     Y As Integer
106.    
107.     ' NEW:
108.     Items As String
109.     HP As Integer
110.     XP As Integer
111.     Level As Integer
112.     Gold As Integer
113. End Type ' PlayerType
114.  
115. Dim ProgramPath$
116. Dim ProgramName$
117.  
118. ' =============================================================================
119. ' INITIALIZE
120. ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
121. ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
122.  
123. ' =============================================================================
124. ' RUN THE MAIN PROGRAM
125. main ProgramName$
126.  
127. ' =============================================================================
128. ' FINISH
129. System ' return control to the operating system
130. Print ProgramName$ + " finished."
131. End
132.  
133. ' /////////////////////////////////////////////////////////////////////////////
134.  
135. Sub main (ProgName$)
136.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
137.     ' VARIABLES
138.     Dim iLoop As Integer
139.     Dim K$
140.    
141.     Dim iNewCol As Integer
142.     Dim iNewRow As Integer
143.     Dim iPosX As Integer
144.     Dim iPosY As Integer
145.     Dim x%
146.     Dim y%
147.     Dim c%
148.     Dim bNewCave As Integer
149.    
150.     Dim bMonsterPlaced As Integer
151.     Dim arrGuy(16) As PlayerType
152.    
153.     Dim in$
154.    
155.    
156.    
157.     ' ================================================================================================================================================================
158.     ' SHOW INSTRUCTIONS
159.     Cls
160.     color cPeriwinkle&: Print "-------------------------------------------------------------------------------"
161.     color cLtGreen&: Print "Rogue 50"
162.     color cCyan&: Print "(a simple game based on " + chr$(34) + "A QB64 roguelike in 50 lines" + chr$(34) + " from nippycodes.com)"    
163.     color cPeriwinkle&: Print "-------------------------------------------------------------------------------"
164.     color cCyan&: Print "You are the adventurer........";: color cWhite&: Print "@"
165.     color cCyan&: Print "Travel through the caves......";: color cGray&: Print "#"
166.     color cCyan&: Print "Collect the treasure..........";: color cYellow&: Print "*"
167.     color cCyan&: Print "And avoid the monsters........";: color cGreen&: Print "A"
168.     color cCyan&: Print "Find doors to the next cave...";: color cLtGray&: Print "%"
169.     color cCyan&: Print
170.     color cCyan&: Print "If you touch a monster you will battle,"
171.     color cCyan&: Print "and lose hit points but gain experience."
172.     color cCyan&: Print
173.     color cCyan&: Print "CONTROLS:"
174.     color cCyan&: Print "Use the arrow keys to move around."
175.     color cCyan&: Print "Press the ESC key when you want to quit."
176.     color cCyan&: Print
177.     color cCyan&: Input "Press ENTER to continue"; in$
178.  
179.     ' ================================================================================================================================================================
180.     ' START NEW GAME
181.     ' ================================================================================================================================================================
182.  
183.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
184.     NewGame:
185.    
186.     Screen 0
187.     Randomize Timer
188.     Width 80, 60
189.     arrGuy(0).Gold = 0
190.     arrGuy(0).HP = 100
191.     arrGuy(0).XP = 0
192.     arrGuy(0).Level = 1
193.     '_FullScreen
194.    
195.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
196.     NewLevel:
197.     Cls
198.     bNewCave = FALSE
199.     arrGuy(0).X = 40
200.     arrGuy(0).Y = 30
201.    
202.     ' DRAW BORDERS
203.     For iPosX = 2 To 79
204.         For iPosY = 2 To 59
205.             color cGray&
206.             Locate iPosY, iPosX
207.             Print "#";
208.         Next iPosY
209.     Next iPosX
210.    
211.     ' EMPTY OUT INSIDE
212.     For iPosX = 5 To 76
213.         For iPosY = 5 To 56
214.             color cGray&
215.             Locate iPosY, iPosX
216.             Print ".";
217.         Next iPosY
218.     Next iPosX
219.    
220.     ' CREATE RANDOM WALLS
221.     For iLoop = 0 To (80 * 60 / 8)
222.         'color cGray&
223.         'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
224.         'Print "#";
225.         x% = Int(72 * Rnd + 5)
226.         y% = Int(52 * Rnd + 5)
227.         PutCharXY x%, y%, "#", cGray&
228.     Next iLoop
229.    
230.     ' SHOW PROGRESS
231.     Locate 1, 40
232.     Print "Step 1+" + cstr$(iLoop) + "    ";
233.    
234.     ' DROP RANDOM STUFF
235.     For iLoop = 1 To 5
236.         For iPosX = 5 To 75
237.             For iPosY = 5 To 55
238.                 ' DRAW WALL
239.                 If Rnd < .15 And (Screen(iPosY - 1, iPosX) = 35 Or Screen(iPosY + 1, iPosX) = 35 Or Screen(iPosY, iPosX + 1) = 35 Or Screen(iPosY, iPosX - 1) = 35) Then
240.                     'color cGray&
241.                     'Locate iPosY, iPosX
242.                     'Print "#";
243.                     PutCharXY iPosX, iPosY, "#", cGray&
244.                 End If
245.                
246.                 ' DRAW EMPTY
247.                 If Screen(iPosY, iPosX) = 35 And (Screen(iPosY - 1, iPosX) = 46 And Screen(iPosY + 1, iPosX) = 46 And Screen(iPosY, iPosX + 1) = 46 And Screen(iPosY, iPosX - 1) = 46) Then
248.                     'color cGray&
249.                     'Locate iPosY, iPosX
250.                     'Print ".";
251.                     PutCharXY iPosX, iPosY, ".", cGray&
252.                 End If
253.                
254.                 ' DRAW TREASURE
255.                 If Rnd < .005 And Screen(iPosY, iPosX) = 46 Then
256.                     'color cYellow&
257.                     'Locate iPosY, iPosX
258.                     'Print "*";
259.                     PutCharXY iPosX, iPosY, "*", cYellow&
260.                 End If
261.                
262.                 ' DRAW EXIT
263.                 If Rnd < .001 And Screen(iPosY, iPosX) = 46 Then
264.                     'color cWhite&
265.                     'Locate iPosY, iPosX
266.                     'Print "%";
267.                     PutCharXY iPosX, iPosY, "%", cWhite&
268.                 End If
269.                
270.             Next iPosY
271.         Next iPosX
272.        
273.         ' SHOW PROGRESS
274.         Locate 1, 40
275.         Print "Step 2+" + cstr$(iLoop) + "    ";
276.        
277.     Next iLoop
278.    
279.     ' CLEAR SOME SPACE AROUND PLAYER
280.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y - 1, ".", cGray&
281.     PutCharXY arrGuy(0).X + 0, arrGuy(0).Y - 1, ".", cGray&
282.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y - 1, ".", cGray&
283.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y + 0, ".", cGray&
284.     'PutCharXY arrGuy(0).X + 0, arrGuy(0).Y + 0, ".", cGray&
285.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y + 0, ".", cGray&
286.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y + 1, ".", cGray&
287.     PutCharXY arrGuy(0).X + 0, arrGuy(0).Y + 1, ".", cGray&
288.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y + 1, ".", cGray&
289.    
290.     ' PLACE MONSTERS
291.     For iLoop = 1 To 15
292.         bMonsterPlaced = FALSE
293.         Do
294.             '' Locate Y, X sets the current print position
295.             'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
296.             x% = Int(72 * Rnd + 5)
297.             y% = Int(52 * Rnd + 5)
298.            
299.             '' Screen(CsrLin, Pos(0)) returns the character code at the current print position
300.             'If Screen(CsrLin, Pos(0)) = 46 Then
301.             If GetCharXY%(x%, y%) = 46 Then
302.                 arrGuy(iLoop).X = x% ' Pos(0)
303.                 arrGuy(iLoop).Y = y% ' CsrLin
304.                 bMonsterPlaced = TRUE
305.             End If
306.         Loop Until bMonsterPlaced = TRUE
307.     Next iLoop
308.    
309.     ' MAIN GAME LOOP
310.     _Display
311.     Do
312.         ' GET KEYBOARD INPUT
313.         K$ = InKey$
314.        
315.         ' DRAW PLAYER
316.         'color cLtGray&
317.         'Locate arrGuy(0).Y, arrGuy(0).X
318.         'Print "@";
319.         PutCharXY arrGuy(0).X, arrGuy(0).Y, "@", cLtGray&
320.        
321.         ' WRITE SCORE + STATS
322.         color cWhite&
323.         Locate 1, 1
324.         Print "Gold:"; arrGuy(0).Gold, "HP:"; arrGuy(0).HP, "Exp:"; arrGuy(0).XP; "/"; (4 + arrGuy(0).Level * 2), "Level:"; arrGuy(0).Level;
325.        
326.         ' WRITE INSTRUCTIONS
327.         color cWhite&
328.         Locate 60, 1
329.         Print "Arrows = Move", , "t = Teleport (-5HP on failure)";
330.        
331.         ' MOVE MONSTERS
332.         For iLoop = 1 To 15
333.             If arrGuy(0).XP >= (4 + arrGuy(0).Level * 2) Then
334.                 arrGuy(0).XP = arrGuy(0).XP - (4 + arrGuy(0).Level * 2)
335.                 arrGuy(0).Level = arrGuy(0).Level + 1
336.                 arrGuy(0).HP = arrGuy(0).HP + (arrGuy(0).Level * 5)
337.             End If
338.            
339.             If arrGuy(iLoop).X <> -1 And Rnd < .75 Then
340.                 'color cGray&
341.                 'Locate arrGuy(iLoop).Y, arrGuy(iLoop).X
342.                 'Print ".";
343.                 PutCharXY arrGuy(iLoop).X, arrGuy(iLoop).Y, ".", cGray&
344.                
345.                 If arrGuy(iLoop).X < arrGuy(0).X And Screen(arrGuy(iLoop).Y, arrGuy(iLoop).X + 1) = 46 Then
346.                     arrGuy(iLoop).X = arrGuy(iLoop).X + 1
347.                 End If
348.                
349.                 If arrGuy(iLoop).X > arrGuy(0).X And Screen(arrGuy(iLoop).Y, arrGuy(iLoop).X - 1) = 46 Then
350.                     arrGuy(iLoop).X = arrGuy(iLoop).X - 1
351.                 End If
352.                
353.                 If arrGuy(iLoop).Y < arrGuy(0).Y And Screen(arrGuy(iLoop).Y + 1, arrGuy(iLoop).X) = 46 Then
354.                     arrGuy(iLoop).Y = arrGuy(iLoop).Y + 1
355.                 End If
356.                
357.                 If arrGuy(iLoop).Y > arrGuy(0).Y And Screen(arrGuy(iLoop).Y - 1, arrGuy(iLoop).X) = 46 Then
358.                     arrGuy(iLoop).Y = arrGuy(iLoop).Y - 1
359.                 End If
360.                
361.                 'color cGreen&
362.                 'Locate arrGuy(iLoop).Y, arrGuy(iLoop).X
363.                 'Print Chr$(142);
364.                 PutCharXY arrGuy(iLoop).X, arrGuy(iLoop).Y, Chr$(142), cGreen&
365.                
366.             End If
367.         Next iLoop
368.        
369.         _Display
370.        
371.        
372.         ' ERASE OLD POSITION
373.         'color cGray&
374.         'Locate arrGuy(0).Y, arrGuy(0).X
375.         'Print ".";
376.         PutCharXY arrGuy(0).X, arrGuy(0).Y, ".", cGray&
377.        
378.         ' SET NEXT POSITION = CURRENT
379.         iNewCol = arrGuy(0).X
380.         iNewRow = arrGuy(0).Y
381.        
382.         ' GET INPUT
383.         K$ = GetKey$
384.        
385.         ' PROCESS INPUT
386.         If K$ = Chr$(0) + "K" Then iNewCol = arrGuy(0).X - 1
387.         If K$ = Chr$(0) + "M" Then iNewCol = arrGuy(0).X + 1
388.         If K$ = Chr$(0) + "P" Then iNewRow = arrGuy(0).Y + 1
389.         If K$ = Chr$(0) + "H" Then iNewRow = arrGuy(0).Y - 1
390.        
391.         ' TELEPORT TO A RANDOM LOCATION
392.         If K$ = "t" Then
393.             'color cWhite&
394.             'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
395.             'iNewCol = Pos(0)
396.             'iNewRow = CsrLin
397.             iNewCol = Int(72 * Rnd + 5)
398.             iNewRow = Int(52 * Rnd + 5)
399.             c% = GetCharXY%(iNewCol, iNewRow)
400.            
401.             ' IF YOU LAND ON NON-BLANK SPACE, LOSE HIT POINTS
402.             'If Screen(CsrLin, Pos(0)) <> 46 Then
403.             If c% <> 46 Then
404.                 arrGuy(0).HP = arrGuy(0).HP - 5
405.             End If
406.         End If
407.        
408.         ' ATTACK MONSTER
409.         'If Screen(iNewRow, iNewCol) = 142 Then
410.         If GetCharXY%(iNewCol, iNewRow) = 142 Then
411.            
412.             ' GET EXPERIENCE
413.             arrGuy(0).XP = arrGuy(0).XP + 1
414.            
415.             ' SUSTAIN DAMAGE
416.             If Rnd > arrGuy(0).Level * .02 Then
417.                 arrGuy(0).HP = arrGuy(0).HP - Int(20 * Rnd + arrGuy(0).Level)
418.             End If
419.            
420.             ' ERASE OLD LOCATION
421.             'color cGray&
422.             'Locate iNewRow, iNewCol
423.             'Print ".";
424.             PutCharXY iNewCol, iNewRow, ".", cGray&
425.            
426.             ' DID MONSTERS REACH PLAYER?
427.             For iLoop = 1 To 15
428.                 If arrGuy(iLoop).X = iNewCol And arrGuy(iLoop).Y = iNewRow Then
429.                     ' NOT SURE WHAT THIS IS FOR
430.                     arrGuy(iLoop).X = -1
431.                 End If
432.             Next iLoop
433.         End If
434.        
435.         ' PICK UP GOLD
436.         If Screen(iNewRow, iNewCol) = 42 Then
437.             arrGuy(0).Gold = arrGuy(0).Gold + Int((15 * Rnd + 1) * Rnd + 1)
438.             'color cGray&
439.             'Locate iNewRow, iNewCol
440.             'Print ".";
441.             PutCharXY iNewCol, iNewRow, ".", cGray&
442.         End If
443.        
444.         ' EXIT CAVE
445.         If Screen(iNewRow, iNewCol) = 37 Then
446.             arrGuy(0).XP = arrGuy(0).XP + 5
447.             bNewCave = TRUE
448.             'color cGray&
449.             'Locate iNewRow, iNewCol
450.             'Print ".";
451.             PutCharXY iNewCol, iNewRow, ".", cGray&
452.         End If
453.        
454.         ' MOVE TO EMPTY SPACE
455.         If Screen(iNewRow, iNewCol) = 46 Then
456.             arrGuy(0).X = iNewCol
457.             arrGuy(0).Y = iNewRow
458.         Else
459.             iNewRow = arrGuy(0).Y
460.             iNewCol = arrGuy(0).X
461.         End If
462.        
463.         ' KEEP GOING UNTIL QUIT (HIT ESC), OR DEAD, OR NEW CAVE
464.     Loop While (K$ <> Chr$(27)) And arrGuy(0).HP > 0 And bNewCave = FALSE
465.    
466.     ' ================================================================================================================================================================
467.     ' IS PLAYER DEAD?
468.     If arrGuy(0).HP <= 0 Then
469.         ' GAME OVER MAN
470.         color cLtRed&
471.         Locate 29, 31
472.         Print "--== Game Over! ==--"
473.     End If
474.  
475.     ' ================================================================================================================================================================
476.     ' NEW CAVE
477.     If bNewCave = TRUE Then
478.         ' NEXT CAVE
479.         color cPeriwinkle&
480.         Locate 30, 35
481.         Print "Next Cave!";
482.        
483.         _Display
484.         'KEYDELAY 0
485.         GoTo NewLevel
486.     End If
487.    
488.     ' ================================================================================================================================================================
489.     ' GAME OVER
490.    
491.     ' PLAY AGAIN?
492.     color cWhite&
493.     Locate 30, 33
494.     Print "Play Again?(y/n)"
495.     _Display
496.    
497.     K$ = YesOrNo$
498.     If K$ = "y" Then
499.         GoTo NewGame
500.     End If
501.    
502. end sub ' Main
503.  
504. ' /////////////////////////////////////////////////////////////////////////////
505. ' Convert a value to string and trim it (because normal Str$ adds spaces)
506.  
507. Function cstr$ (myValue)
508.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
509.     cstr$ = _Trim$(Str$(myValue))
510. End Function ' cstr$
511.  
512. ' /////////////////////////////////////////////////////////////////////////////
513.  
514. Function GetCharXY%(x%, y%)
515.     'Locate y%, x%
516.     'GetCharXY% = Screen(CsrLin, Pos(0))
517.     GetCharXY% = SCREEN(y%, x%, 0)     ' character code return parameter 0
518. End Function ' GetCharXY%
519.  
520. ' /////////////////////////////////////////////////////////////////////////////
521.  
522. Function GetColorXY&(x%, y%)
523.     GetColorXY& = SCREEN(y%, x%, 1)   ' character color return parameter 1
524. End Function ' GetColorXY
525.  
526. ' /////////////////////////////////////////////////////////////////////////////
527.  
528. Sub PutCharXY(x%, y%, char$, myColor&)
529.     color myColor&
530.     Locate y%, x%
531.     Print char$;
532. End Sub ' PutCharXY
533.  
534. ' /////////////////////////////////////////////////////////////////////////////
535.  
536. Function GetKey$
537.     DIM K$
538.     K$ = ""
539.     Do
540.         K$ = InKey$
541.     Loop While K$ = ""
542.     GetKey$ = K$
543. End Sub ' GetKey$
544.  
545. ' /////////////////////////////////////////////////////////////////////////////
546.  
547. Function YesOrNo$
548.     Dim K$
549.     Dim bFinished%
550.    
551.     bFinished% = FALSE
552.     Do
553.         K$ = lcase$(InKey$)
554.         If K$ = "y" Or K$ = "n" Then
555.             bFinished% = TRUE
556.         End If
557.     Loop While bFinished% = FALSE
558.    
559.     YesOrNo$ = K$
560. End Function ' YesOrNo$
561.  
562. ' /////////////////////////////////////////////////////////////////////////////
563.  
564. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
565. ' COLOR CODE FUNCTIONS
566. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
567. Function cBlue&
568.     cBlue& = 1
569. End Function
570.  
571. Function cGreen&
572.     cGreen& = 2
573. End Function
574.  
575. Function cLtBlue&
576.     cLtBlue& = 3
577. End Function
578.  
579. Function cRed&
580.     cRed& = 4
581. End Function
582.  
583. Function cPurple&
584.     cPurple& = 5
585. End Function
586.  
587. Function cOrange&
588.     cOrange& = 6
589. End Function
590.  
591. Function cWhite&
592.     cWhite& = 7
593. End Function
594.  
595. Function cGray&
596.     cGray& = 8
597. End Function
598.  
599. Function cPeriwinkle&
600.     cPeriwinkle& = 9
601. End Function
602.  
603. Function cLtGreen&
604.     cLtGreen& = 10
605. End Function
606.  
607. Function cCyan&
608.     cCyan& = 11
609. End Function
610.  
611. Function cLtRed&
612.     cLtRed& = 12
613. End Function
614.  
615. Function cPink&
616.     cPink& = 13
617. End Function
618.  
619. Function cYellow&
620.     cYellow& = 14
621. End Function
622.  
623. Function cLtGray&
624.     cLtGray& = 15
625. End Function
626.  

[xra7en]

amazing!
Love anything DOS, which is why I love QB64!

Might have to play this. looks fun..
One thing you might wanna try it give your adventurer a light source and have him travel the map with just a circle of light, everything else is black!

[TempodiBasic]

Cool!
... mmmh but where is the sound /music?
Waiting weapons to fight with monsters...

[madscijr]

amazing!
Love anything DOS, which is why I love QB64!

Might have to play this. looks fun..
One thing you might wanna try it give your adventurer a light source and have him travel the map with just a circle of light, everything else is black!

I made a list of possible future enhancements, the light idea is in there (see torch)!

[madscijr]

Cool!
... mmmh but where is the sound /music?
Waiting weapons to fight with monsters...

As is, this was just the program as I found it, I just made the code easier to read. Sound effects & music, is a great idea, I just haven't added any mods. The farthest I got was listing some features I think it needs, sounds & music definitely belongs in there!

Note the code from my post here is my attempt at an RPG engine, where I am adapting this game with sounds and tile graphics:
https://www.qb64.org/forum/index.php?topic=3949.0

The thing is, it's a huge beast of a program with all those features, so I figured I'd post this much smaller one which is probably easier for people to digest :-)

[Caligari87]

Here's a program I came across at nippycodes.com which I cleaned up a little, maybe to expand in the future.
I'm not sure who the original author is, so I just cited the web site.

Hello! I know this is a fair few months bump but I wanted to comment that this was me!

Code: QB64: [Select]

1. https://web.archive.org/web/20130410123327/www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=10791.0

archive.org cache of original topic

Not sure how it ended up on nippycodes, but I'm glad someone's getting some mileage out of it. I'd be interested to see what else you've done with it in the meantime.

[Petr]

@madscijr

Text mode is really not limitation for your game. I wrote small ugrade (in text mode) and if you now use fullscreen (for better view), your character @ is displayed in circle now. QB64 occurs really many options.

Code: QB64: [Select]

1. 'Petr's modifications: Add TextCirlce& function [create hardware circle image],
2. '                      Rows:  127, 128, 161, 330, 331, 382
3.  
4.  
5. ' #############################################################################
6. ' This game is from:
7. '
8. '     A QB64 roguelike in 50 lines
9. '     https://nippycodes.com/coding/a-qb64-roguelike-in-50-lines/
10. '
11. ' cleaned up and made prettier.
12.  
13. ' ================================================================================================================================================================
14. ' NOTES
15. ' ================================================================================================================================================================
16. ' The CSRLIN function returns the current text row position of the PRINT cursor.
17. ' The POS function returns the current print cursor text column position.
18. ' The SCREEN function returns the ASCII code of a text character or the color attribute at a set text location on the screen.
19. ' codeorcolor% = SCREEN (row%, column% [, colorflag%])
20. ' row and column are the INTEGER text coordinates of the SCREEN mode used.
21. ' Optional colorflag INTEGER value can be omitted or 0 for ASCII code values or 1 for color attributes.
22.  
23. ' ================================================================================================================================================================
24. ' TO DO
25. ' ================================================================================================================================================================
26. ' Code improvements:
27. ' * Remove GOTO statements and make code more modular.
28. ' * Store terrain, players, objects, etc. in different arrays/layers for more complex interaction
29. ' * Include a level editor (not just random levels).
30. ' * Add combat and RPG features similar to Ultima 1-5
31. ' * Quests
32. ' * Towns, Castles, etc.
33.  
34. ' Weapons:
35. ' * Hands & Feet (default)
36. ' * Club
37. ' * Mace
38. ' * Staff
39. ' * Dagger
40. ' * Sword
41. ' * Great Sword
42. ' * Spear
43. ' * Bow / Arrow - player needs to find arrows
44. ' * Sling - unlimited stones, can buy lead sling bullets for more damage
45.  
46. ' Armor:
47. ' * Skin (default)
48. ' * Cloth
49. ' * Leather
50. ' * Chain Mail
51. ' * Plate
52.  
53. ' Armor (shields):
54. ' * Leather Shield
55. ' * Wood Shield
56. ' * Small Metal Shield
57. ' * Great Shield
58.  
59. ' Objects:
60. ' * Healing Potion - restore HP
61. ' * Torches - allow player to see in dark areas
62.  
63. ' Stats:
64. ' * Food - decreases every n turns, if out of food player starves (loses HP)
65. ' * Max HP - increases with higher levels
66.  
67. ' Attributes that affect combat, etc.:
68. ' * Strength
69. ' * Agility
70. ' * Stamina
71. ' * Intelligence
72. ' * Wisdom
73. ' * Charisma
74. ' * weapon attack skill (increases per weapon type as you use it)
75. ' * weapon defense skill (increases per weapon each time you fight someone with it)
76.  
77. ' Magic:
78. ' ???
79.  
80. ' Monsters / NPCs:
81. ' * different races
82. ' * have their own inventory of items, food, etc.
83. ' * have different HP, attributes, etc.
84. ' * can be interacted with or yell things
85.  
86. ' Map:
87. ' * include screens that are towns, not just random dungeons
88.  
89. ' Store:
90. ' * buy weapons/armor/food/healing
91. ' * located in certain "civilized" areas
92.  
93. ' ================================================================================================================================================================
94. ' OPTIONS
95. ' ================================================================================================================================================================
96. OPTION _EXPLICIT
97.  
98. ' ================================================================================================================================================================
99. ' GLOBAL DECLARATIONS a$=string, i%=integer, L&=long, s!=single, d#=double
100. ' ================================================================================================================================================================
101. CONST FALSE = 0
102. CONST TRUE = NOT FALSE
103.  
104. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
105. ' UDFs
106. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
107. TYPE PlayerType
108.     X AS INTEGER
109.     Y AS INTEGER
110.  
111.     ' NEW:
112.     Items AS STRING
113.     HP AS INTEGER
114.     XP AS INTEGER
115.     Level AS INTEGER
116.     Gold AS INTEGER
117. END TYPE ' PlayerType
118.  
119. DIM ProgramPath$
120. DIM ProgramName$
121.  
122. ' =============================================================================
123. ' INITIALIZE
124. ProgramName$ = MID$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\") + 1)
125. ProgramPath$ = LEFT$(COMMAND$(0), _INSTRREV(COMMAND$(0), "\"))
126.  
127. DIM SHARED DC&
128. DC& = TextCircle&
129.  
130. ' =============================================================================
131. ' RUN THE MAIN PROGRAM
132. main ProgramName$
133.  
134. ' =============================================================================
135. ' FINISH
136. SYSTEM ' return control to the operating system
137. PRINT ProgramName$ + " finished."
138. END
139.  
140. ' /////////////////////////////////////////////////////////////////////////////
141.  
142. SUB main (ProgName$)
143.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
144.     ' VARIABLES
145.     DIM iLoop AS INTEGER
146.     DIM K$
147.  
148.     DIM iNewCol AS INTEGER
149.     DIM iNewRow AS INTEGER
150.     DIM iPosX AS INTEGER
151.     DIM iPosY AS INTEGER
152.     DIM x%
153.     DIM y%
154.     DIM c%
155.     DIM bNewCave AS INTEGER
156.  
157.     DIM bMonsterPlaced AS INTEGER
158.     DIM arrGuy(16) AS PlayerType
159.  
160.     DIM in$
161.     DIM gPosX AS INTEGER, gPosY AS INTEGER
162.  
163.  
164.  
165.     ' ================================================================================================================================================================
166.     ' SHOW INSTRUCTIONS
167.     CLS
168.     COLOR cPeriwinkle&: PRINT "-------------------------------------------------------------------------------"
169.     COLOR cLtGreen&: PRINT "Rogue 50"
170.     COLOR cCyan&: PRINT "(a simple game based on " + CHR$(34) + "A QB64 roguelike in 50 lines" + CHR$(34) + " from nippycodes.com)"
171.     COLOR cPeriwinkle&: PRINT "-------------------------------------------------------------------------------"
172.     COLOR cCyan&: PRINT "You are the adventurer........";: COLOR cWhite&: PRINT "@"
173.     COLOR cCyan&: PRINT "Travel through the caves......";: COLOR cGray&: PRINT "#"
174.     COLOR cCyan&: PRINT "Collect the treasure..........";: COLOR cYellow&: PRINT "*"
175.     COLOR cCyan&: PRINT "And avoid the monsters........";: COLOR cGreen&: PRINT "A"
176.     COLOR cCyan&: PRINT "Find doors to the next cave...";: COLOR cLtGray&: PRINT "%"
177.     COLOR cCyan&: PRINT
178.     COLOR cCyan&: PRINT "If you touch a monster you will battle,"
179.     COLOR cCyan&: PRINT "and lose hit points but gain experience."
180.     COLOR cCyan&: PRINT
181.     COLOR cCyan&: PRINT "CONTROLS:"
182.     COLOR cCyan&: PRINT "Use the arrow keys to move around."
183.     COLOR cCyan&: PRINT "Press the ESC key when you want to quit."
184.     COLOR cCyan&: PRINT
185.     COLOR cCyan&: INPUT "Press ENTER to continue"; in$
186.  
187.     ' ================================================================================================================================================================
188.     ' START NEW GAME
189.     ' ================================================================================================================================================================
190.  
191.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
192.     NewGame:
193.  
194.     SCREEN 0
195.     RANDOMIZE TIMER
196.     WIDTH 80, 60
197.     arrGuy(0).Gold = 0
198.     arrGuy(0).HP = 100
199.     arrGuy(0).XP = 0
200.     arrGuy(0).Level = 1
201.     '_FullScreen
202.  
203.     ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
204.     NewLevel:
205.     CLS
206.     bNewCave = FALSE
207.     arrGuy(0).X = 40
208.     arrGuy(0).Y = 30
209.  
210.     ' DRAW BORDERS
211.     FOR iPosX = 2 TO 79
212.         FOR iPosY = 2 TO 59
213.             COLOR cGray&
214.             LOCATE iPosY, iPosX
215.             PRINT "#";
216.         NEXT iPosY
217.     NEXT iPosX
218.  
219.     ' EMPTY OUT INSIDE
220.     FOR iPosX = 5 TO 76
221.         FOR iPosY = 5 TO 56
222.             COLOR cGray&
223.             LOCATE iPosY, iPosX
224.             PRINT ".";
225.         NEXT iPosY
226.     NEXT iPosX
227.  
228.     ' CREATE RANDOM WALLS
229.     FOR iLoop = 0 TO (80 * 60 / 8)
230.         'color cGray&
231.         'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
232.         'Print "#";
233.         x% = INT(72 * RND + 5)
234.         y% = INT(52 * RND + 5)
235.         PutCharXY x%, y%, "#", cGray&
236.     NEXT iLoop
237.  
238.     ' SHOW PROGRESS
239.     LOCATE 1, 40
240.     PRINT "Step 1+" + cstr$(iLoop) + "    ";
241.  
242.     ' DROP RANDOM STUFF
243.     FOR iLoop = 1 TO 5
244.         FOR iPosX = 5 TO 75
245.             FOR iPosY = 5 TO 55
246.                 ' DRAW WALL
247.                 IF RND < .15 AND (SCREEN(iPosY - 1, iPosX) = 35 OR SCREEN(iPosY + 1, iPosX) = 35 OR SCREEN(iPosY, iPosX + 1) = 35 OR SCREEN(iPosY, iPosX - 1) = 35) THEN
248.                     'color cGray&
249.                     'Locate iPosY, iPosX
250.                     'Print "#";
251.                     PutCharXY iPosX, iPosY, "#", cGray&
252.                 END IF
253.  
254.                 ' DRAW EMPTY
255.                 IF SCREEN(iPosY, iPosX) = 35 AND (SCREEN(iPosY - 1, iPosX) = 46 AND SCREEN(iPosY + 1, iPosX) = 46 AND SCREEN(iPosY, iPosX + 1) = 46 AND SCREEN(iPosY, iPosX - 1) = 46) THEN
256.                     'color cGray&
257.                     'Locate iPosY, iPosX
258.                     'Print ".";
259.                     PutCharXY iPosX, iPosY, ".", cGray&
260.                 END IF
261.  
262.                 ' DRAW TREASURE
263.                 IF RND < .005 AND SCREEN(iPosY, iPosX) = 46 THEN
264.                     'color cYellow&
265.                     'Locate iPosY, iPosX
266.                     'Print "*";
267.                     PutCharXY iPosX, iPosY, "*", cYellow&
268.                 END IF
269.  
270.                 ' DRAW EXIT
271.                 IF RND < .001 AND SCREEN(iPosY, iPosX) = 46 THEN
272.                     'color cWhite&
273.                     'Locate iPosY, iPosX
274.                     'Print "%";
275.                     PutCharXY iPosX, iPosY, "%", cWhite&
276.                 END IF
277.  
278.             NEXT iPosY
279.         NEXT iPosX
280.  
281.         ' SHOW PROGRESS
282.         LOCATE 1, 40
283.         PRINT "Step 2+" + cstr$(iLoop) + "    ";
284.  
285.     NEXT iLoop
286.  
287.     ' CLEAR SOME SPACE AROUND PLAYER
288.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y - 1, ".", cGray&
289.     PutCharXY arrGuy(0).X + 0, arrGuy(0).Y - 1, ".", cGray&
290.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y - 1, ".", cGray&
291.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y + 0, ".", cGray&
292.     'PutCharXY arrGuy(0).X + 0, arrGuy(0).Y + 0, ".", cGray&
293.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y + 0, ".", cGray&
294.     PutCharXY arrGuy(0).X - 1, arrGuy(0).Y + 1, ".", cGray&
295.     PutCharXY arrGuy(0).X + 0, arrGuy(0).Y + 1, ".", cGray&
296.     PutCharXY arrGuy(0).X + 1, arrGuy(0).Y + 1, ".", cGray&
297.  
298.     ' PLACE MONSTERS
299.     FOR iLoop = 1 TO 15
300.         bMonsterPlaced = FALSE
301.         DO
302.             '' Locate Y, X sets the current print position
303.             'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
304.             x% = INT(72 * RND + 5)
305.             y% = INT(52 * RND + 5)
306.  
307.             '' Screen(CsrLin, Pos(0)) returns the character code at the current print position
308.             'If Screen(CsrLin, Pos(0)) = 46 Then
309.             IF GetCharXY%(x%, y%) = 46 THEN
310.                 arrGuy(iLoop).X = x% ' Pos(0)
311.                 arrGuy(iLoop).Y = y% ' CsrLin
312.                 bMonsterPlaced = TRUE
313.             END IF
314.         LOOP UNTIL bMonsterPlaced = TRUE
315.     NEXT iLoop
316.  
317.     ' MAIN GAME LOOP
318.     _DISPLAY
319.  
320.     DO
321.         ' GET KEYBOARD INPUT
322.         K$ = INKEY$
323.  
324.         ' DRAW PLAYER
325.         'color cLtGray&
326.         'Locate arrGuy(0).Y, arrGuy(0).X
327.         'Print "@";
328.         PutCharXY arrGuy(0).X, arrGuy(0).Y, "@", cLtGray&
329.  
330.         gPosX = arrGuy(0).X * 8 - 12 '-12 is for center image to text coordinate
331.         gPosY = arrGuy(0).Y * 8 - 12
332.  
333.  
334.         ' WRITE SCORE + STATS
335.         COLOR cWhite&
336.         LOCATE 1, 1
337.         PRINT "Gold:"; arrGuy(0).Gold, "HP:"; arrGuy(0).HP, "Exp:"; arrGuy(0).XP; "/"; (4 + arrGuy(0).Level * 2), "Level:"; arrGuy(0).Level;
338.  
339.         ' WRITE INSTRUCTIONS
340.         COLOR cWhite&
341.         LOCATE 60, 1
342.         PRINT "Arrows = Move", , "t = Teleport (-5HP on failure)";
343.  
344.         ' MOVE MONSTERS
345.         FOR iLoop = 1 TO 15
346.             IF arrGuy(0).XP >= (4 + arrGuy(0).Level * 2) THEN
347.                 arrGuy(0).XP = arrGuy(0).XP - (4 + arrGuy(0).Level * 2)
348.                 arrGuy(0).Level = arrGuy(0).Level + 1
349.                 arrGuy(0).HP = arrGuy(0).HP + (arrGuy(0).Level * 5)
350.             END IF
351.  
352.             IF arrGuy(iLoop).X <> -1 AND RND < .75 THEN
353.                 'color cGray&
354.                 'Locate arrGuy(iLoop).Y, arrGuy(iLoop).X
355.                 'Print ".";
356.                 PutCharXY arrGuy(iLoop).X, arrGuy(iLoop).Y, ".", cGray&
357.  
358.                 IF arrGuy(iLoop).X < arrGuy(0).X AND SCREEN(arrGuy(iLoop).Y, arrGuy(iLoop).X + 1) = 46 THEN
359.                     arrGuy(iLoop).X = arrGuy(iLoop).X + 1
360.                 END IF
361.  
362.                 IF arrGuy(iLoop).X > arrGuy(0).X AND SCREEN(arrGuy(iLoop).Y, arrGuy(iLoop).X - 1) = 46 THEN
363.                     arrGuy(iLoop).X = arrGuy(iLoop).X - 1
364.                 END IF
365.  
366.                 IF arrGuy(iLoop).Y < arrGuy(0).Y AND SCREEN(arrGuy(iLoop).Y + 1, arrGuy(iLoop).X) = 46 THEN
367.                     arrGuy(iLoop).Y = arrGuy(iLoop).Y + 1
368.                 END IF
369.  
370.                 IF arrGuy(iLoop).Y > arrGuy(0).Y AND SCREEN(arrGuy(iLoop).Y - 1, arrGuy(iLoop).X) = 46 THEN
371.                     arrGuy(iLoop).Y = arrGuy(iLoop).Y - 1
372.                 END IF
373.  
374.                 'color cGreen&
375.                 'Locate arrGuy(iLoop).Y, arrGuy(iLoop).X
376.                 'Print Chr$(142);
377.                 PutCharXY arrGuy(iLoop).X, arrGuy(iLoop).Y, CHR$(142), cGreen&
378.  
379.             END IF
380.         NEXT iLoop
381.  
382.         _PUTIMAGE (gPosX, gPosY), DC&
383.         _DISPLAY
384.  
385.  
386.         ' ERASE OLD POSITION
387.         'color cGray&
388.         'Locate arrGuy(0).Y, arrGuy(0).X
389.         'Print ".";
390.         PutCharXY arrGuy(0).X, arrGuy(0).Y, ".", cGray&
391.  
392.         ' SET NEXT POSITION = CURRENT
393.         iNewCol = arrGuy(0).X
394.         iNewRow = arrGuy(0).Y
395.  
396.         ' GET INPUT
397.         K$ = GetKey$
398.  
399.         ' PROCESS INPUT
400.         IF K$ = CHR$(0) + "K" THEN iNewCol = arrGuy(0).X - 1
401.         IF K$ = CHR$(0) + "M" THEN iNewCol = arrGuy(0).X + 1
402.         IF K$ = CHR$(0) + "P" THEN iNewRow = arrGuy(0).Y + 1
403.         IF K$ = CHR$(0) + "H" THEN iNewRow = arrGuy(0).Y - 1
404.  
405.         ' TELEPORT TO A RANDOM LOCATION
406.         IF K$ = "t" THEN
407.             'color cWhite&
408.             'Locate Int(52 * Rnd + 5), Int(72 * Rnd + 5)
409.             'iNewCol = Pos(0)
410.             'iNewRow = CsrLin
411.             iNewCol = INT(72 * RND + 5)
412.             iNewRow = INT(52 * RND + 5)
413.             c% = GetCharXY%(iNewCol, iNewRow)
414.  
415.             ' IF YOU LAND ON NON-BLANK SPACE, LOSE HIT POINTS
416.             'If Screen(CsrLin, Pos(0)) <> 46 Then
417.             IF c% <> 46 THEN
418.                 arrGuy(0).HP = arrGuy(0).HP - 5
419.             END IF
420.         END IF
421.  
422.         ' ATTACK MONSTER
423.         'If Screen(iNewRow, iNewCol) = 142 Then
424.         IF GetCharXY%(iNewCol, iNewRow) = 142 THEN
425.  
426.             ' GET EXPERIENCE
427.             arrGuy(0).XP = arrGuy(0).XP + 1
428.  
429.             ' SUSTAIN DAMAGE
430.             IF RND > arrGuy(0).Level * .02 THEN
431.                 arrGuy(0).HP = arrGuy(0).HP - INT(20 * RND + arrGuy(0).Level)
432.             END IF
433.  
434.             ' ERASE OLD LOCATION
435.             'color cGray&
436.             'Locate iNewRow, iNewCol
437.             'Print ".";
438.             PutCharXY iNewCol, iNewRow, ".", cGray&
439.  
440.             ' DID MONSTERS REACH PLAYER?
441.             FOR iLoop = 1 TO 15
442.                 IF arrGuy(iLoop).X = iNewCol AND arrGuy(iLoop).Y = iNewRow THEN
443.                     ' NOT SURE WHAT THIS IS FOR
444.                     arrGuy(iLoop).X = -1
445.                 END IF
446.             NEXT iLoop
447.         END IF
448.  
449.         ' PICK UP GOLD
450.         IF SCREEN(iNewRow, iNewCol) = 42 THEN
451.             arrGuy(0).Gold = arrGuy(0).Gold + INT((15 * RND + 1) * RND + 1)
452.             'color cGray&
453.             'Locate iNewRow, iNewCol
454.             'Print ".";
455.             PutCharXY iNewCol, iNewRow, ".", cGray&
456.         END IF
457.  
458.         ' EXIT CAVE
459.         IF SCREEN(iNewRow, iNewCol) = 37 THEN
460.             arrGuy(0).XP = arrGuy(0).XP + 5
461.             bNewCave = TRUE
462.             'color cGray&
463.             'Locate iNewRow, iNewCol
464.             'Print ".";
465.             PutCharXY iNewCol, iNewRow, ".", cGray&
466.         END IF
467.  
468.         ' MOVE TO EMPTY SPACE
469.         IF SCREEN(iNewRow, iNewCol) = 46 THEN
470.             arrGuy(0).X = iNewCol
471.             arrGuy(0).Y = iNewRow
472.         ELSE
473.             iNewRow = arrGuy(0).Y
474.             iNewCol = arrGuy(0).X
475.         END IF
476.  
477.         ' KEEP GOING UNTIL QUIT (HIT ESC), OR DEAD, OR NEW CAVE
478.     LOOP WHILE (K$ <> CHR$(27)) AND arrGuy(0).HP > 0 AND bNewCave = FALSE
479.  
480.     ' ================================================================================================================================================================
481.     ' IS PLAYER DEAD?
482.     IF arrGuy(0).HP <= 0 THEN
483.         ' GAME OVER MAN
484.         COLOR cLtRed&
485.         LOCATE 29, 31
486.         PRINT "--== Game Over! ==--"
487.     END IF
488.  
489.     ' ================================================================================================================================================================
490.     ' NEW CAVE
491.     IF bNewCave = TRUE THEN
492.         ' NEXT CAVE
493.         COLOR cPeriwinkle&
494.         LOCATE 30, 35
495.         PRINT "Next Cave!";
496.  
497.         _DISPLAY
498.         'KEYDELAY 0
499.         GOTO NewLevel
500.     END IF
501.  
502.     ' ================================================================================================================================================================
503.     ' GAME OVER
504.  
505.     ' PLAY AGAIN?
506.     COLOR cWhite&
507.     LOCATE 30, 33
508.     PRINT "Play Again?(y/n)"
509.     _DISPLAY
510.  
511.     K$ = YesOrNo$
512.     IF K$ = "y" THEN
513.         GOTO NewGame
514.     END IF
515.  
516. END SUB ' Main
517.  
518. ' /////////////////////////////////////////////////////////////////////////////
519. ' Convert a value to string and trim it (because normal Str$ adds spaces)
520.  
521. FUNCTION cstr$ (myValue)
522.     'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
523.     cstr$ = _TRIM$(STR$(myValue))
524. END FUNCTION ' cstr$
525.  
526. ' /////////////////////////////////////////////////////////////////////////////
527.  
528. FUNCTION GetCharXY% (x%, y%)
529.     'Locate y%, x%
530.     'GetCharXY% = Screen(CsrLin, Pos(0))
531.     GetCharXY% = SCREEN(y%, x%, 0) ' character code return parameter 0
532. END FUNCTION ' GetCharXY%
533.  
534. ' /////////////////////////////////////////////////////////////////////////////
535.  
536. FUNCTION GetColorXY& (x%, y%)
537.     GetColorXY& = SCREEN(y%, x%, 1) ' character color return parameter 1
538. END FUNCTION ' GetColorXY
539.  
540. ' /////////////////////////////////////////////////////////////////////////////
541.  
542. SUB PutCharXY (x%, y%, char$, myColor&)
543.     COLOR myColor&
544.     LOCATE y%, x%
545.     PRINT char$;
546. END SUB ' PutCharXY
547.  
548. ' /////////////////////////////////////////////////////////////////////////////
549.  
550. FUNCTION GetKey$
551.     DIM K$
552.     K$ = ""
553.     DO
554.         K$ = INKEY$
555.     LOOP WHILE K$ = ""
556.     GetKey$ = K$
557. END SUB ' GetKey$
558.  
559. ' /////////////////////////////////////////////////////////////////////////////
560.  
561. FUNCTION YesOrNo$
562.     DIM K$
563.     DIM bFinished%
564.  
565.     bFinished% = FALSE
566.     DO
567.         K$ = LCASE$(INKEY$)
568.         IF K$ = "y" OR K$ = "n" THEN
569.             bFinished% = TRUE
570.         END IF
571.     LOOP WHILE bFinished% = FALSE
572.  
573.     YesOrNo$ = K$
574. END FUNCTION ' YesOrNo$
575.  
576. ' /////////////////////////////////////////////////////////////////////////////
577.  
578. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
579. ' COLOR CODE FUNCTIONS
580. ' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
581. FUNCTION cBlue&
582.     cBlue& = 1
583. END FUNCTION
584.  
585. FUNCTION cGreen&
586.     cGreen& = 2
587. END FUNCTION
588.  
589. FUNCTION cLtBlue&
590.     cLtBlue& = 3
591. END FUNCTION
592.  
593. FUNCTION cRed&
594.     cRed& = 4
595. END FUNCTION
596.  
597. FUNCTION cPurple&
598.     cPurple& = 5
599. END FUNCTION
600.  
601. FUNCTION cOrange&
602.     cOrange& = 6
603. END FUNCTION
604.  
605. FUNCTION cWhite&
606.     cWhite& = 7
607. END FUNCTION
608.  
609. FUNCTION cGray&
610.     cGray& = 8
611. END FUNCTION
612.  
613. FUNCTION cPeriwinkle&
614.     cPeriwinkle& = 9
615. END FUNCTION
616.  
617. FUNCTION cLtGreen&
618.     cLtGreen& = 10
619. END FUNCTION
620.  
621. FUNCTION cCyan&
622.     cCyan& = 11
623. END FUNCTION
624.  
625. FUNCTION cLtRed&
626.     cLtRed& = 12
627. END FUNCTION
628.  
629. FUNCTION cPink&
630.     cPink& = 13
631. END FUNCTION
632.  
633. FUNCTION cYellow&
634.     cYellow& = 14
635. END FUNCTION
636.  
637. FUNCTION cLtGray&
638.     cLtGray& = 15
639. END FUNCTION
640.  
641. FUNCTION TextCircle& 'create HARDWARE image, this can be placed also to SCREEN 0, but _DISPLAY must be always used!
642.     DIM s AS LONG, o
643.     s = _NEWIMAGE(16, 16, 32)
644.     o = _DEST
645.     _DEST s
646.     CIRCLE (7, 7), 7, &HFFFFFFFF
647.     _DEST o
648.     TextCircle& = _COPYIMAGE(s, 33)
649.     _FREEIMAGE s
650. END FUNCTION
651.  

[madscijr]

Sorry for the delayed response, I have been a little busy...

Hello! I know this is a fair few months bump but I wanted to comment that this was me!
interested to see what else you've done with it in the meantime.

Aha, mystery solved!
I haven't gotten back to this little project yet, but when I do, i will definitely post an update.

Got any other RPG or other QuickBasic programs to share? LoL

[madscijr]

@madscijr
Text mode is really not limitation for your game. I wrote small ugrade (in text mode) and if you now use fullscreen (for better view), your character @ is displayed in circle now. QB64 occurs really many options.

Neat!
Thanks for sharing that!