_TITLE "Amazing rat B+ trans 2018-06-15" 'from SmallBASIC to QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'2018-06-15 added more fun!
'rat runs whole maze.bas for SmallBASIC 0.12.6 [B+MGA] 2016-06-30
' mod of Chris maze gererator post
' Backtracking maze generator
' 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.
'
' model consts
CONST border
= margin
/ 2
cellW = (xmax - margin) / W
cellH = (ymax - margin) / H
' What's a maze with out a little white mouse?
init_walls
generate_maze
rX = 0: rY = 0: rd = 180
ti = 0
cheese = 0
'maze board
recf 0, 0, xmax, ymax
show_maze
'add to trail
ti = ti + 1
trail(ti).x = border + (rX + .5) * cellW
trail(ti).y = border + (rY + .5) * cellH
'bread crumbs or whatever...
fcirc trail(i).x, trail(i).y, 2
'draw cheese
fcirc border + (chx + .5) * cellW, border + (chy + .5) * cellH, .25 * cellH
'draw mouse
drawRat border + rX * cellW, border + rY * cellH, cellW, cellH, rd, cheese
'mouse find the cheese?
cheese = cheese + 1
ti = 0
'setup next move
IF h_walls
(rX
, rY
+ 1) = 0 THEN rY = rY + 1: rd = 90
rX = rX + 1
rY = rY - 1: rd = 270
rX = rX - 1: rd = 180
rX = rX - 1: rd = 180
rY = rY + 1
rX = rX + 1: rd = 0
rY = rY - 1: rd = 270
rY = rY - 1: rd = 270
rX = rX - 1
rY = rY + 1: rd = 90
rX = rX + 1: rd = 0
IF v_walls
(rX
+ 1, rY
) = 0 THEN rX = rX + 1: rd = 0
rY = rY - 1
rX = rX - 1: rd = 180
rY = rY + 1: rd = 90
v_walls(x, y) = 1
h_walls(x, y) = 1
'cls
py = border
px = border
recf px, py, px + cellW, py + 2
recf px, py, px + 2, py + cellH
px = px + cellW
py = py + cellH
SUB get_unvisited
(visited
(), current
AS cell
, unvisited
() AS cell
, uvi
) 'local n
x = current.x
y = current.y
uvi = 0
uvi = uvi + 1
unvisited(uvi).x = x - 1
unvisited(uvi).y = y
uvi = uvi + 1
unvisited(uvi).x = x + 1
unvisited(uvi).y = y
uvi = uvi + 1
unvisited(uvi).x = x
unvisited(uvi).y = y - 1
uvi = uvi + 1
unvisited(uvi).x = x
unvisited(uvi).y = y + 1
'local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
'local x, y
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
cnt = 0
get_unvisited visited(), curr_cell, cells(), cnt
' choose randomly one of the current cell's unvisited neighbours
next_cell.x = cells(rc).x
next_cell.y = cells(rc).y
' push the current cell to the stack
si = si + 1
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
x = max(next_cell.x, curr_cell.x)
y = next_cell.y
v_walls(x, y) = 0
' 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
' 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
SUB drawRat
(leftX
, topY
, cwidth
, cheight
, heading
, cheese
) 'local bcX, bcY, bR, neckX, neckY
bcX = leftX + .5 * cwidth
bcY = topY + .5 * cheight
bR = .5 * .5 * min(cwidth, cheight)
'local noseX :
noseX
= bcX
+ 2 * bR
* COS(rad
(heading
)) 'local noseY :
noseY
= bcY
+ 2 * bR
* SIN(rad
(heading
)) neckX
= bcX
+ .75 * bR
* COS(rad
(heading
)) neckY
= bcY
+ .75 * bR
* SIN(rad
(heading
)) 'local tailX :
tailX
= bcX
+ 2 * bR
* COS(rad
(heading
+ 180)) 'local tailY :
tailY
= bcY
+ 2 * bR
* SIN(rad
(heading
+ 180)) 'local earLX :
earLX
= bcX
+ bR
* COS(rad
(heading
- 30)) 'local earLY :
earLY
= bcY
+ bR
* SIN(rad
(heading
- 30)) 'local earRX :
earRX
= bcX
+ bR
* COS(rad
(heading
+ 30)) 'local earRY :
earRY
= bcY
+ bR
* SIN(rad
(heading
+ 30))
fcirc bcX, bcY, .65 * bR + 2 * cheese
fcirc neckX, neckY, bR * .3
ftri noseX
, noseY
, earLX
, earLY
, earRX
, earRY
, _RGB32(225, 225, 225) fcirc earLX, earLY, bR * .3
fcirc earRX, earRY, bR * .3
wX
= .7 * bR
* COS(rad
(heading
- 90 - 20)) wY
= .7 * bR
* SIN(rad
(heading
- 90 - 20)) ln noseX + wX, noseY + wY, noseX - wX, noseY - wY
wX
= .7 * bR
* COS(rad
(heading
- 90 + 20)) wY
= .7 * bR
* SIN(rad
(heading
- 90 + 20)) ln noseX + wX, noseY + wY, noseX - wX, noseY - wY
ln bcX, bcY, tailX, tailY
'Steve McNeil's copied from his forum note: Radius is too common a name
RadiusError = -subRadius
X = subRadius
Y = 0
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
LINE (CX
- X
, CY
)-(CX
+ X
, CY
), , BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), , BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), , BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), , BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), , BF
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
LINE (x1
, y1
)-(x2
, y2
), , B
SUB recf
(x1
, y1
, x2
, y2
) LINE (x1
, y1
)-(x2
, y2
), , BF
rad = a * pi / 180