Sorry your browser is not supported!

Rem Project: MazeGenerator
Rem Created: Friday, June 19, 2009
Rem By: Plystire

Rem ***** Main Source File *****
global recurse,comp,escape
global maxrecurse
maxrecurse=49100

#constant MAZE_TREE 1

`Ask how big to make maze and if we want it to wraparound
global wid,hit,wraparound
input "Make maze wrap around? (Y/N)",c$
if lower$(c$)="y" then wraparound=1
input "Enter Width of Maze: ",wid
input "Enter Height of Maze: ",hit
mazetype=MAZE_TREE

print "Generating maze..."
tt=timer()

gosub generatemaze

print "Done!"
print "Generation time = "+str$(timer()-tt)+"ms"

do
	`paste image 1,0,0
	if spacekey()=1 then end
loop


generatemaze:
	`First make a memblock to make maze in
	make memblock 1, ((wid*2)*(hit*2)*4)+12
	`Put width and height into first two dwords
	write memblock dword 1,0,wid*2
	write memblock dword 1,4,hit*2
	write memblock dword 1,8,32 : `Use this depth.. any other depth doesn't seem to work. Convert to a lower depth in an image editor after generation to reduce file size
	`Begin generation of maze
	select mazetype
		case MAZE_TREE:
			gosub maketreemaze
		endcase
	endselect
return

maketreemaze:
	`Pick random colors for the back ground, nearcolor and farcolor
	`This section if for making random colors for Valle's labyrinth program
	remstart
	bg=rgb(rnd(255),rnd(255),rnd(255))
	nr=rgb(rnd(255),rnd(255),rnd(255))
	fr=rgb(rnd(255),rnd(255),rnd(255))
	write memblock dword 1,12,bg
	write memblock dword 1,16,nr
	write memblock dword 1,20,fr
	remend
	`Pick random starting position
	posx=rnd(wid)
	posy=rnd(hit)
	`Recurse through maze
	repeat
		if escape=1
			`Our recursion depth ran too high, let's scan for another starting point
			escape=0
			jump=0
			for x = 0 to wid-1
				for y = 0 to hit-1
					if (spottaken(x-1,y)=0 or spottaken(x+1,y)=0 or spottaken(x,y-1)=0 or spottaken(x,y+1)=0) and spottaken(x,y)=1
						posx=x : posy=y : jump=1 : exit
					endif
				next y
				if jump=1 then exit
			next x
		endif
		genmaze(posx,posy,1)
		if (comp*100)/(wid*hit)<99 then escape=1
	until escape=0
	`Look for any anomalies that might exist and fill them in
	print "Fixing any anomalies..."
	for x = 0 to wid-1
		for y = 0 to hit-1
			if spottaken(x-1,y)=0 or spottaken(x+1,y)=0 or spottaken(x,y-1)=0 or spottaken(x,y+1)=0
				inc anomalies
				genmaze(x,y,0)
			endif
		next y
	next x
	print str$(anomalies)+" anomalies found and fixed"
	`Pick random start and end spots and color them in (green is start, red is finish)
	sx=rnd(wid) : sy=rnd(hit)
	clr=getrgb(0,255,0)
	write memblock dword 1,(((sy*2+1)*wid*2)+(sx*2+1))*4+12,clr
	repeat
		ex=rnd(wid) : ey=rnd(hit)
	until sqrt((ex-sx)^2+(ey-sy)^2)>wid/2
	clr=getrgb(255,0,0)
	write memblock dword 1,(((ey*2+1)*wid*2)+(ex*2+1))*4+12,clr
	`Make an image from our memblock and save it
	make image from memblock 1,1
	num=0
	while file exist("maze"+str$(num)+".bmp")=1
		inc num
	endwhile
	save image "maze"+str$(num)+".bmp",1,2
return

function spottaken(x as integer, y as integer)
	ret=0
	if wraparound=1
		if x>=wid then dec x,wid
		if x<0 then inc x,wid
		if y>=hit then dec y,hit
		if y<0 then inc y,hit
	endif
	if x>=wid or x<0 or y>=hit or y<0
		ret=1
	else
		chk=memblock dword(1, (((y*2+1)*wid*2)+(x*2+1))*4+12)
		if rgbr(chk)=255 and rgbg(chk)=255 and rgbb(chk)=255 then ret=1
		if rgbr(chk)=255 and rgbg(chk)=255 and rgbb(chk)=0 then ret=1
	endif
endfunction ret

function genmaze(x as integer, y as integer, showprogress)
	inc recurse : inc comp
	if showprogress=1
		cls
		print : print : print "Generating "+str$(wid)+"x"+str$(hit)+" maze..."
		print "Recursion Depth: "+str$(recurse)
		print "Completed: "+str$((comp*100)/(wid*hit))+"%"
	endif
	`do we have any directions to move in
	if wraparound=1
		if x>=wid then dec x,wid
		if x<0 then inc x,wid
		if y>=hit then dec y,hit
		if y<0 then inc y,hit
	endif
	while (spottaken(x+1,y)=0 or spottaken(x-1,y)=0 or spottaken(x,y+1)=0 or spottaken(x,y-1)=0) and recurse<maxrecurse and escape=0
		`We can move in a direction so pick until we have a direction to move in
		repeat
			`If we haven't found the path yet
			d=rnd(3)
			desx=x : tx=x*2
			desy=y : ty=y*2
			if d=0 then dec desy : dec ty
			if d=1 then inc desx : inc tx
			if d=2 then inc desy : inc ty
			if d=3 then dec desx : dec tx
		until spottaken(desx,desy)=0 : `and ((ty<>0 and ty<>hit*2) or tx>2) :rem this last part prevents overwriting color key information
		`Color current tile and tile in direction of our movement, white
		clr=getrgb(255,255,255)
		writepixel(x*2,y*2,clr)
		writepixel(tx,ty,clr)
		`Start generating from our new desired position
		genmaze(desx,desy,showprogress)
	endwhile
	if recurse>=maxrecurse then escape=1
	`Color current tile white
	clr=getrgb(255,255,255)
	writepixel(x*2,y*2,clr)
	dec recurse
endfunction

function writepixel(x as integer, y as integer, clr as dword)
	`make sure our color keys aren't used : Used for Valle's labyrinth program
	`if y+1=0 and x+1<3 then exitfunction
	if x+1>=wid*2 then dec x,wid*2
	if x+1<0 then inc x,wid*2
	if y+1>=hit*2 then dec y,hit*2
	if y+1<0 then inc y,hit*2
	write memblock dword 1,(((y+1)*wid*2)+(x+1))*4+12,clr
endfunction

function getrgb(r as byte, g as byte, b as byte)
	ret as dword
	ret = ret || (r << 16)
	ret = ret || (g << 8)
	ret = ret || b
endfunction ret