Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
08-07-2025, 04:54 PM
(This post was last modified: 08-07-2025, 04:57 PM by SierraKen.)
I saw this on a Commodore group page on FB and asked ChatGPT to convert it to QB64pe. Then I fixed it like usual and added a couple things.
This is one of the smallest maze makers. lol The Commodore version looks a lot different, but it's the same CHR$ number.
Code: (Select All)
'Maze Maker - ASCII
_Title "Maze Maker - ASCII"
Randomize Timer
For t = 1 To 2000
Print Chr$(Int(205.5 + Rnd));
Next t
Sleep
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
That Chr$ doesn't work for me, I learned it this way:
Code: (Select All) _Title "Maze Maker - ASCII"
_Font 8
For r = 1 To 25: For c = 1 To 80
Locate r, c: Print Chr$(Int(Rnd * 2) * 45 + 47);
Next: Next
Sleep
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
08-07-2025, 08:51 PM
(This post was last modified: 08-07-2025, 08:51 PM by SierraKen.)
LOL Bplus, yours looks almost just like the Commodore one. Good job! Mine looks like jumbled city blocks. lol
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
Some time ago, I actually wrote some code to walk around in a maze like that!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
08-07-2025, 09:46 PM
(This post was last modified: 08-07-2025, 09:50 PM by SierraKen.)
Awesome!
I decided to go crazy on this and added large animated text only using your CHR$'s. LOL
Code: (Select All)
'Maze Text
'By SierraKen and Bplus
_Title "Maze Text - Esc to quit"
Screen _NewImage(800, 600, 32)
_Font 8
For r = 1 To 75: For c = 1 To 100
Locate r, c: Print Chr$(Int(Rnd * 2) * 45 + 47);
Next: Next
Color _RGB32(0, 0, 1)
word$ = "QB64pe"
_PrintString (1, 0), word$
letters = Len(word$)
ll = (letters * 8) - 2
dir = 1
Do
If s > 2 Then dir = 2
If s < .1 Then dir = 1
If dir = 1 Then s = s + .1
If dir = 2 Then s = s - .1
For I = 1 To 1 + ll Step s
For j = 0 To 15 Step s
If Point(I, j) = _RGB32(0, 0, 1) Then
Color _RGB32(0, 255, 0)
_PrintString ((I * 8) + 220 - (ll / 2), j * 8 + 50), Chr$(Int(Rnd * 2) * 45 + 47)
End If
Next j
Next I
_Delay .1
Loop Until InKey$ = Chr$(27)
The tiny little blank area in the upper-left hand corner is intential, because that's where it has to detect the original word at to make the larger one.
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
Nice! lets get rid of black hole and change up the colors a bit:
Code: (Select All)
'Maze Text
'By SierraKen and Bplus
_Title "Maze Text - Esc to quit"
Screen _NewImage(800, 600, 32)
_Font 8
prt& = _NewImage(48, 16, 32)
_Dest prt&
Color _RGB32(0, 0, 1)
word$ = "QB64pe"
_PrintString (1, 0), word$
letters = Len(word$)
ll = (letters * 8) - 3
_Dest 0
Color &HFF000000, &HFFAAAAAA
For r = 1 To 75: For c = 1 To 100
Locate r, c: Print Chr$(Int(Rnd * 2) * 45 + 47);
Next: Next
dir = 1
_Source prt&
Do
If s > 2 Then dir = 2
If s < .1 Then dir = 1
If dir = 1 Then s = s + .1
If dir = 2 Then s = s - .1
For I = 1 To 1 + ll Step s
For j = 0 To 14 Step s
If Point(I, j) = _RGB32(0, 0, 1) Then
Color &HFFFFFFFF, &HFF000000
_PrintString ((I * 8) + 220 - (ll / 2), j * 8 + 50), Chr$(Int(Rnd * 2) * 45 + 47)
End If
Next j
Next I
_Delay .1
Loop Until InKey$ = Chr$(27)
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
WOW!! That's sweet!! I like the 3D effect it makes somehow.  Thanks B+. People could use this as the perfect opening welcome screen to a game or app.
Or just make it part of a game or app.
Way cool.
-Ken
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
08-08-2025, 08:06 AM
(This post was last modified: 08-08-2025, 08:10 AM by bplus.)
This "maze" is based on a 2 tile system. Here are mazes made from two tiles, one tile is two vertical bars, the other tile is two horizontal bars. Here I play with 2 tile maze system various keys to shrink/increase tile size, more or less vertical to horizontal, arrow keys to navigate and mouse clicks to paint paths in either red or blue:
Code: (Select All)
' b+ mod NOVARSEG code for 2 tiler 2021-01-25
' 2021-01-27 mod this for navigation and toggle paint jobs red and back or blue and black as per NOVARSEG
' 2021-01-27 add spacebar to reverse a cells walls a sound will buzz if not inside a cell with walls
' The color your standing on will PAINT the new roadway if the walls switch.
Const W = 1024, H = 700 ' screen width and height and color for lines and border check
Screen _NewImage(W, H, 32)
_Delay .25 'wait for screen to set
_ScreenMove _Middle 'then center it in screen
ReDim white As _Unsigned Long, hColr As _Unsigned Long
white = &HFFFFFFFF
s = 10 ' s is the unit for drawing and navigating screen each step is 2*s
t = .5 ' t is splitter between up/down walls and left/right walls
Color white
_Title "Press z increase over/under, x increase left/right, c makes smaller cells, v bigger, esc to quit, left mouse paints red/black, right blue/black, spacebar to reverse cells"
Do
Cls
xcells = Int(W / s) 'how many cells across
ycells = Int(H / s) 'how many down
ReDim maze(xcells + 2, ycells + 2) As Long ' save our wall settings in maze array for wall changing with spacebar
For y = 0 To H Step s * 4
For x = 0 To W Step s * 4
r = Rnd
'CIRCLE (x, y), 2, &HFFFFFF00
If r <= t Then
maze(Int(x / s), Int(y / s)) = -1
Line (x - s, y + s)-(x + s, y + s) 'bottom line
Line (x - s, y - s)-(x + s, y - s) 'top line
End If
If r > t Then
maze(Int(x / s), Int(y / s)) = 1
Line (x - s, y - s)-(x - s, y + s) 'left line
Line (x + s, y - s)-(x + s, y + s) 'right line
End If
x = x + s * 2: y = y + s * 2 ' offset to do the other half of screen
'CIRCLE (x, y), 2, &HFF0000FF
r = Rnd
If r <= t Then
maze(Int(x / s), Int(y / s)) = -1
Line (x - s, y + s)-(x + s, y + s) 'bottom line
Line (x - s, y - s)-(x + s, y - s) 'top line
End If
If r > t Then
maze(Int(x / s), Int(y / s)) = 1
Line (x - s, y - s)-(x - s, y + s) 'left line
Line (x + s, y - s)-(x + s, y + s) 'right line
End If
x = x - s * 2: y = y - s * 2 ' set back to first set
Next
Next
If back Then _FreeImage back ' be careful not to cause a memory leak
ReDim back As Long
back = _NewImage(_Width, _Height, 32) ' this uses new memory regardless if back is same old name or not
_PutImage , 0, back 'store current maze into image
xcells = Int(W / s) 'how many cells across
ycells = Int(H / s) 'how many down
hx = Int(xcells / 2) 'put our guy smack in middle of screen but he has to be on even number of cells!
If hx Mod 2 = 1 Then hx = hx + 1
hy = Int(ycells / 2)
If hy Mod 2 = 1 Then hy = hy + 1
Do
_PutImage , back, 0
KH& = _KeyHit
Select Case KH& ' which key was pressed?
Case 27 ' the ESC key
System '
Case 32
If maze(hx, hy) Then ' make sure on a cell that has walls
If maze(hx, hy) = 1 Then
maze(hx, hy) = -1
ElseIf maze(hx, hy) = -1 Then
maze(hx, hy) = 1
End If
' now redraw everything!!!!
hColr = Point(hx * s - (s - 1), hy * s - (s - 1)) ' preserve color at hx, hy
Cls
For y = 0 To ycells Step 2 'redraw maze
For x = 0 To xcells Step 2
If maze(x, y) = -1 Then
Line (x * s - s, y * s + s)-(x * s + s, y * s + s) 'bottom line
Line (x * s - s, y * s - s)-(x * s + s, y * s - s) 'top line
ElseIf maze(x, y) = 1 Then
Line (x * s - s, y * s - s)-(x * s - s, y * s + s) 'left line
Line (x * s + s, y * s - s)-(x * s + s, y * s + s) 'right line
End If
Next
Next
If hColr <> white Then Paint (hx * s, hy * s), hColr, white ' paint the new roadway
'take a new picture
_Display
If back Then _FreeImage back ' be careful not to cause a memory leak
back = _NewImage(_Width, _Height, 32) ' this uses new memory regardless if back is same old name or not
_PutImage , 0, back 'store current maze into image
Else
Sound 100, 4
End If
Case 18432 ' Up Arrow
If hy - 2 > 0 Then
'CIRCLE (hx * s, (hy - 1) * s), 5, &HFFFFFF00
'_DELAY .5
'PRINT POINT(hx * s, (hy - 1) * s), POINT(hx * s, (hy - 1) * s + 1), POINT(hx * s, (hy - 1) * s - 1), white
'_DISPLAY
'SLEEP
If Point(hx * s, (hy - 1) * s) <> white And Point(hx * s, (hy - 1) * s + 1) <> white And Point(hx * s, (hy - 1) * s - 1) <> white Then hy = hy - 2
End If
Case 19712 'the RIGHT ARROW key
If hx + 2 < xcells Then
'CIRCLE ((hx + 1) * s, hy * s), 5, &HFFFFFF00
'_DELAY .5
If Point((hx + 1) * s, hy * s) <> white And Point((hx + 1) * s + 1, hy * s) <> white And Point((hx + 1) * s - 1, hy * s) <> white Then hx = hx + 2
End If
Case 20480 ' the DOWN ARROW key
If hy + 2 < ycells Then
'CIRCLE (hx * s, (hy + 1) * s), 5, &HFFFFFF00
'_DELAY .5
If Point(hx * s, (hy + 1) * s) <> white And Point(hx * s, (hy + 1) * s + 1) <> white And Point(hx * s, (hy + 1) * s - 1) <> white Then hy = hy + 2
End If
Case 19200 'the LEFT ARROW key
If hx - 2 > 0 Then
'CIRCLE ((hx - 1) * s, hy * s), 5, &HFFFFFF00
'_DELAY .5
If Point((hx - 1) * s, hy * s) <> white And Point((hx - 1) * s + 1, hy * s) <> white And Point((hx - 1) * s - 1, hy * s) <> white Then hx = hx - 2
End If
End Select
For ra = 0 To .5 * s Step .25 ' make a solid filled circle
Circle (hx * s, hy * s), ra, &HFFFFFF00
Next
_Display
_Limit 60
' the rest of this loop is input from user, the drawing part is over but might PAINT roadways
While _MouseInput: Wend
If _MouseButton(1) Then
_Delay .2
_PutImage , back, 0 'get rid of hero
If Point(_MouseX, _MouseY) = _RGB32(0, 0, 0) Then
Paint (_MouseX, _MouseY), _RGB32(255, 0, 0), &HFFFFFFFF
ElseIf Point(_MouseX, _MouseY) = _RGB32(255, 0, 0) Then
Paint (_MouseX, _MouseY), _RGB32(0, 0, 0), &HFFFFFFFF
End If
_Display
If back Then _FreeImage back ' be careful not to cause a memory leak
back = _NewImage(_Width, _Height, 32) ' this uses new memory regardless if back is same old name or not
_PutImage , 0, back 'store current maze into image
End If
If _MouseButton(2) Then
_Delay .2
_PutImage , back, 0 'get rid of hero
If Point(_MouseX, _MouseY) = _RGB32(0, 0, 255) Then
Paint (_MouseX, _MouseY), _RGB32(0, 0, 0), &HFFFFFFFF
ElseIf Point(_MouseX, _MouseY) = _RGB32(0, 0, 0) Then
Paint (_MouseX, _MouseY), _RGB32(0, 0, 255), &HFFFFFFFF
End If
_Display
If back Then _FreeImage back ' be careful not to cause a memory leak
back = _NewImage(_Width, _Height, 32) ' this uses new memory regardless if back is same old name or not
_PutImage , 0, back 'store current maze into image
End If
i$ = InKey$
If i$ = "z" And t < 1 Then t = t + .05: Exit Do ' changed from .005 because too slow
If i$ = "x" And t > 0 Then t = t - .05: Exit Do
If i$ = "c" And s > 3 Then s = s - 1: Exit Do
If i$ = "v" And s < 41 Then s = s + 1: Exit Do
If i$ = Chr$(27) Then End
Loop
Loop
Oh really cool, reverse the tile the yellow dot is at with spacebar press, it completely changes the color path the dot is on!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
oooh I love me some mazes. Good work!
Here's one I made a little while ago that I slowed down because it was fun to watch.
Code: (Select All)
Screen _NewImage(300, 200, 256)
_FullScreen
Cls , 0
Randomize Timer
dig$ = ""
Type point_type
x As Integer
y As Integer
score As Integer
End Type
Dim Shared runl 'i was palnnign on making this more complicaated eventually so variables are shared to share with subds and functions
Dim Shared pnt(maxpoints) As point_type
Dim Shared curp, pointcount
Do
Cls
runl = Int(2 + Rnd * 3 + Rnd * 3 + Rnd * 3)
lastgo = Int(1 + Rnd * 4)
startx = Int(_Width / 2 + Rnd * (_Width / 4) - Rnd * (_Width / 4))
starty = Int(_Height / 2 + Rnd * (_Height / 4) - Rnd * (_Height / 4))
maxpoints = ((_Width - 1) * (_Height - 1)) \ (((runl - 1) * runl))
ReDim Shared pnt(maxpoints) As point_type
curp = 1
pointcount = 1
pnt(curp).x = startx: pnt(curp).y = starty
PSet (pnt(curp).x, pnt(curp).y), 6
Do
_Limit ((runl ^ 2) * 600)
cx = pnt(curp).x: cy = pnt(curp).y
dgo = Int(1 + Rnd * 7)
If dgo = 5 Then dig$ = "jump"
If dgo = 6 Then dig$ = "back"
If dgo > 5 Then
dgo = lastgo
End If
Select Case dgo
Case 1
If cy - runl > 0 Then
gy = cy - runl: gx = cx
If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"
End If
Case 2
If cx + runl < (_Width - runl) Then
gx = cx + runl: gy = cy
If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"
End If
Case 3
If cy + runl < (_Height - runl) Then
gy = cy + runl: gx = cx
If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"
End If
Case 4
If cx - runl > 0 Then
gx = cx - runl: gy = cy
If Point(gx, gy) = 0 Then dig$ = "dig" Else If Point(gx, gy) = 6 Then dig$ = "move"
End If
End Select
If dgo > 0 Then lastgo = dgo
Select Case dig$
Case "dig"
Line (cx, cy)-(gx, gy), 6
curp = curp + 1
pointcount = pointcount + 1
pnt(pointcount).x = gx
pnt(pointcount).y = gy
Case "move"
curp = findp(gx, gy)
Case "jump"
curp = Int(1 + Rnd * pointcount)
Case "back"
curp = pointcount - Int(1 + Rnd * Sqr(pointcount))
End Select
dig$ = ""
kk$ = InKey$
Loop Until pointcount >= maxpoints Or kk$ <> ""
Sleep
kk$ = InKey$
Loop Until kk$ = Chr$(27)
Function findp (xx, yy)
fd = 0
For f = 1 To pointcount
If pnt(f).x = xx And pnt(f).y = yy Then
fd = f
End If
If fd > 0 Then Exit For
Next f
findp = fd
End Function
Posts: 360
Threads: 36
Joined: Mar 2023
Reputation:
28
Those are cool, James and bplus!
|
