Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Random plumbing generator in QBasic
' 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment