Random plumbing generator in QBasic

plumbing.bas

' https://codegolf.stackexchange.com/questions/62894/plumbing-random-paths
' Deluxe ungolfed version, using depth-first search
' Does not wrap on the boundaries
' Uses black for background, gray for pipe walls, blue for pipe insides

' scale is how many pixels wide the inside of a pipe is
CONST scale = 5
' tick_amt# is the animation delay in seconds
' If < 0, prompt at each step instead
CONST tick_amt# = 0.1

CONST black = 0
CONST blue = 1
CONST gray = 7
CONST white = 15

RANDOMIZE TIMER
SCREEN 9
CLS
INPUT "Grid width"; w
INPUT "Grid height"; h
INPUT "Steps"; s

IF s = 0 THEN CLS: END

' possible_moves(i) stores an integer representing the moves at step i
' that haven't been tried yet
DIM possible_moves(s)
' moves(i) stores the move that was tried at step i
DIM SHARED moves(s)

' If we need to do a hard reset (start over with a new start cell), this
' is the place to GOTO
restart:

' Initialize all elements of possible_moves to -1
' The idea is that possible_moves(i) is -1 if we haven't gotten to
' step i yet; it's 0 if we have gotten to step i but have exhausted
' all potential moves at that step
FOR i = 1 TO s
  possible_moves(i) = -1
NEXT i

startx = INT(RND * w)
starty = INT(RND * h)
search_depth = 1

DO
loop_begin:

' At the top of the loop, set x,y to startx,starty and call the draw_path
' subprogram
' draw_path draws a path starting at x,y according to the moves given in
' the moves array; it also modifies x and y, so that they are pointing
' to the end of the path
x = startx
y = starty
CALL draw_path(x, y, search_depth - 1)

IF search_depth = s THEN
  ' The path is the proper length
  IF crossing THEN
    ' Unfortunately, it ends while trying to do a crossing, so backtrack
    CALL delay
    search_depth = search_depth - 1
    GOTO loop_begin
  ELSE
    ' Otherwise, success
    END
  END IF
END IF

IF search_depth < 1 THEN
  ' Backtracking has gotten all the way back to the original cell;
  ' this means there is no valid path beginning at that start cell
  ' (can happen especially with input 3,3,9), so restart to generate
  ' a new start cell
  GOTO restart
END IF

IF possible_moves(search_depth) = -1 THEN
  ' We are at a new search depth and need to generate a random
  ' permutation of the numbers 1234, representing the order in which
  ' we will try potential moves (where the numbers 1-4 each represent
  ' a direction in which to move from a given cell)
  ' To make sure each number is included exactly once, we use an
  ' integer as a bitstring, with its 2^1, 2^2, 2^3, and 2^4 bits
  ' initially set
  permutation_bitstring = 30   ' 11110
  ' The value of possible_moves(i) is an integer representing a base 5
  ' number with four digits, which stores a permutation of the numbers 1-4
  possible_moves(search_depth) = 0
  WHILE permutation_bitstring > 0
    dir = INT(RND * 4) + 1
    ' Check whether we've seen this direction before (AND is bitwise)
    IF permutation_bitstring AND 2 ^ dir THEN
      ' If not seen before, add it to the permutation and unset its
      ' flag in the bitstring
      possible_moves(search_depth) = possible_moves(search_depth) * 5 + dir
      permutation_bitstring = permutation_bitstring - 2 ^ dir
    END IF
  WEND
END IF

' Retrieve the next potential direction from possible_moves and store it
' in moves
get_direction:
dir = possible_moves(search_depth) MOD 5
possible_moves(search_depth) = possible_moves(search_depth) \ 5
moves(search_depth) = dir
' Calculate cell if we move in this direction
' 1 = up, 2 = left, 3 = down, 4 = right
IF dir = 2 THEN dx = -1 ELSE IF dir = 4 THEN dx = 1 ELSE dx = 0
IF dir = 1 THEN dy = -1 ELSE IF dir = 3 THEN dy = 1 ELSE dy = 0
a = x + dx
b = y + dy

' Grab the values of pixels from the screen to figure out whether this is
' a valid move or not
' A move is valid if the moved-to cell is in bounds and:
' 1) The moved-to cell is empty; or
' 2) Both
'    a) The moved-to cell contains a pipe going straight through,
'       either horizontally or vertically, and
'    b) The new pipe section does not double up an existing pipe section
center = POINT((a*5+2)*scale, (b*5+2)*scale)
left = POINT((a*5)*scale, (b*5+2)*scale)
right = POINT((a*5+4)*scale, (b*5+2)*scale)
top = POINT((a*5+2)*scale, (b*5)*scale)
bottom = POINT((a*5+2)*scale, (b*5+4)*scale)
pipe_midpoint = POINT(((a*5+x*5)\2+2)*scale, ((b*5+y*5)\2+2)*scale)
empty = (center = black)
horizontal = (left = blue) AND (right = blue)
vertical = (top = blue) AND (bottom = blue)
crossing = (horizontal OR vertical) AND (pipe_midpoint = black)
in_bounds = a>=0 AND b>=0 AND a<w AND b<h
IF (empty OR crossing) AND in_bounds THEN
  ' This is a valid move; proceed
  search_depth = search_depth + 1
ELSEIF possible_moves(search_depth) > 0 THEN
  ' This is an invalid move; try the next potential move
  GOTO get_direction
ELSE
  ' All moves are exhausted; backtrack
  possible_moves(search_depth) = -1
  search_depth = search_depth - 1
END IF

CALL delay

LOOP


' Wait amt# seconds; or if amt#  is less than 0, wait for user keypress
SUB delay
  IF tick_amt# < 0 THEN
    dont_care$ = INPUT$(1)
  ELSE
    starttime# = TIMER
    endtime# = starttime# + tick_amt#
    WHILE TIMER < endtime#
      IF TIMER < starttime# THEN
        ' TIMER wraps back to 0 at midnight; adjust endtime# accordingly
        endtime# = endtime# - 24*60*60
      END IF
    WEND
  END IF
END SUB

' Draw a path, starting at (x, y), with the given number of steps,
' based on the information stored in the moves array
' Also draw a white rectangle around the outside of the grid
SUB draw_path(x, y, steps)
  SHARED w, h
  CLS
  CALL draw_point(x, y)
  FOR i = 1 TO steps
    dir = moves(i)
    IF dir = 2 THEN dx = -1 ELSE IF dir = 4 THEN dx = 1 ELSE dx = 0
    IF dir = 1 THEN dy = -1 ELSE IF dir = 3 THEN dy = 1 ELSE dy = 0
    a = x + dx
    b = y + dy
    CALL draw_point(a, b)
    CALL draw_connection(x, y, dir)
    x = a
    y = b
  NEXT
  LINE (-1, -1)-(w*5*scale, h*5*scale), white, B
END SUB

' Draw a pipe stub in the center of the given cell (x, y)
SUB draw_point(x, y)
  LINE ((x*5+1)*scale, (y*5+1)*scale)-((x*5+4)*scale-1, (y*5+4)*scale-1), gray, BF
  LINE ((x*5+2)*scale, (y*5+2)*scale)-((x*5+3)*scale-1, (y*5+3)*scale-1), blue, BF
END SUB

' Draw a connecting pipe starting at (x, y) and going in the given direction
' In the below diagram, the asterist represents the pixel (x*5, y*5), the X
' is the center of the current cell, the @'s are the pipe walls after
' calling draw_point(x, y), and the o's are the centers of neighboring cells
'      .....
'      .....
'      ..o..
'      .....
'      .....
' .....*.........
' ......@@@......
' ..o...@X@...o..
' ......@@@......
' ...............
'      .....
'      .....
'      ..o..
'      .....
'      .....
SUB draw_connection(x, y, dir)
  IF dir = 1 THEN
    ' Up
    vert = 1
    horiz = 0
    x1 = x*5+1
    y1 = y*5-2
    x2 = x*5+4
    y2 = y*5+2
  ELSEIF dir = 2 THEN
    ' Left
    vert = 0
    horiz = 1
    x1 = x*5-2
    y1 = y*5+1
    x2 = x*5+2
    y2 = y*5+4
  ELSEIF dir = 3 THEN
    ' Down
    vert = 1
    horiz = 0
    x1 = x*5+1
    y1 = y*5+3
    x2 = x*5+4
    y2 = y*5+7
  ELSEIF dir = 4 THEN
    ' Right
    vert = 0
    horiz = 1
    x1 = x*5+3
    y1 = y*5+1
    x2 = x*5+7
    y2 = y*5+4
  END IF
  LINE (x1*scale, y1*scale)-(x2*scale-1, y2*scale-1), gray, BF
  LINE ((x1+vert)*scale, (y1+horiz)*scale)-((x2-vert)*scale-1, (y2-horiz)*scale-1), blue, BF
END SUB