kent@xanth.cs.odu.edu (Kent Paul Dolan) (10/08/87)
In response to a terrifying dearth of AmigaBASIC software, I submit
the following piece of cute trivia for the USENet community. My
friends claim it is fun to watch the mazes grow. My friends are
mostly pretty weird.
Hex_maze.bas is a program that designs hexagonal mazes on the Amiga's
screen. There are 5 sizes of maze available, from a quick demo to an
hours long "killer maze".
The program desperately needs the AmigaBASIC Compiler ((C) by
whomever). I don't own it, but I tried it on this at a friends house
before I added the menus to this program, and it cut down the run time
for the biggest maze from 135 minutes to about 7 minutes. Super tool!
(Plug, plug! ;-)
The only thing nice about this program besides the cute mazes is the
maze generating algorithm. A hex grid is drawn. All of its cells are
assigned to the exterior of the maze. Then a starting cell is chosen
from the grid at random. It is assigned to the maze interior and the
(up to) six cells around it are added to the (up to now empty) list of
the boundary cells. Thereafter, a cell is chosen at random from the
boundary list, moved to the maze interior, a wall is knocked out
between it and (a random one of) the adjacent interior cell(s), and
any adjacent exterior cells are added to the list of boundary cells.
This continues until all the cells are in the interior. Then the
entrance and exit are opened.
So much for documentation. Here's the program. Enjoy!
Kent, the man from xanth. (Kent Paul Dolan, LCDR, NOAA, Retired)
----------------------- usual clip job here ----------------------------------
CLEAR,10000&
CLEAR,60000& : REM Yep, the biggest maze needs every bit of that space.
REM Program Hex Maze
REM
REM Another demented creation from the mind and keys of Kent Paul Dolan.
REM
REM Draws a hexagonal grid, then removes sides and doors to make a hex maze.
REM
RANDOMIZE TIMER
REM precalculate trig stuff for speed
PI = 4#*ATN(1#)
c0pi3 = COS(0!*PI/3!)
s0pi3 = SIN(0!*PI/3!)
c1pi3 = COS(1!*PI/3!)
s1pi3 = SIN(1!*PI/3!)
c2pi3 = COS(2!*PI/3!)
s2pi3 = SIN(2!*PI/3!)
c3pi3 = COS(3!*PI/3!)
s3pi3 = SIN(3!*PI/3!)
c4pi3 = COS(4!*PI/3!)
s4pi3 = SIN(4!*PI/3!)
c5pi3 = COS(5!*PI/3!)
s5pi3 = SIN(5!*PI/3!)
REM Sizes for largest supported maze; used only to dimension arrays below.
xhuge = 51
yhuge = 51
DIM SHARED inlist(6,2),evenlist(6,2),oddlist(6,2),marks%(2*xhuge+1,yhuge+1),border%((2*xhuge+1)*(yhuge+1),2)
REM Tables for pointing to the (column,row) offset of adjacent hexes
REM for an even numbered hex in a row
DATA 1,1, 0,1, -1,1, -1,0, 0,-1, 1,0
REM for an odd numbered hex in a row
DATA 1,0, 0,1, -1,0, -1,-1, 0,-1, 1,-1
RESET
FOR k = 1 TO 6
FOR j = 1 TO 2
READ evenlist(k,j)
NEXT j
NEXT k
FOR k = 1 TO 6
FOR j = 1 TO 2
READ oddlist(k,j)
NEXT j
NEXT k
CALL announce
SCREEN 1,640,400,1,4
WINDOW 2,"Hex Maze",,20,1
PALETTE 0,.4,.4,.4
PALETTE 1,.2,.2,.2
COLOR 1,0
MENU 5,0,1,"Hex Maze Choices"
MENU 5,1,1,"Demo - 30 seconds"
MENU 5,2,1,"Kiddie - 4 minutes"
MENU 5,3,1,"Challenge - 16 minutes"
MENU 5,4,1,"Toughie - 60 minutes"
MENU 5,5,1,"Killer - 140 minutes"
MENU 5,6,1,"Quit and clean up"
ON MENU GOSUB DoMaze
MENU ON
WHILE (1)
SLEEP
WEND
DoMaze:
IF (MENU(0) <> 5) THEN RETURN
CLS
MenuItem = MENU(1)
IF ( (MenuItem < 1) OR (MenuItem > 6) ) THEN BEEP : RETURN
REM Disable the maze menu.
MENU 5,0,0
REM xmax is PAIRS of hexes in one row, ymax is rows, rad is radius of a hex
REM (xbegin,ybegin) is the offset of the first hex's center from (0,0)
REM Bail out option.
IF (MenuItem = 6) GOTO CleanUp
REM Killer maze - takes over 2 hours to draw, tiny cells, too hard to solve.
IF (MenuItem = 5) THEN xmax = 51 : ymax =51 : rad = 4! : xbegin = 6! : ybegin = 14!
REM A very detailed maze - about an hour to draw.
IF (MenuItem = 4) THEN xmax = 34 : ymax = 34 : rad = 6! : xbegin = 18! : ybegin = 24!
REM A pretty good maze; takes about 16 minutes to draw.
IF (MenuItem = 3) THEN xmax = 23 : ymax = 23 : rad = 9! : xbegin = 10! : ybegin = 20!
REM A kiddie maze, done in about 4 minutes.
IF (MenuItem = 2) THEN xmax = 10 : ymax = 10 : rad = 20! : xbegin = 26! : ybegin = 36!
REM A fast demo maze, done in about 30 seconds.
IF (MenuItem = 1) THEN xmax = 3 : ymax = 3 : rad = 48! : xbegin = 120! : ybegin = 100!
REM Stuff different depending on maze sizes starts here.
bsize = 0
marksize = rad/10!
xorg = xbegin
yorg = ybegin
ycen = yorg
lrad = rad*COS(PI/6!)
xoff = 2!*lrad*COS(PI/6!)
yoff = 2!*lrad*SIN(PI/6!)
REM draw hex grid
FOR y = 1 TO ymax
xcen = xorg
FOR x = 1 TO xmax
CALL dohex (xcen,ycen,rad)
xcen = xcen + xoff
ycen = ycen + yoff
CALL dohex (xcen,ycen,rad)
xcen = xcen + xoff
ycen = ycen - yoff
NEXT x
yorg = yorg + 2!*lrad
ycen = yorg
NEXT y
REM initialize marks
FOR y = 0 TO ymax + 1
FOR x = 0 TO 2 * xmax + 1
IF x = 0 OR x = 2 * xmax + 1 OR y = 0 OR y = ymax + 1 THEN
marks%(x,y) = -1
ELSE
marks%(x,y) = 0
END IF
NEXT x
NEXT y
REM seed maze
yseed = INT(RND * ymax + 1!)
xseed = INT(RND * 2 * xmax + 1!)
border%(1,1) = xseed
border%(1,2) = yseed
bsize = 1
CALL surround(1!,bsize,xmax,ymax)
REM fill in the rest of the maze
WHILE (bsize > 0)
goat = INT(RND * bsize + 1!)
CALL surround(goat,bsize,xmax,ymax)
WEND
REM Open an entrance and an exit.
CALL remove (1!,1!,1!,0!)
CALL remove (2!*xmax,ymax,2!*xmax,ymax+1)
REM Reenable the maze menu.
MENU 5,0,1
RETURN
CleanUp:
WINDOW CLOSE 2
SCREEN CLOSE 1
PALETTE 0,.2,.4,.8
PALETTE 1,1!,1!,1!
STOP
SUB surround(goat,bsize,xmax,ymax) STATIC
SHARED rad
insize = 0
xgoat = border%(goat,1)
ygoat = border%(goat,2)
LOCATE 1,1
FOR i = 1 TO 6
IF 2*INT(xgoat/2) = xgoat THEN
REM even case
xtemp = xgoat + evenlist(i,1)
ytemp = ygoat + evenlist(i,2)
ELSE
REM odd case
xtemp = xgoat + oddlist(i,1)
ytemp = ygoat + oddlist(i,2)
END IF
IF marks%(xtemp,ytemp) = 2 THEN
insize = insize + 1
inlist(insize,1) = xtemp
inlist(insize,2) = ytemp
END IF
IF marks%(xtemp,ytemp) = 0 THEN
bsize = bsize + 1
border%(bsize,1) = xtemp
border%(bsize,2) = ytemp
marks%(xtemp,ytemp) = 1
END IF
NEXT i
border%(goat,1) = border%(bsize,1)
border%(goat,2) = border%(bsize,2)
bsize = bsize - 1
IF rad > 9! THEN CALL markit(xgoat,ygoat)
marks%(xgoat,ygoat) = 2
IF insize > 0 THEN
newone = INT(RND*insize +1!)
xfrom = inlist(newone,1)
yfrom = inlist(newone,2)
CALL remove(xgoat,ygoat,xfrom,yfrom)
END IF
REM INPUT junk$
EXIT SUB
END SUB
SUB getedge(xhome,yhome,xaway,yaway,edge) STATIC
edge = 0
xdif = xaway - xhome
ydif = yaway - yhome
FOR i = 1 TO 6
IF 2*INT(xhome/2) = xhome THEN
IF ( (xdif = evenlist(i,1) ) AND (ydif = evenlist(i,2) ) ) THEN edge = i
ELSE
IF ( (xdif = oddlist(i,1) ) AND (ydif = oddlist(i,2) ) ) THEN edge = i
END IF
NEXT i
IF edge = 0 THEN
PRINT "edge error with inputs:",xhome,yhome,xaway,yaway
INPUT junk$
STOP
END IF
EXIT SUB
END SUB
SUB markit (xgoat,ygoat) STATIC
SHARED rad,up,marksize
CALL getcen(xgoat,ygoat,xcen,ycen)
CALL dohex(xcen,ycen,marksize)
EXIT SUB
END SUB
SUB getcen(xgoat,ygoat,xcen,ycen) STATIC
SHARED xbegin,ybegin,xoff,yoff,lrad
xcen = xbegin + (xgoat - 1) * xoff
ycen = ybegin + 2 * lrad * (ygoat -1)
IF 2*INT(xgoat/2!) = xgoat THEN
ycen = ycen + lrad
END IF
EXIT SUB
END SUB
SUB remove (xgoat,ygoat,xfrom,yfrom) STATIC
SHARED rad
SHARED c0pi3,c1pi3,c2pi3,c3pi3,c4pi3,c5pi3
SHARED s0pi3,s1pi3,s2pi3,s3pi3,s4pi3,s5pi3
twolrad = 2!*lrad
tworad = 2!*rad
REM Find the centers of the added hex and the one from which it was added.
CALL getcen(xgoat,ygoat,xgcen,ygcen)
CALL getcen(xfrom,yfrom,xfcen,yfcen)
REM Find the edge they share in common from each point of view.
CALL getedge(xgoat,ygoat,xfrom,yfrom,gedge)
CALL getedge(xfrom,yfrom,xgoat,ygoat,fedge)
REM Find the end points of the edge from the added hex's point of view.
IF gedge = 1 THEN
xgb = xgcen+rad*c0pi3
ygb = ygcen+rad*s0pi3
xge = xgcen+rad*c1pi3
yge = ygcen+rad*s1pi3
END IF
IF gedge = 2 THEN
xgb = xgcen+rad*c1pi3
ygb = ygcen+rad*s1pi3
xge = xgcen+rad*c2pi3
yge = ygcen+rad*s2pi3
END IF
IF gedge = 3 THEN
xgb = xgcen+rad*c2pi3
ygb = ygcen+rad*s2pi3
xge = xgcen+rad*c3pi3
yge = ygcen+rad*s3pi3
END IF
IF gedge = 4 THEN
xgb = xgcen+rad*c3pi3
ygb = ygcen+rad*s3pi3
xge = xgcen+rad*c4pi3
yge = ygcen+rad*s4pi3
END IF
IF gedge = 5 THEN
xgb = xgcen+rad*c4pi3
ygb = ygcen+rad*s4pi3
xge = xgcen+rad*c5pi3
yge = ygcen+rad*s5pi3
END IF
IF gedge = 6 THEN
xgb = xgcen+rad*c5pi3
ygb = ygcen+rad*s5pi3
xge = xgcen+rad*c0pi3
yge = ygcen+rad*s0pi3
END IF
REM Find the line ends from the connecting hex's point of view.
IF fedge = 1 THEN
xfb = xfcen+rad*c0pi3
yfb = yfcen+rad*s0pi3
xfe = xfcen+rad*c1pi3
yfe = yfcen+rad*s1pi3
END IF
IF fedge = 2 THEN
xfb = xfcen+rad*c1pi3
yfb = yfcen+rad*s1pi3
xfe = xfcen+rad*c2pi3
yfe = yfcen+rad*s2pi3
END IF
IF fedge = 3 THEN
xfb = xfcen+rad*c2pi3
yfb = yfcen+rad*s2pi3
xfe = xfcen+rad*c3pi3
yfe = yfcen+rad*s3pi3
END IF
IF fedge = 4 THEN
xfb = xfcen+rad*c3pi3
yfb = yfcen+rad*s3pi3
xfe = xfcen+rad*c4pi3
yfe = yfcen+rad*s4pi3
END IF
IF fedge = 5 THEN
xfb = xfcen+rad*c4pi3
yfb = yfcen+rad*s4pi3
xfe = xfcen+rad*c5pi3
yfe = yfcen+rad*s5pi3
END IF
IF fedge = 6 THEN
xfb = xfcen+rad*c5pi3
yfb = yfcen+rad*s5pi3
xfe = xfcen+rad*c0pi3
yfe = yfcen+rad*s0pi3
END IF
REM Draw over the appropriate sides in background color.
REM (We're hitting the "same" line from both sides, to get all the points
REM we'd otherwise miss due to roundoff errors.)
LINE (xgb,ygb)-(xge,yge),0
LINE (xfb,yfb)-(xfe,yfe),0
REM Put the line ends back, to avoid breaks in cell walls.
PSET (xgb,ygb),1
PSET (xge,yge),1
PSET (xfb,yfb),1
PSET (xfe,yfe),1
EXIT SUB
END SUB
SUB dohex (xcen,ycen,rad) STATIC
SHARED c0pi3,c1pi3,c2pi3,c3pi3,c4pi3,c5pi3
SHARED s0pi3,s1pi3,s2pi3,s3pi3,s4pi3,s5pi3
LINE (xcen+rad*c0pi3,ycen+rad*s0pi3)-(xcen+rad*c1pi3,ycen+rad*s1pi3),1
LINE (xcen+rad*c1pi3,ycen+rad*s1pi3)-(xcen+rad*c2pi3,ycen+rad*s2pi3),1
LINE (xcen+rad*c2pi3,ycen+rad*s2pi3)-(xcen+rad*c3pi3,ycen+rad*s3pi3),1
LINE (xcen+rad*c3pi3,ycen+rad*s3pi3)-(xcen+rad*c4pi3,ycen+rad*s4pi3),1
LINE (xcen+rad*c4pi3,ycen+rad*s4pi3)-(xcen+rad*c5pi3,ycen+rad*s5pi3),1
LINE (xcen+rad*c5pi3,ycen+rad*s5pi3)-(xcen+rad*c0pi3,ycen+rad*s0pi3),1
EXIT SUB
END SUB
SUB announce STATIC
LOCATE 1,1
PRINT TAB(28);"Welcome to Hex Maze!"
PRINT
PRINT "This program draws a maze on a hexagonal grid."
PRINT
PRINT "Your choice of maze sizes is from a menu; nothing happens until you"
PRINT "choose a maze size. The menu is turned off while the maze is drawn."
PRINT
PRINT "Use your favorite screen grabber to save a copy of the maze for printing."
PRINT "(You'll probably want to change the colors to black and white first;"
PRINT "the current color selection is designed to minimize interlace flicker.)"
PRINT
PRINT "When you're done solving a maze by eye, choose another from the menu."
PRINT "Choose the menu 'cleanup' option to leave the program nicely."
PRINT
PRINT "Have fun!"
PRINT
PRINT "Enter a return to go ahead when you're done reading."
INPUT "(You may have to click the mouse in this window to type here.) Ready";junk$
EXIT SUB
END SUB
END
----- Cut Here, this is the end, not the beginning, but the end -----