I was pretty bored ... so i made this Maze.

Ultrahex · **Posted:** Sat Jan 29, 2005 5:11 pm

Ya ... its a maze... (Generated)

code:

var WinID := Window.Open ("msdos")
type block :
record
wL, wR, wT, wB, used, filled : boolean
end record

type loc :
record
x, y : int
end record

var q := false %Quit
var width := 15
var height := 15
var thick := 20

var VisitedCells : int := 0 %Total Amount Visted
var chars : array char of boolean
var TotalCells : int := width * height - 1 %Total Amount Of Cells In Maze
var DelayInputs := 0
var cells : array 1 .. width, 1 .. height of block %Setup The Cells
for i : 1 .. width
for o : 1 .. height
cells (i, o).wL := true
cells (i, o).wR := true
cells (i, o).wT := true
cells (i, o).wB := true
cells (i, o).used := false
cells (i, o).filled := false
end for
end for

cells (1, 1).used := true
var CurrentCell : loc
CurrentCell.y := 1
CurrentCell.x := 1
var WinFont := Font.New ("arial:50:bold")
var TitleFont := Font.New ("arial:20:bold,underline")
var TitleMedium := Font.New ("arial:12:bold,underline")
var TitleSmall := Font.New ("arial:12:bold")
var SmallFont := Font.New ("arial:10")
var Right, Left, Up, Down : boolean
View.Set ("offscreenonly")
put "Generating Maze, Please Wait..."
var Winx, Winy, Startx, Starty, Currentx, Currenty : int
Startx := 1
Starty := 1
Winx := width
Winy := height
Currentx := Startx
Currenty := Starty
View.Update

proc DrawScreen
cls
Draw.FillBox (0, 0, maxx, maxy, 20)
Font.Draw ("Maze 2005 - Made By Alex Riedler", 100, maxy - 35, TitleFont, white)
Font.Draw ("INSTRUCTIONS", 325, 310, TitleMedium, white)
Font.Draw ("Controls", 325, 280, TitleSmall, white)
Font.Draw ("Use the arrow keys to move", 325, 265, SmallFont, white)
Font.Draw ("Objective", 325, 240, TitleSmall, white)
Font.Draw ("move(you) the black dot to the blue X", 325, 220, SmallFont, white)
for i : 1 .. width
for o : 1 .. height
if cells (i, o).used = true then
Draw.FillBox (i * thick, o * thick, i * thick + thick, o * thick + thick, 42)
end if
if cells (i, o).wL = true then
Draw.ThickLine (i * thick, o * thick, i * thick, o * thick + thick, 2, black)
end if
if cells (i, o).wR = true then
Draw.ThickLine (i * thick + thick, o * thick, i * thick + thick, o * thick + thick, 2, black)
end if
if cells (i, o).wT = true then
Draw.ThickLine (i * thick, o * thick + thick, i * thick + thick, o * thick + thick, 2, black)
end if
if cells (i, o).wB = true then
Draw.ThickLine (i * thick, o * thick, i * thick + thick, o * thick, 2, black)
end if
end for
end for
Draw.FillOval (round (Currentx * thick + (thick / 2)), round (Currenty * thick + (thick / 2)), 3, 3, black)
Draw.ThickLine (Winx * thick, Winy * thick, Winx * thick + thick, Winy * thick + thick, 2, brightblue)
Draw.ThickLine (Winx * thick, Winy * thick + thick, Winx * thick + thick, Winy * thick, 2, brightblue)
View.Update
end DrawScreen

proc Inputs
Input.KeyDown (chars)
if Time.Elapsed - DelayInputs > 100 then
if chars (KEY_RIGHT_ARROW) then
if cells (Currentx, Currenty).wR = false then
Currentx += 1
DelayInputs := Time.Elapsed
end if
elsif chars (KEY_LEFT_ARROW) then
if cells (Currentx, Currenty).wL = false then
Currentx -= 1
DelayInputs := Time.Elapsed
end if
elsif chars (KEY_DOWN_ARROW) then
if cells (Currentx, Currenty).wB = false then
Currenty -= 1
DelayInputs := Time.Elapsed
end if
elsif chars (KEY_UP_ARROW) then
if cells (Currentx, Currenty).wT = false then
Currenty += 1
DelayInputs := Time.Elapsed
end if
end if
end if
end Inputs

proc CheckWin
if Currentx = Winx and Currenty = Winy then
for i : 1 .. 10
delay (100)
cls
Draw.FillBox (0, 0, maxx, maxy, 20)
Font.Draw ("YOU WIN!", 150, 200, WinFont, Rand.Int (9, 15))
Font.Draw ("Thanx For Playing Alex Riedler's Maze", 150, 150, SmallFont, white)
View.Update
end for
q := true
end if
end CheckWin

proc CheckDirection (x, y : int)
Right := true
Left := true
Down := true
Up := true

if x - 1 = 0 then
Left := false
end if
if x = width then
Right := false
end if
if y - 1 = 0 then
Down := false
end if
if y = height then
Up := false
end if

if x - 1 >= 1 and cells (x - 1, y).used = true then
Left := false
end if
if x + 1 <= width and cells (x + 1, y).used = true then
Right := false
end if
if y - 1 >= 1 and cells (x, y - 1).used = true then
Down := false
end if
if y + 1 <= height and cells (x, y + 1).used = true then
Up := false
end if
if Right = false and Left = false and Up = false and Down = false then
cells (x, y).filled := true
end if
end CheckDirection

proc GetNext
if cells (CurrentCell.x, CurrentCell.y).filled = true then
for i : 1 .. width
for o : 1 .. height
if cells (i, o).filled = false then
CheckDirection (i, o)
end if
if cells (i, o).filled = false and cells (i, o).used = true then
CurrentCell.x := i
CurrentCell.y := o
return
end if
end for
end for
end if
end GetNext

proc GenerateMaze
loop
exit when VisitedCells >= TotalCells
loop
exit when VisitedCells >= TotalCells
for i : 1 .. width
for o : 1 .. height
CheckDirection (i, o)
end for
end for
GetNext

var Random : int := Rand.Int (1, 4)
if Random = 1 and CurrentCell.x - 1 >= 1 and cells (CurrentCell.x - 1, CurrentCell.y).used = false then
if cells (CurrentCell.x - 1, CurrentCell.y).wR = true then
cells (CurrentCell.x - 1, CurrentCell.y).used := true
cells (CurrentCell.x - 1, CurrentCell.y).wR := false
cells (CurrentCell.x, CurrentCell.y).wL := false
CurrentCell.x -= 1
VisitedCells += 1
end if
elsif Random = 2 and CurrentCell.x + 1 <= width and cells (CurrentCell.x + 1, CurrentCell.y).used = false then
if cells (CurrentCell.x + 1, CurrentCell.y).wL = true then
cells (CurrentCell.x + 1, CurrentCell.y).used := true
cells (CurrentCell.x + 1, CurrentCell.y).wL := false
cells (CurrentCell.x, CurrentCell.y).wR := false
CurrentCell.x += 1
VisitedCells += 1
end if
elsif Random = 3 and CurrentCell.y - 1 >= 1 and cells (CurrentCell.x, CurrentCell.y - 1).used = false then
if cells (CurrentCell.x, CurrentCell.y - 1).wT = true then
cells (CurrentCell.x, CurrentCell.y - 1).used := true
cells (CurrentCell.x, CurrentCell.y - 1).wT := false
cells (CurrentCell.x, CurrentCell.y).wB := false
CurrentCell.y -= 1
VisitedCells += 1
end if
elsif Random = 4 and CurrentCell.y + 1 <= height and cells (CurrentCell.x, CurrentCell.y + 1).used = false then
if cells (CurrentCell.x, CurrentCell.y + 1).wB = true then
cells (CurrentCell.x, CurrentCell.y + 1).used := true
cells (CurrentCell.x, CurrentCell.y + 1).wB := false
cells (CurrentCell.x, CurrentCell.y).wT := false
CurrentCell.y += 1
VisitedCells += 1
end if
end if
end loop
end loop
end GenerateMaze

GenerateMaze
put "Generated in:", Time.Elapsed, " Miliseconds"
View.Update
%var a:string(1)
%getch(a)

loop
DrawScreen
Inputs
CheckWin
exit when q
end loop
delay (500)
Window.Close (WinID)

or Attachment i suppose

Delos · **Posted:** Sat Jan 29, 2005 6:34 pm

Good work! Been a while since we've seen a quality maze...

I like the fact that it actually generates mazes based on an algorithm and doesn't just pull a bunch of predefs out.

Suggestion: add several levels of difficulty - i.e., different maze sizes. Also, when I ran it on my comp, the little dot tended to move more than 1 space if I held down an arrow for a fraction of a second too long. Just for perfection's sake, add some FPS limits to it.

Otherwise, great stuff.
+ bits

basketball4ever · **Posted:** Sat Jan 29, 2005 6:48 pm

nice maze man Very Happy

good work on doing the random generating maze coding

MihaiG · **Posted:** Sat Jan 29, 2005 7:58 pm

excellent...i will use this invention to take over the world Twisted Evil

Bacchus · **Posted:** Sat Jan 29, 2005 11:47 pm

ya the generating maze is great good job

mike200015 · **Posted:** Tue Mar 15, 2005 9:01 pm

hey.. nice work on the maze... like how it generates a new 1 each time! Very Happy

GB · **Posted:** Thu Mar 17, 2005 12:42 am

cool dude · **Posted:** Thu Mar 17, 2005 11:22 am

nice work. the best part of all is how the maze changes everytime. u should make some levels though and a highscore list for the least number of moves until the finish. other then that great job!

Mr. T · **Posted:** Sun Mar 27, 2005 11:11 pm

mike200015 wrote:

hey.. nice work on the maze... like how it generates a new 1 each time! Very Happy

What else would you be complimenting on, if not the fact that it generates a maze each time lol. CAPTAIN OBVIOUS TO THE RESCUE!!!

...but seriously, great concept!