08-22-2023, 08:15 PM
I wrote some code for using those mazes for walking around in. I either can't find it or I took all the angles and made them rectilinear:
It's a 2 tile system:
I think that's the code I was remembering.
It's a 2 tile system:
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
LoopI think that's the code I was remembering.
b = b + ...