Here is the QB64 version of the the Amazing Rat with some more amusements added:
_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 xmax = 1200
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
CONST W = 48
CONST H = 28
CONST margin = 25
CONST border = margin / 2
TYPE cell
x AS INTEGER
y AS INTEGER
END TYPE
DIM SHARED cellW
cellW = (xmax - margin) / W
DIM SHARED cellH
cellH = (ymax - margin) / H
DIM SHARED h_walls(W, H)
DIM SHARED v_walls(W, H)
DIM SHARED pi
pi = _PI
' What's a maze without a little white mouse
RANDOMIZE TIMER
init_walls
generate_maze
rX = 0: rY = 0: rd = 180
DIM trail AS cell
ti = 0
cheese = 0
chx = INT(RND * (W - 1)) + 1
chy = INT(RND * (H - 1)) + 1
WHILE 1
'maze board
COLOR _RGB32(155, 75, 32)
recf 0, 0, xmax, ymax
show_maze
'add to trail
ti = ti + 1
REDIM _PRESERVE trail(ti) AS cell
trail(ti).x = border + (rX + .5) * cellW
trail(ti).y = border + (rY + .5) * cellH
'bread crumbs or whatever...
COLOR _RGBA(8, 4, 2, 40)
FOR i = 1 TO ti
fcirc trail(i).x, trail(i).y, 2
NEXT
'draw cheese
COLOR _RGB32(200, 180, 0)
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?
IF rX = chx AND rY = chy THEN
cheese = cheese + 1
chx = INT(RND * (W - 1)) + 1
chy = INT(RND * (H - 1)) + 1
ti = 0
REDIM trail(ti) AS cell
_DELAY 1
END IF
_DISPLAY
_DELAY .2
'setup next move
SELECT CASE rd
CASE 0
IF h_walls(rX, rY + 1) = 0 THEN
rY = rY + 1: rd = 90
ELSEIF v_walls(rX + 1, rY) = 0 THEN
rX = rX + 1
ELSEIF h_walls(rX, rY) = 0 THEN
rY = rY - 1: rd = 270
ELSE
rX = rX - 1: rd = 180
END IF
CASE 90
IF v_walls(rX, rY) = 0 THEN
rX = rX - 1: rd = 180
ELSEIF h_walls(rX, rY + 1) = 0 THEN
rY = rY + 1
ELSEIF v_walls(rX + 1, rY) = 0 THEN
rX = rX + 1: rd = 0
ELSE
rY = rY - 1: rd = 270
END IF
CASE 180
IF h_walls(rX, rY) = 0 THEN
rY = rY - 1: rd = 270
ELSEIF v_walls(rX, rY) = 0 THEN
rX = rX - 1
ELSEIF h_walls(rX, rY + 1) = 0 THEN
rY = rY + 1: rd = 90
ELSE
rX = rX + 1: rd = 0
END IF
CASE 270
IF v_walls(rX + 1, rY) = 0 THEN
rX = rX + 1: rd = 0
ELSEIF h_walls(rX, rY) = 0 THEN
rY = rY - 1
ELSEIF v_walls(rX, rY) = 0 THEN
rX = rX - 1: rd = 180
ELSE
rY = rY + 1: rd = 90
END IF
END SELECT
WEND
SUB init_walls ()
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 ()
COLOR _RGB32(180, 90, 45)
'cls
py = border
FOR y = 0 TO H
px = border
FOR x = 0 TO W
IF x < W AND h_walls(x, y) = 1 THEN
recf px, py, px + cellW, py + 2
END IF
IF y < H AND v_walls(x, y) = 1 THEN
recf px, py, px + 2, py + cellH
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(), current AS cell, unvisited() AS cell, uvi)
'local n
REDIM unvisited(0) AS cell
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 ()
'local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
'local x, y
DIM visited(W, H)
REDIM stack(0) AS cell
DIM curr_cell AS cell
DIM next_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
SUB drawRat (leftX, topY, cwidth, cheight, heading, cheese)
COLOR _RGB32(225, 225, 225)
'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
END SUB
'Steve McNeil's copied from his forum note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
DIM subRadius AS LONG, RadiusError AS LONG
DIM X AS LONG, Y AS LONG
subRadius = ABS(R)
RadiusError = -subRadius
X = subRadius
Y = 0
IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
' 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
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
WEND
END SUB
' found at QB64.net: http://www.qb64.net/forum/index.php?topic=14425.0
SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
a& = _NEWIMAGE(1, 1, 32)
_DEST a&
PSET (0, 0), K
_DEST 0
_MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
_FREEIMAGE a& '<<< this is important!
END SUB
SUB ln (x1, y1, x2, y2)
LINE (x1, y1)-(x2, y2)
END SUB
SUB rec (x1, y1, x2, y2)
LINE (x1, y1)-(x2, y2), , B
END SUB
SUB recf (x1, y1, x2, y2)
LINE (x1, y1)-(x2, y2), , BF
END SUB
FUNCTION max (a, b)
IF a > b THEN max = a ELSE max = b
END FUNCTION
FUNCTION min (a, b)
IF a > b THEN min = b ELSE min = a
END FUNCTION
FUNCTION rad (a)
rad = a * pi / 180
END FUNCTION
Maybe John can get a JS version of it?
Here is a 12 x 7 maze screen shot when the rat has had a couple of hits of cheese:
