RetroBASIC

Basicprogramming(.org) => Code and examples => Topic started by: B+ on July 01, 2016, 04:20:19 AM

Title: Rat Runner for Maze Maker
Post by: B+ on July 01, 2016, 04:20:19 AM

Code: [Select]

'rat runs whole maze.bas for SmallBASIC 0.12.6 [B+MGA] 2016-06-30

' 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 W = 40
const H = 30
const margin = 25
const border = margin / 2
const cellW = (xmax - margin) / W
const cellH = (ymax - margin) / H
dim h_walls(0 to W, 0 to H)
dim v_walls(0 to W, 0 to H)

func init_walls()
  local x,y
  for x = 0 to W
    for y = 0 to H
      v_walls(x, y) = 1
      h_walls(x, y) = 1
    next y
  next x
end

sub show_maze()
  local py, px

  local wallc, x, y
 
  wallc = rgb(80, 80, 80)
  'cls
  py = border
  for y = 0 to H
    px = border
    for x = 0 to W
      'wallc += 255
      'wallc = rgb(0,0, 32 + x/W * 223)
      if (x < W && h_walls(x, y)) then
        rect px, py, px + cellW, py+2, wallc FILLED
      fi
      if (y < H && v_walls(x, y)) then
        rect px, py, px+2, py + cellH, wallc FILLED
      fi
      px += cellW
    next y
    py += cellH
  next x
end

func rand_cell()
  rand_cell = [rnd * 1000 % W, rnd * 1000 % H]
end

func get_unvisited(byref visited, byref current)
  local n
  dim n
  local x = current(0)
  local y = current(1)
  if (x > 0 && visited(x - 1, y) == false) then
    n << [x - 1, y]
  endif
  if (x < W - 1 && visited(x + 1, y) == false) then
    n << [x + 1, y]
  endif
  if (y > 0 && visited(x, y - 1) == false) then
    n << [x, y - 1]
  endif
  if (y < H -1 && visited(x, y + 1) == false) then
    n << [x, y + 1]
  endif
  get_unvisited = n
end
 
func generate_maze()
  local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
  local x, y
  dim visited(W, H)
  dim stack

  curr_cell = rand_cell()
  visited(curr_cell(0), curr_cell(1)) = true
  num_visited = 1
  num_cells = W * H

  while num_visited < num_cells
    cells = get_unvisited(visited, curr_cell)
    if (len(cells) > 0) then
      ' choose randomly one of the current cell's unvisited neighbours
      next_cell = cells((rnd * 100) % len(cells))

      ' push the current cell to the stack
      stack << curr_cell
         
      ' remove the wall between the current cell and the chosen cell
      if (next_cell(0) == curr_cell(0)) then
        x = next_cell(0)
        y = max(next_cell(1), curr_cell(1))
        h_walls(x, y) = 0
      else
        x = max(next_cell(0), curr_cell(0))
        y = next_cell(1)
        v_walls(x, y) = 0
      fi

      ' make the chosen cell the current cell and mark it as visited
      curr_cell = next_cell
      visited(curr_cell(0), curr_cell(1)) = true
      num_visited++
    else if (len(stack) > 0) then
      ' pop a cell from the stack and make it the current cell
      local idx = len(stack) - 1
      curr_cell = stack(idx)
      delete stack, idx, 1
    else
      exit loop
    endif
  wend   
end

'Fast Filled Triangle Sub by AndyAmaya
sub filltri(x1, y1, x2, y2, x3, y3)
  x1 = x1\1 : y1 = y1\1 : x2 = x2\1: y2 = y2\1 : x3 = x3\1 : y3 = y3\1
  local x, y, length, slope1, slope2, slope3
  'triangle coordinates must be ordered: where x1 < x2 < x3
  if x2 < x1 then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
  'swap x1, y1, with x3, y3
  if x3 < x1 then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
  'swap x2, y2 with x3, y3
  if x3 < x2 then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
  if x1 <> x3 then slope1 = (y3 - y1) / (x3 - x1)
  'draw the first half of the triangle
  length = x2 - x1
  if length <> 0 then
    slope2 = (y2 - y1) / (x2 - x1)
    for x = 0 to length
      line int(x + x1), int(x * slope1 + y1), int(x + x1), int(x * slope2 + y1)
    next
  end if
  'draw the second half of the triangle
  y = length * slope1 + y1 : length = x3 - x2
  if length <> 0 then
    slope3 = (y3 - y2) / (x3 - x2)
    for x = 0 To length
      line int(x + x2), int(x * slope1 + y), int(x + x2), int(x * slope3 + y2)
    next
  end if
  line x1, y1, x2, y2
  line x2, y2, x1, y1
  line x2, y2, x3, y3
  line x3, y3, x2, y2
  line x1, y1, x3, y3
  line x3, y3, x1, y1
end

sub drawRat(leftX, topY, cwidth, cheight, heading)
  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))
 
  circle bcX, bcY, .65 *bR filled
  circle neckX, neckY, bR * .3 filled
  fillTri(noseX, noseY, earLX, earLY, earRX, earRY)
  circle earLX, earLY, bR * .3 filled
  circle earRX, earRY, bR * .3 filled
 
  local wX = .7 * bR * cos(rad(heading - 90 - 20))
  local wY = .7 * bR * sin(rad(heading - 90 - 20))
  line noseX + wX, noseY + wY, noseX - wX, noseY - wY
  wX = .7 * bR * cos(rad(heading - 90 + 20))
  wY = .7 * bR * sin(rad(heading - 90 + 20))
  line noseX + wX, noseY + wY, noseX - wX, noseY- wY
  line bcx, bcy, tailX, tailY
end
 
randomize
't=ticks
init_walls
generate_maze
rX = 0 : rY = 0 : rd = 180

while 1
  cls
  show_maze
  color 12, 0
  drawRat border + rX * cellW, border + rY * cellH, cellW, cellH, rd
  'circle border + rX * cellW + .5 * cellW, border + rY * cellH + .5*cellH, 4 filled
  showpage
  delay 50
  'setup next move
  select case rd
  case 0
    if h_walls(rX, rY + 1) = 0 then
      rY += 1 : rd = 90
    elif v_walls(rX + 1, rY) = 0
      rX +=1
    elif h_walls(rX, rY) = 0
      rY -= 1 : rd = 270
    else
      rX -=1 : rd = 180
    fi
   
  case 90
    if v_walls(rX, rY ) = 0 then
      rX -= 1 : rd = 180
    elif h_walls(rX, rY+1) = 0
      rY +=1
    elif v_walls(rX+1,rY) = 0
      rX +=1 : rd = 0
    else
      rY -=1 : rd = 270
    fi 
       
  case 180
    if h_walls(rX, rY) = 0 then
      rY -= 1 : rd = 270
    elif v_walls(rX, rY) = 0 then
      rX -= 1
    elif h_walls(rX, rY + 1) =0 then
      rY += 1 : rd = 90
    else
      rX += 1 : rd = 0
    fi 
   
  case 270
    if v_walls(rX + 1, ry) = 0 then
      rX += 1 : rd = 0
    elif h_walls(rX,rY) = 0
      rY -= 1
    elif v_walls(rX, rY) = 0
      rX -= 1 : rd = 180
   else
      rY +=1 : rd = 90
    fi
  end select
wend



Title: Smarter Rat?
Post by: B+ on July 04, 2016, 02:32:00 AM

Johnno get your stopwatch ready, I think I have a smarter rat.

Code: [Select]

'Smarter rat?.bas for SmallBASIC 0.12.6 [B+MGA] 2016-07-03

' OK after painstaking breeding and carefully controlled experiments
'with genetic drugs I think I have developed a smarter breed of
'maze running rat, what do you think?

' 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 W = 40
const H = 30
const margin = 25
const border = margin / 2
const cellW = (xmax - margin) / W
const cellH = (ymax - margin) / H
dim h_walls(0 to W, 0 to H)
dim v_walls(0 to W, 0 to H)

func init_walls()
  local x,y
  for x = 0 to W
    for y = 0 to H
      v_walls(x, y) = 1
      h_walls(x, y) = 1
    next y
  next x
end
sub show_maze()
  local py, px

  local wallc, x, y
 
  wallc = rgb(80, 80, 80)
  'cls
  py = border
  for y = 0 to H
    px = border
    for x = 0 to W
      'wallc += 255
      'wallc = rgb(0,0, 32 + x/W * 223)
      if (x < W && h_walls(x, y)) then
        rect px, py, px + cellW, py+2, wallc FILLED
      fi
      if (y < H && v_walls(x, y)) then
        rect px, py, px+2, py + cellH, wallc FILLED
      fi
      px += cellW
    next y
    py += cellH
  next x
end
func rand_cell()
  rand_cell = [rnd * 1000 % W, rnd * 1000 % H]
end
func get_unvisited(byref visited, byref current)
  local n
  dim n
  local x = current(0)
  local y = current(1)
  if (x > 0 && visited(x - 1, y) == false) then
    n << [x - 1, y]
  endif
  if (x < W - 1 && visited(x + 1, y) == false) then
    n << [x + 1, y]
  endif
  if (y > 0 && visited(x, y - 1) == false) then
    n << [x, y - 1]
  endif
  if (y < H -1 && visited(x, y + 1) == false) then
    n << [x, y + 1]
  endif
  get_unvisited = n
end
sub bye
  while (border+rX*cellW+.5*cellW-75<xmax) and (border+rY*cellH+.5*cellY+75>0)
    if r <= 100 then
    for r = 15 to 100:cls:show_maze:color 12,0
      circle border + rX * cellW + .5 * cellW, border + rY * cellH + .5*cellY, r filled
      if r > 50 then rX = rX + .1 : rY = rY - .1
      showpage:delay 200:next
    else
      cls:show_maze:color 12,0:rX = rX + .1 : rY = rY - .1
      circle border + rX * cellW + .5 * cellW, border + rY * cellH + .5*cellY, r filled
      showpage:delay 200
    fi
  wend
  stop
end
func generate_maze()
  local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
  local x, y
  dim visited(W, H)
  dim stack

  curr_cell = rand_cell()
  visited(curr_cell(0), curr_cell(1)) = true
  num_visited = 1
  num_cells = W * H

  while num_visited < num_cells
    cells = get_unvisited(visited, curr_cell)
    if (len(cells) > 0) then
      ' choose randomly one of the current cell's unvisited neighbours
      next_cell = cells((rnd * 100) % len(cells))

      ' push the current cell to the stack
      stack << curr_cell
         
      ' remove the wall between the current cell and the chosen cell
      if (next_cell(0) == curr_cell(0)) then
        x = next_cell(0)
        y = max(next_cell(1), curr_cell(1))
        h_walls(x, y) = 0
      else
        x = max(next_cell(0), curr_cell(0))
        y = next_cell(1)
        v_walls(x, y) = 0
      fi

      ' make the chosen cell the current cell and mark it as visited
      curr_cell = next_cell
      visited(curr_cell(0), curr_cell(1)) = true
      num_visited++
    else if (len(stack) > 0) then
      ' pop a cell from the stack and make it the current cell
      local idx = len(stack) - 1
      curr_cell = stack(idx)
      delete stack, idx, 1
    else
      exit loop
    endif
  wend   
end
'Fast Filled Triangle Sub by AndyAmaya
sub filltri(x1, y1, x2, y2, x3, y3)
  x1 = x1\1 : y1 = y1\1 : x2 = x2\1: y2 = y2\1 : x3 = x3\1 : y3 = y3\1
  local x, y, length, slope1, slope2, slope3
  'triangle coordinates must be ordered: where x1 < x2 < x3
  if x2 < x1 then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
  'swap x1, y1, with x3, y3
  if x3 < x1 then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
  'swap x2, y2 with x3, y3
  if x3 < x2 then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
  if x1 <> x3 then slope1 = (y3 - y1) / (x3 - x1)
  'draw the first half of the triangle
  length = x2 - x1
  if length <> 0 then
    slope2 = (y2 - y1) / (x2 - x1)
    for x = 0 to length
      line int(x + x1), int(x * slope1 + y1), int(x + x1), int(x * slope2 + y1)
    next
  end if
  'draw the second half of the triangle
  y = length * slope1 + y1 : length = x3 - x2
  if length <> 0 then
    slope3 = (y3 - y2) / (x3 - x2)
    for x = 0 To length
      line int(x + x2), int(x * slope1 + y), int(x + x2), int(x * slope3 + y2)
    next
  end if
  line x1, y1, x2, y2
  line x2, y2, x1, y1
  line x2, y2, x3, y3
  line x3, y3, x2, y2
  line x1, y1, x3, y3
  line x3, y3, x1, y1
end
sub drawRat(leftX, topY, cwidth, cheight, heading)
  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))
 
  circle bcX, bcY, .65 *bR filled
  circle neckX, neckY, bR * .3 filled
  fillTri(noseX, noseY, earLX, earLY, earRX, earRY)
  circle earLX, earLY, bR * .3 filled
  circle earRX, earRY, bR * .3 filled
 
  local wX = .7 * bR * cos(rad(heading - 90 - 20))
  local wY = .7 * bR * sin(rad(heading - 90 - 20))
  line noseX + wX, noseY + wY, noseX - wX, noseY - wY
  wX = .7 * bR * cos(rad(heading - 90 + 20))
  wY = .7 * bR * sin(rad(heading - 90 + 20))
  line noseX + wX, noseY + wY, noseX - wX, noseY- wY
  line bcx, bcy, tailX, tailY
end
 
randomize
't=ticks
init_walls
generate_maze
rX = 0 : rY = 0 : rd = 180

while 1
  cls
  show_maze
  color 12, 0
  drawRat border + rX * cellW, border + rY * cellH, cellW, cellH, rd
  'circle border + rX * cellW + .5 * cellW, border + rY * cellH + .5*cellH, 4 filled
  showpage
  delay 100
  'setup next move
  select case rd
  case 0
    if h_walls(rX, rY + 1) = 0 then
      rY += 1 : rd = 90
    elif v_walls(rX + 1, rY) = 0
      rX +=1
    elif h_walls(rX, rY) = 0
      rY -= 1 : rd = 270
    else
      rX -=1 : rd = 180
    fi
   
  case 90
    if v_walls(rX, rY ) = 0 then
      rX -= 1 : rd = 180
    elif h_walls(rX, rY+1) = 0
      rY +=1
    elif v_walls(rX+1,rY) = 0
      rX +=1 : rd = 0
    else
      rY -=1 : rd = 270
    fi 
       
  case 180
    if h_walls(rX, rY) = 0 then
      rY -= 1 : rd = 270
    elif v_walls(rX, rY) = 0 then
      rX -= 1
    elif h_walls(rX, rY + 1) =0 then
      rY += 1 : rd = 90
    else
      rX += 1 : rd = 0
    fi 
   
  case 270
    if v_walls(rX + 1, ry) = 0 then
      rX += 1 : rd = 0
    elif h_walls(rX,rY) = 0
      rY -= 1
    elif v_walls(rX, rY) = 0
      rX -= 1 : rd = 180
   else
      rY +=1 : rd = 90
    fi
  end select
  if rX = W/2 and rY = H/2 then bye
wend


Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 16, 2018, 04:08:49 PM

Here is the QB64 version of the the Amazing Rat with some more amusements added:

Code: [Select]

_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:

Title: Re: Rat Runner for Maze Maker
Post by: ScriptBasic on June 16, 2018, 08:17:27 PM

If I remember correctly, NaaLaa is the master maze software to use.

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 17, 2018, 01:03:52 PM

Quote from: John on June 16, 2018, 08:17:27 PM

If I remember correctly, NaaLaa is the master maze software to use.

Software? Maze making just takes a few lines of code. Could probably do it in less than 100. hmm... now I wonder what is minimal?

Title: Re: Rat Runner for Maze Maker
Post by: ZXDunny on June 17, 2018, 04:09:06 PM

You want minimal maze-making code? :)

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 17, 2018, 04:28:39 PM

Yeah this one-liner (but not one statement) is not navigable for mouse looking for cheese... ie so that any spot can be reached from any other (you can always get there from here...)

Code: [Select]

SCREEN _NEWIMAGE(560, 420, 32): _FONT 8: DO WHILE i < 80 * 60: _PRINTSTRING ((i MOD 80) * 7, INT(i / 80) * 7), CHR$(45 * INT(RND * 2) + 47): i = i + 1: LOOP


Title: Re: Rat Runner for Maze Maker
Post by: ZXDunny on June 17, 2018, 05:59:46 PM

This one generates navigable mazes:

Code: [Select]

10 mw=(scrw/8)-1,mh=(scrh/8)-1:
   DIM map(mw,mh) BASE 0
20 m$="1"*mw*mh,
   b$="1"*mw+(("1"+(" "*(mw-2))+"1")*(mh-2))+("1"*mw),
   cc=mw+2:
   DIM of=-1,-mw,1,mw:
   m$(cc)="0",stk$=QCHR$ cc:
   DIM nb(4)
30 nn=0:
   FOR n=1 TO 4:
      IF b$(cc+of(n))<>"1" THEN
         IF m$(cc+(of(n)*2))<>"0" THEN    nn+=1:
            nb(nn)=n
40 NEXT n
50 IF nn>0 THEN
      o=of(nb(INT(RND*nn)+1)),
      m$(cc+o),m$(cc+(o*2))="0",
      stk$=(QCHR$(cc) AND nn>1)+stk$:
      cc+=o*2:
      GO TO 30
60 IF stk$<>"" THEN
      cc=QCODE stk$,stk$=stk$(5 TO):
      GO TO 30
70 FOR n=0 TO LEN m$-1:
      map(n MOD mw,n DIV mw)=VAL m$(n+1)*208:
   NEXT n:
   map(mw-1,mh-2)=0
80 for y=0 to mh-1:
      for x=0 to mw-1:
         print at y,x;"ð"(map(x,y)>0);:
      next x:
   next y

(https://s8.postimg.cc/gejzt8g1h/screenshot_38.png)

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 17, 2018, 07:10:53 PM

Nice, looks like either black or gray could serve as wall or path but gray looks the better choice for path since it has only one exit to "outside" edge.

Title: Re: Rat Runner for Maze Maker
Post by: ScriptBasic on June 18, 2018, 03:20:14 AM

When I mentioned NaaLaa, I was speaking of Doom like mazes. Marcus has a few examples that would make a great starting point.

Title: Re: Rat Runner for Maze Maker
Post by: Mike Lobanovsky on June 18, 2018, 05:24:24 AM

Quote from: John on June 18, 2018, 03:20:14 AM

... I was speaking of Doom like mazes.

Actually, any general purpose BASIC interpreter with minimum GDI graphics can generate exploitable Doom- or Castle of Wolfenstein-like mazes. A little slow to navigate in real time but still quite usable as long as the viewport size remains small enough, say, 640x480 pixels large.

The technique is called ray casting (https://en.wikipedia.org/wiki/Ray_casting):
(https://i.stack.imgur.com/lLFb3.png)

Title: Re: Rat Runner for Maze Maker
Post by: ZXDunny on June 18, 2018, 09:34:45 AM

Like this, Mike?

http://www.zxspectrum4.net/forum/viewtopic.php?f=8&t=150

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 18, 2018, 03:22:05 PM

Ah raycasting! That's what John meant... yes a faster graphics is needed for that, but these days even SmallBASIC, a straight interpreter, can handle it. JS could run rings around it, I bet!

Never liked that view of things, too much like being the rat stuck inside the maze. Such a limited view, of course our freeways are getting like that, specially in urban areas.  :(

Title: Re: Rat Runner for Maze Maker
Post by: ScriptBasic on June 18, 2018, 03:48:24 PM

Quote

Never liked that view of things, too much

That's why it's called Doom.  :)

Title: Re: Rat Runner for Maze Maker
Post by: Mike Lobanovsky on June 18, 2018, 04:08:11 PM

Quote from: ZXDunny on June 18, 2018, 09:34:45 AM

Like this, Mike?

http://www.zxspectrum4.net/forum/viewtopic.php?f=8&t=150

Exactly!

Quote from: B+ on June 18, 2018, 03:22:05 PM

... too much like being the rat stuck inside the maze.

That's it! But it does generate adrenaline as you're running for your life, doesn't it? :)

Quote from: John on June 18, 2018, 03:48:24 PM

That's why it's called Doom.  :)

That's correct! :D

Title: Re: Rat Runner for Maze Maker
Post by: Mike Lobanovsky on June 18, 2018, 05:03:05 PM

I used to experiment with ray casting a lot. It's usually quite easy to implement collision detection in it so that you wouldn't fall through the walls whenever you run into them and thus you wouldn't wander into the areas that aren't defined by the maze. (Fig.1 below).

But the real adventure starts when you disable collision detection (or happen to occasionally fall through due to imperfect emulation of wall solidity in simple collision detection algos) and do go beyond the maze outer wall! Then, depending on whether your BASIC has been compiled with a C (or Asm) compiler that can handle floating-point infinities and NaNs gracefully rather than throw an FPU divide-by-zero exceptions, you can enter the world of objects that really aren't there on your maze map! :D

You can see objects of strange patterns and colors that weren't there in your original palette (Figs.2 and 3), or objects that are mutually orientated at angles different than purely orthogonal (Figs.4 and 5).

And in certain cases, if you have enough free system memory, you can come across wide spaces where your virtual (undefined!) maze extends as far as, and possibly beyond, your visible horizon (Fig.6)! You can't however reach the far distant wall; your app will crash somewhere in the middle of the passageway. :D

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 18, 2018, 06:35:37 PM

Ah Mike! Welcome to the Matrix!  ;D

Title: Re: Rat Runner for Maze Maker
Post by: ScriptBasic on June 19, 2018, 01:57:41 AM

Here is an article that teaches you how to build 3D mazes in JavaScript / CSS.

https://www.sitepoint.com/art-science-javascript/

Title: Re: Rat Runner for Maze Maker
Post by: B+ on June 19, 2018, 12:33:45 PM

SmallBASIC sample is 286 lines, started by Rick:

Code: [Select]

'Raycaster with definekey.bas for SmallBASIC 0.12.6 [B+=MGA] 2016-06-17
' Raycaster maze Ricks copy from SB 2016-06-17
' MGA modified with definekey all inkey stuff removed
' still quits with esc and now q

' uses a simple ray casting technique (see lodev.org for tutorial) to draw
' vertical stripes down the graphics window.

' Each stripe is drawn to a size dependent upon the distance of the wall from the viewer.
' "Rays" are cast across a viewing plane in front of the viewer, from left to right.
' the height of the wall stripe depends on the distance of the wall from the viewer.

'InitialSetup
' set up screen width and height
' values also used to determine the width and height of the "viewing plane"
' "size" is used to determine the width of each vertical line drawn.
' a smaller value makes the walls sharper, but draws slower (there are more lines)
' a larger value makes the walls blockier, but draws more quickly

'these replace INKEY catching
definekey 0xFF04, moveLeft    'press left arrow or ccw
definekey 0xFF05, moveRight   'press right arrow or cw
definekey 0xFF09, moveForward 'press up arrow, forward
definekey 0xFF0A, moveBack    'press down arrow, back
definekey 0x0071, quit        'press q
definekey 0x001B, quit        'press esc

but maze generator was not built into it.