Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
Pretty awesome guys.
Here is a different tiny one.
Code: (Select All)
'Maze - Tiny
'Mod from Basic Programming's FB group
_Title "Maze - Tiny - Esc to quit - Other keys for a new one."
Randomize Timer
Do
For t = 1 To 2000
Print Chr$(220 + Rnd(1));
Next t
Sleep
If InKey$ = Chr$(27) Then End
Cls
Loop
Posts: 187
Threads: 14
Joined: May 2024
Reputation:
20
jdj this is a pretty good program. thank you!
i changed it so it worked on a 800x600 screen. it took a rather long time. but it finished. very clever!
one of my favorite programs. for the tandy color computer. wasn't very sophisticated. it relied on the user. to create a maze. allowed it saved to cassette. then one of those "mazes" recalled. so the player could "play" moving around it. i still have all that red on my mind. "your maze is all walls!"
we should print out the mazes. being created by any of these programs. then go and solve them on paper!
![[Image: jdj-maze-big-one-in-window.png]](https://i.ibb.co/bRrsKmXg/jdj-maze-big-one-in-window.png)
Posts: 187
Threads: 14
Joined: May 2024
Reputation:
20
(08-07-2025, 04:54 PM)SierraKen Wrote: 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
with this program. put it into graphics mode. add the _loadfont command. first for one of the c64 original character sets.
i was going to propose. use with "microknight" or "topaz" or other such font. but that was for commodore amiga. not for c64. likely the character set changed. out of only two slants used. in that famous "10 print" program.
Posts: 688
Threads: 154
Joined: Apr 2022
Reputation:
67
(08-08-2025, 10:52 PM)hsiangch_ong Wrote: jdj this is a pretty good program. thank you!
i changed it so it worked on a 800x600 screen. it took a rather long time. but it finished. very clever!
I had planned to use it for a more complicated program (a dungeoncrwler with rooms and monsters) and might get to that some day.
Posts: 4,692
Threads: 222
Joined: Apr 2022
Reputation:
322
08-09-2025, 09:03 PM
(This post was last modified: 08-09-2025, 09:06 PM by bplus.)
(08-09-2025, 07:44 PM)James D Jarvis Wrote: (08-08-2025, 10:52 PM)hsiangch_ong Wrote: jdj this is a pretty good program. thank you!
i changed it so it worked on a 800x600 screen. it took a rather long time. but it finished. very clever!
I had planned to use it for a more complicated program (a dungeoncrwler with rooms and monsters) and might get to that some day.
Yeah a true maze IMHO you can get from any cell to any other cell. These fake tiny mazes made from 2 tile system just kinda look like a maze.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 30
Threads: 11
Joined: Jul 2022
Reputation:
2
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
Here is an old GW-Basic (or maybe older) maze maker that someone posted on an old BASIC newsgroup back in the 90's.
Code: (Select All)
1010 Key Off
1020 DefInt A-Z
1030 X.MAX = 95
1040 Y.MAX = 49
1050 Dim DELTA.X(6, 720)
1060 Dim DELTA.Y(6, 720)
1070 Dim PAGE(Y.MAX, X.MAX)
1080 Dim R.N(8)
1090 Dim STACK.1(Y.MAX * X.MAX)
1100 Dim STACK.2(Y.MAX * X.MAX)
1110 Cls
1120 Print " Maze Generator"
1130 Print
1140 Print
1150 Print
1160 Print " Random number seed? ";
1170 Line Input SEED$
1180 R.N.INDEX.1 = 1
1190 For R.N.INDEX.2 = 1 To Len(SEED$)
1200 TEM.INT = Asc(Mid$(SEED$, R.N.INDEX.2, 1))
1210 R.N(R.N.INDEX.1) = TEM.INT
1220 R.N.INDEX.1 = R.N.INDEX.1 + 1
1230 Next R.N.INDEX.2
1240 R.N.INDEX.2 = 8
1250 While (R.N.INDEX.1 > 1)
1260 R.N.INDEX.1 = R.N.INDEX.1 - 1
1270 R.N(R.N.INDEX.2) = R.N(R.N.INDEX.1)
1280 R.N.INDEX.2 = R.N.INDEX.2 - 1
1290 Wend
1300 While (R.N.INDEX.2 >= 1)
1310 R.N(R.N.INDEX.2) = 367
1320 R.N.INDEX.2 = R.N.INDEX.2 - 1
1330 Wend
1340 DELTA.Y(1, 1) = -1
1350 DELTA.X(1, 1) = -2
1360 DELTA.Y(2, 1) = 1
1370 DELTA.X(2, 1) = -2
1380 DELTA.Y(3, 1) = -2
1390 DELTA.X(3, 1) = 0
1400 DELTA.Y(4, 1) = 2
1410 DELTA.X(4, 1) = 0
1420 DELTA.Y(5, 1) = -1
1430 DELTA.X(5, 1) = 2
1440 DELTA.Y(6, 1) = 1
1450 DELTA.X(6, 1) = 2
1460 DELTA.INDEX.2 = 0
1470 For DELTA.INDEX.1A = 1 To 6
1480 For DELTA.INDEX.1B = 1 To 6
1490 If DELTA.INDEX.1A = DELTA.INDEX.1B Then 1850
1500 For DELTA.INDEX.1C = 1 To 6
1510 If DELTA.INDEX.1A = DELTA.INDEX.1C Then 1840
1520 If DELTA.INDEX.1B = DELTA.INDEX.1C Then 1840
1530 For DELTA.INDEX.1D = 1 To 6
1540 If DELTA.INDEX.1A = DELTA.INDEX.1D Then 1830
1550 If DELTA.INDEX.1B = DELTA.INDEX.1D Then 1830
1560 If DELTA.INDEX.1C = DELTA.INDEX.1D Then 1830
1570 For DELTA.INDEX.1E = 1 To 6
1580 If DELTA.INDEX.1A = DELTA.INDEX.1E Then 1820
1590 If DELTA.INDEX.1B = DELTA.INDEX.1E Then 1820
1600 If DELTA.INDEX.1C = DELTA.INDEX.1E Then 1820
1610 If DELTA.INDEX.1D = DELTA.INDEX.1E Then 1820
1620 For DELTA.INDEX.1F = 1 To 6
1630 If DELTA.INDEX.1A = DELTA.INDEX.1F Then 1810
1640 If DELTA.INDEX.1B = DELTA.INDEX.1F Then 1810
1650 If DELTA.INDEX.1C = DELTA.INDEX.1F Then 1810
1660 If DELTA.INDEX.1D = DELTA.INDEX.1F Then 1810
1670 If DELTA.INDEX.1E = DELTA.INDEX.1F Then 1810
1680 DELTA.INDEX.2 = DELTA.INDEX.2 + 1
1690 DELTA.X(DELTA.INDEX.1A, DELTA.INDEX.2) = DELTA.X(1, 1)
1700 DELTA.Y(DELTA.INDEX.1A, DELTA.INDEX.2) = DELTA.Y(1, 1)
1710 DELTA.X(DELTA.INDEX.1B, DELTA.INDEX.2) = DELTA.X(2, 1)
1720 DELTA.Y(DELTA.INDEX.1B, DELTA.INDEX.2) = DELTA.Y(2, 1)
1730 DELTA.X(DELTA.INDEX.1C, DELTA.INDEX.2) = DELTA.X(3, 1)
1740 DELTA.Y(DELTA.INDEX.1C, DELTA.INDEX.2) = DELTA.Y(3, 1)
1750 DELTA.X(DELTA.INDEX.1D, DELTA.INDEX.2) = DELTA.X(4, 1)
1760 DELTA.Y(DELTA.INDEX.1D, DELTA.INDEX.2) = DELTA.Y(4, 1)
1770 DELTA.X(DELTA.INDEX.1E, DELTA.INDEX.2) = DELTA.X(5, 1)
1780 DELTA.Y(DELTA.INDEX.1E, DELTA.INDEX.2) = DELTA.Y(5, 1)
1790 DELTA.X(DELTA.INDEX.1F, DELTA.INDEX.2) = DELTA.X(6, 1)
1800 DELTA.Y(DELTA.INDEX.1F, DELTA.INDEX.2) = DELTA.Y(6, 1)
1810 Next DELTA.INDEX.1F
1820 Next DELTA.INDEX.1E
1830 Next DELTA.INDEX.1D
1840 Next DELTA.INDEX.1C
1850 Next DELTA.INDEX.1B
1860 Next DELTA.INDEX.1A
1870 Y.OUT.MOD.4 = 1
1880 For Y.OUT = 1 To Y.MAX
1890 If Y.OUT.MOD.4 <> 1 Then 2030
1900 X.OUT.MOD.8 = 1
1910 For X.OUT = 1 To X.MAX
1920 If ((X.OUT.MOD.8 = 0) And (Y.OUT <> 1) And (Y.OUT <> Y.MAX)) Then 1980
1930 If X.OUT.MOD.8 = 3 Then 1980
1940 If X.OUT.MOD.8 = 4 Then 1980
1950 If X.OUT.MOD.8 = 5 Then 1980
1960 PAGE(Y.OUT, X.OUT) = 0
1970 GoTo 1990
1980 PAGE(Y.OUT, X.OUT) = 1
1990 X.OUT.MOD.8 = X.OUT.MOD.8 + 1
2000 If X.OUT.MOD.8 >= 8 Then X.OUT.MOD.8 = 0
2010 Next X.OUT
2020 GoTo 2260
2030 If ((Y.OUT.MOD.4 <> 0) And (Y.OUT.MOD.4 <> 2)) Then 2140
2040 X.OUT.MOD.8 = 1
2050 For X.OUT = 1 To X.MAX
2060 If ((X.OUT.MOD.8 = 2) Or (X.OUT.MOD.8 = 6)) Then 2090
2070 PAGE(Y.OUT, X.OUT) = 0
2080 GoTo 2100
2090 PAGE(Y.OUT, X.OUT) = 1
2100 X.OUT.MOD.8 = X.OUT.MOD.8 + 1
2110 If X.OUT.MOD.8 >= 8 Then X.OUT.MOD.8 = 0
2120 Next X.OUT
2130 GoTo 2260
2140 X.OUT.MOD.8 = 1
2150 For X.OUT = 1 To X.MAX
2160 If X.OUT.MOD.8 = 0 Then 2220
2170 If X.OUT.MOD.8 = 1 Then 2220
2180 If X.OUT.MOD.8 = 4 Then 2220
2190 If X.OUT.MOD.8 = 7 Then 2220
2200 PAGE(Y.OUT, X.OUT) = 0
2210 GoTo 2230
2220 PAGE(Y.OUT, X.OUT) = 1
2230 X.OUT.MOD.8 = X.OUT.MOD.8 + 1
2240 If X.OUT.MOD.8 >= 8 Then X.OUT.MOD.8 = 0
2250 Next X.OUT
2260 Y.OUT.MOD.4 = Y.OUT.MOD.4 + 1
2270 If Y.OUT.MOD.4 >= 4 Then Y.OUT.MOD.4 = 0
2280 Next Y.OUT
2290 X = 4
2300 Y = Y.MAX - 2
2310 PAGE(Y, X) = 0
2320 STACK.HEAD = -1
2330 DELTA.INDEX.1A = 1
2340 DELTA.INDEX.2 = R.N(1)
2350 R.N.INDEX.1 = 1
2360 For R.N.INDEX.2 = 2 To 8
2370 TEM.INT = R.N(R.N.INDEX.2)
2380 R.N(R.N.INDEX.1) = TEM.INT
2390 DELTA.INDEX.2 = DELTA.INDEX.2 + TEM.INT
2400 If DELTA.INDEX.2 > 727 Then DELTA.INDEX.2 = DELTA.INDEX.2 - 727
2410 R.N.INDEX.1 = R.N.INDEX.2
2420 Next R.N.INDEX.2
2430 R.N(8) = DELTA.INDEX.2
2440 If DELTA.INDEX.2 > 720 Then 2340
2450 PASSAGE.FOUND = 0
2460 SEARCH.COMPLETE = 0
2470 While (SEARCH.COMPLETE = 0)
2480 While ((DELTA.INDEX.1A <= 6) And (PASSAGE.FOUND = 0))
2490 X.NEXT = X + 2 * DELTA.X(DELTA.INDEX.1A, DELTA.INDEX.2)
2500 If X.NEXT > 0 Then 2530
2510 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2520 GoTo 2670
2530 If X.NEXT < X.MAX Then 2560
2540 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2550 GoTo 2670
2560 Y.NEXT = Y + 2 * DELTA.Y(DELTA.INDEX.1A, DELTA.INDEX.2)
2570 If Y.NEXT > 0 Then 2600
2580 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2590 GoTo 2670
2600 If Y.NEXT < Y.MAX Then 2630
2610 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2620 GoTo 2670
2630 If PAGE(Y.NEXT, X.NEXT) = 0 Then 2660
2640 PASSAGE.FOUND = -1
2650 GoTo 2670
2660 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2670 Wend
2680 If PASSAGE.FOUND <> 0 Then 2760
2690 If STACK.HEAD < 0 Then 2760
2700 DELTA.INDEX.1A = STACK.1(STACK.HEAD)
2710 DELTA.INDEX.2 = STACK.2(STACK.HEAD)
2720 X = X - 2 * DELTA.X(DELTA.INDEX.1A, DELTA.INDEX.2)
2730 Y = Y - 2 * DELTA.Y(DELTA.INDEX.1A, DELTA.INDEX.2)
2740 STACK.HEAD = STACK.HEAD - 1
2750 DELTA.INDEX.1A = DELTA.INDEX.1A + 1
2760 If PASSAGE.FOUND = 0 Then 2790
2770 SEARCH.COMPLETE = -1
2780 GoTo 2810
2790 If ((STACK.HEAD >= 0) Or (DELTA.INDEX.1A <= 6)) Then 2810
2800 SEARCH.COMPLETE = -1
2810 Wend
2820 If PASSAGE.FOUND = 0 Then 2900
2830 STACK.HEAD = STACK.HEAD + 1
2840 STACK.1(STACK.HEAD) = DELTA.INDEX.1A
2850 STACK.2(STACK.HEAD) = DELTA.INDEX.2
2860 PAGE(Y.NEXT, X.NEXT) = 0
2870 PAGE((Y + Y.NEXT) \ 2, (X + X.NEXT) \ 2) = 0
2880 X = X.NEXT
2890 Y = Y.NEXT
2900 If STACK.HEAD <> -1 Then 2330
2910 PAGE(2, 2) = 0
2920 PAGE(Y.MAX - 1, X.MAX - 1) = 0
2930 Screen 1
2940 Color 0, 0
2950 Cls
2960 Y.PREVIOUS = 0
2970 Y.NEXT = 2
2980 For Y.OUT = 1 To Y.MAX
2990 X.OUT = 1
3000 For X.NEXT = 2 To X.MAX
3010 If PAGE(Y.OUT, X.OUT) = 0 Then 3100
3020 If PAGE(Y.OUT, X.NEXT) = 0 Then 3040
3030 Line (3 * (X.OUT - 1), 4 * (Y.OUT - 1))-(3 * (X.NEXT - 1), 4 * (Y.OUT - 1)), 1
3040 If Y.PREVIOUS <= 0 Then 3070
3050 If PAGE(Y.PREVIOUS, X.NEXT) = 0 Then 3070
3060 Line (3 * (X.OUT - 1), 4 * (Y.OUT - 1))-(3 * (X.NEXT - 1), 4 * (Y.PREVIOUS - 1)), 1
3070 If Y.NEXT > Y.MAX Then 3100
3080 If PAGE(Y.NEXT, X.NEXT) = 0 Then 3100
3090 Line (3 * (X.OUT - 1), 4 * (Y.OUT - 1))-(3 * (X.NEXT - 1), 4 * (Y.NEXT - 1)), 1
3100 X.OUT = X.NEXT
3110 Next X.NEXT
3120 Y.PREVIOUS = Y.OUT
3130 Y.NEXT = Y.NEXT + 1
3140 Next Y.OUT
3150 Beep
3160 While (InKey$ = "")
3170 Wend
3180 NUM.DEAD.ENDS = 0
3190 For Y.OUT = 3 To Y.MAX Step 4
3200 For X.OUT = 4 To X.MAX Step 8
3210 NUM.WALLS = PAGE(Y.OUT - 1, X.OUT - 2)
3220 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 1, X.OUT - 2)
3230 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 2, X.OUT)
3240 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 1, X.OUT + 2)
3250 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT - 1, X.OUT + 2)
3260 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT - 2, X.OUT)
3270 If NUM.WALLS <> 5 Then 3510
3280 NUM.DEAD.ENDS = NUM.DEAD.ENDS + 1
3290 If PAGE(Y.OUT - 1, X.OUT - 2) <> 0 Then 3330
3300 Line (3 * (X.OUT - 4), 4 * (Y.OUT - 1))-(3 * (X.OUT - 2), 4 * (Y.OUT - 3)), 2
3310 PAGE(Y.OUT - 1, X.OUT - 2) = 1
3320 GoTo 3510
3330 If PAGE(Y.OUT - 2, X.OUT) <> 0 Then 3370
3340 Line (3 * (X.OUT - 2), 4 * (Y.OUT - 3))-(3 * X.OUT, 4 * (Y.OUT - 3)), 2
3350 PAGE(Y.OUT - 2, X.OUT) = 1
3360 GoTo 3510
3370 If PAGE(Y.OUT - 1, X.OUT + 2) <> 0 Then 3410
3380 Line (3 * X.OUT, 4 * (Y.OUT - 3))-(3 * (X.OUT + 2), 4 * (Y.OUT - 1)), 2
3390 PAGE(Y.OUT - 1, X.OUT + 2) = 1
3400 GoTo 3510
3410 If PAGE(Y.OUT + 1, X.OUT + 2) <> 0 Then 3450
3420 Line (3 * (X.OUT + 2), 4 * (Y.OUT - 1))-(3 * X.OUT, 4 * (Y.OUT + 1)), 2
3430 PAGE(Y.OUT + 1, X.OUT + 2) = 1
3440 GoTo 3510
3450 If PAGE(Y.OUT + 2, X.OUT) <> 0 Then 3490
3460 Line (3 * X.OUT, 4 * (Y.OUT + 1))-(3 * (X.OUT - 2), 4 * (Y.OUT + 1)), 2
3470 PAGE(Y.OUT + 2, X.OUT) = 1
3480 GoTo 3510
3490 Line (3 * (X.OUT - 2), 4 * (Y.OUT + 1))-(3 * (X.OUT - 4), 4 * (Y.OUT - 1)), 2
3500 PAGE(Y.OUT + 1, X.OUT - 2) = 1
3510 Next X.OUT
3520 Next Y.OUT
3530 Y.LIMIT = Y.MAX - 1
3540 For Y.OUT = 5 To Y.LIMIT Step 4
3550 For X.OUT = 8 To X.MAX Step 8
3560 NUM.WALLS = PAGE(Y.OUT - 1, X.OUT - 2)
3570 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 1, X.OUT - 2)
3580 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 2, X.OUT)
3590 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT + 1, X.OUT + 2)
3600 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT - 1, X.OUT + 2)
3610 NUM.WALLS = NUM.WALLS + PAGE(Y.OUT - 2, X.OUT)
3620 If NUM.WALLS <> 5 Then 3860
3630 NUM.DEAD.ENDS = NUM.DEAD.ENDS + 1
3640 If PAGE(Y.OUT - 1, X.OUT - 2) <> 0 Then 3680
3650 Line (3 * (X.OUT - 4), 4 * (Y.OUT - 1))-(3 * (X.OUT - 2), 4 * (Y.OUT - 3)), 2
3660 PAGE(Y.OUT - 1, X.OUT - 2) = 1
3670 GoTo 3860
3680 If PAGE(Y.OUT - 2, X.OUT) <> 0 Then 3720
3690 Line (3 * (X.OUT - 2), 4 * (Y.OUT - 3))-(3 * X.OUT, 4 * (Y.OUT - 3)), 2
3700 PAGE(Y.OUT - 2, X.OUT) = 1
3710 GoTo 3860
3720 If PAGE(Y.OUT - 1, X.OUT + 2) <> 0 Then 3760
3730 Line (3 * X.OUT, 4 * (Y.OUT - 3))-(3 * (X.OUT + 2), 4 * (Y.OUT - 1)), 2
3740 PAGE(Y.OUT - 1, X.OUT + 2) = 1
3750 GoTo 3860
3760 If PAGE(Y.OUT + 1, X.OUT + 2) <> 0 Then 3800
3770 Line (3 * (X.OUT + 2), 4 * (Y.OUT - 1))-(3 * X.OUT, 4 * (Y.OUT + 1)), 2
3780 PAGE(Y.OUT + 1, X.OUT + 2) = 1
3790 GoTo 3860
3800 If PAGE(Y.OUT + 2, X.OUT) <> 0 Then 3840
3810 Line (3 * X.OUT, 4 * (Y.OUT + 1))-(3 * (X.OUT - 2), 4 * (Y.OUT + 1)), 2
3820 PAGE(Y.OUT + 2, X.OUT) = 1
3830 GoTo 3860
3840 Line (3 * (X.OUT - 2), 4 * (Y.OUT + 1))-(3 * (X.OUT - 4), 4 * (Y.OUT - 1)), 2
3850 PAGE(Y.OUT + 1, X.OUT - 2) = 1
3860 Next X.OUT
3870 Next Y.OUT
3880 If NUM.DEAD.ENDS <> 0 Then 3180
3890 Beep
3900 While (InKey$ = "")
3910 Wend
3920 Screen 0
3930 Width 80
3940 End
Posts: 4,692
Threads: 222
Joined: Apr 2022
Reputation:
322
Oh a hexagonal one!
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 4,692
Threads: 222
Joined: Apr 2022
Reputation:
322
08-09-2025, 11:38 PM
(This post was last modified: 08-09-2025, 11:41 PM by bplus.)
Here's an old one of mine fully commented that I got from a SmallBASIC program years ago:
Code: (Select All) Option _Explicit
_Title "Maze Generator" 'B+
' 2019-09-02 isolated and updated generator code for OPTION _EXPLICIT
' from trans 2018-06-15 for Amazing Rat.bas (QB64)
' From SmallBASIC code written by Chris WS developer
' Backtracking maze generator by chrisws 2016-06-30 now found at
' https://github.com/smallbasic/smallbasic.github.io/blob/5601c8bc1d794c5b143d863555bb7c15a5966a3c/samples/node/1623.bas
'
' Chris notes:
' https://en.wikipedia.org/wiki/Maze_generation_algorithm
' - Starting from a random cell,
' - Selects a random neighbouring cell that has not been visited.
' - Remove the wall between the two cells and marks the new cell as visited,
' and adds it to the stack to facilitate backtracking.
' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
' When at a dead-end it backtracks through the path until it reaches a cell with an
' unvisited neighbour, continuing the path generation by visiting this new,
' unvisited cell (creating a new junction).
' This process continues until every cell has been visited, backtracking all the
' way back to the beginning cell. We can be sure every cell is visited.
'
'B+ notes for using:
' The most important item is that the maze uses 2 arrays one for vertical walls the other for horizontal
' CONST xmax, ymax is pixel size used in maze coder, using SW, SH for screen dimensions
' Maze should mount in top left corner of screen with min border space around it at left and top at least.
' CONST W, H - number of cells Wide and High you can specify.
' CONST wallThk - adjusts thickness of walls
' CONST mazeClr - colors walls made with BF in LINE statement
' CONST border - will create a space around the maze
' SHARED cellW, cellH - are pixels sizes for cell, see calcs before SCREEN command
' SHARED h_walls(W, H) AS INTEGER, v_walls(W, H) AS INTEGER - these are your Maze, 0 no wall, 1 = wall
' When player occupies cell x, y that cell may v_wall that blocks player going left;
' a cell v_wall(x+1, y) = 1 will block a player going right;
' cell (x, y) may have an h_wall that stops player from going up;
' cell (x, y+1) may have h_wall that stops player at x, y from going down.
' Cells at (W, y) should not be occupied with W cells wide and array base 0 only W-1 can be occupied
' unless game needs something special.
' Likewise cells at (x, H) should only provide wall to stop player from going out of box.
Const xmax = 800, ymax = 600, SW = 1200, SH = 700 'maze pixels from 0,0 and screen SH, SW
Const W = 40, H = 30, border = 25, wallThk = 5 'maze cells wide and high
Const mazeClr = &HFFFF8800
Type cell
x As Integer
y As Integer
End Type
Dim Shared cellW As Single, cellH As Single, h_walls(W, H) As Integer, v_walls(W, H) As Integer
cellW = (xmax - 2 * border - wallThk) / W
cellH = (ymax - 2 * border - wallThk) / H
Randomize Timer
Screen _NewImage(SW, SH, 32)
_ScreenMove 100, 20
Line (0, 0)-(xmax, ymax), &HFFFFFF00, B
init_walls
generate_maze
show_maze
Sleep
Sub init_walls ()
Dim x As Integer, y As Integer
For x = 0 To W
For y = 0 To H
v_walls(x, y) = 1
h_walls(x, y) = 1
Next
Next
End Sub
Sub show_maze ()
Dim py As Single, px As Single, y As Integer, x As Integer
py = border
For y = 0 To H
px = border
For x = 0 To W
If x < W And h_walls(x, y) = 1 Then
Line (px, py)-Step(cellW + wallThk, wallThk), mazeClr, BF
End If
If y < H And v_walls(x, y) = 1 Then
Line (px, py)-Step(wallThk, cellH + wallThk), mazeClr, BF
End If
px = px + cellW
Next
py = py + cellH
Next
End Sub
Sub rand_cell (rWx, rHy)
rWx = Int(Rnd * 1000) Mod W
rHy = Int(Rnd * 1000) Mod H
End Sub
Sub get_unvisited (visited() As Integer, current As cell, unvisited() As cell, uvi As Integer)
ReDim unvisited(0) As cell
Dim x As Integer, y As Integer
x = current.x
y = current.y
uvi = 0
If x > 0 Then
If visited(x - 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x - 1
unvisited(uvi).y = y
End If
End If
If x < W - 1 Then
If visited(x + 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x + 1
unvisited(uvi).y = y
End If
End If
If y > 0 Then
If visited(x, y - 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y - 1
End If
End If
If y < H - 1 Then
If visited(x, y + 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y + 1
End If
End If
End Sub
Sub generate_maze ()
Dim visited(W, H) As Integer
Dim num_visited As Integer, num_cells As Integer, si As Integer
Dim cnt As Integer, rc As Integer, x As Integer, y As Integer
ReDim stack(0) As cell
Dim curr_cell As cell, next_cell As cell, cur_cell As cell
rand_cell cur_cell.x, cur_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = 1
num_cells = W * H
si = 0
While num_visited < num_cells
ReDim cells(0) As cell
cnt = 0
get_unvisited visited(), curr_cell, cells(), cnt
If cnt > 0 Then
' choose randomly one of the current cell's unvisited neighbours
rc = Int(Rnd * 100) Mod cnt + 1
next_cell.x = cells(rc).x
next_cell.y = cells(rc).y
' push the current cell to the stack
si = si + 1
ReDim _Preserve stack(si) As cell
stack(si).x = curr_cell.x
stack(si).y = curr_cell.y
' remove the wall between the current cell and the chosen cell
If next_cell.x = curr_cell.x Then
x = next_cell.x
y = max(next_cell.y, curr_cell.y)
h_walls(x, y) = 0
Else
x = max(next_cell.x, curr_cell.x)
y = next_cell.y
v_walls(x, y) = 0
End If
' make the chosen cell the current cell and mark it as visited
curr_cell.x = next_cell.x
curr_cell.y = next_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = num_visited + 1
ElseIf si > 0 Then
' pop a cell from the stack and make it the current cell
curr_cell.x = stack(si).x
curr_cell.y = stack(si).y
si = si - 1
ReDim _Preserve stack(si) As cell
Else
Exit While
End If
Wend
End Sub
Function max (a, b)
If a > b Then max = a Else max = b
End Function
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-09-2025, 11:39 PM
(This post was last modified: 08-09-2025, 11:43 PM by SierraKen.)
LOL yeah, I had no idea I had it ever since then. Feel free to make it larger if you want. I doubt I will touch it myself since there's a lot of math. Although someone can just add _FULLSCREEN at the top if they want.
Looks big B+, but I got an error message on it, maybe my QB64pe isn't updated enough. It says:
"Statement cannot be placed between SUBs/Functions."
On line 239:
Const xmax = 800, ymax = 600, SW = 1200, SH = 700 'maze pixels from 0,0 and screen SH, SW
|
