Post by Tom Not logged in on Nov 12, 2004 23:47:45 GMT -5
Again, the code is a bit messy, but the result looks okay (imo :) )
dim xSize, ySize
dim c$, back
back = NewTileMap (LoadMipmapTexture ("textures\floor01.jpg"))
dim map(0)(0)
map (0)(0) = 0
SprSetTiles (map)
SprSetXRepeat (true)
SprSetYRepeat (true)
SprSetScale (5)
SprSetVel (1, 1)
SprSetPos (320, 240)
glClearColor (1, 1, 1, 1)
cls
color (255, 255, 255)
printr "Options"
printr "1 = Easy"
printr "2 = Medium"
printr "3 = Hard"
print "Please choose a number: "
DrawText ()
while xSize = 0
c$ = inkey$ ()
if c$ = "1" then
xSize = 13: ySize = 10
endif
if c$ = "2" then
xSize = 20: ySize = 15
endif
if c$ = "3" then
xSize = 30: ySize = 20
endif
wend
ResizeText (xSize * 2 + 1, ySize * 2 + 1)
struc Cell
dim links (4)
dim covered, backtracked
endstruc
struc Dir
dim available, xd, yd
endstruc
const frameSkip = 10
dim Cell maze (xSize)(ySize), Dir dirs (4)
dim x, y, x2, y2, done, foundDir, i, d, counter
dim oppositeDir (4), xd, yd, ex, ey, time
dirs (1).xd = -1
dirs (2).xd = 1
dirs (3).yd = -1
dirs (4).yd = 1
oppositeDir (1) = 2
oppositeDir (2) = 1
oppositeDir (3) = 4
oppositeDir (4) = 3
x = rnd () % xSize + 1
y = rnd () % ySize + 1
maze (x)(y).covered = true
TextMode (TEXT_BUFFERED)
color (255, 255, 255)
while not done
maze (x)(y).covered = true
foundDir = false
for i = 1 to 4
x2 = x + dirs (i).xd
y2 = y + dirs (i).yd
dirs (i).available = false
if x2 >= 1 and x2 <= xSize and y2 >= 1 and y2 <= ySize then
if not maze (x2)(y2).covered then
dirs (i).available = true
foundDir = true
endif
endif
next
if not foundDir then
maze (x)(y).backtracked = true
for i = 1 to 4
if maze (x)(y).links (i) then
x2 = x + dirs (i).xd
y2 = y + dirs (i).yd
if not maze (x2)(y2).backtracked then
dirs (i).available = true
foundDir = true
endif
endif
next
endif
if foundDir then
d = rnd ()%4+1
while not dirs (d).available
d = rnd ()%4+1
wend
x2 = x + dirs (d).xd
y2 = y + dirs (d).yd
maze(x)(y).links (d) = true
maze(x2)(y2).links (oppositeDir (d)) = true
locate x * 2 - 2, y * 2 - 2: print "@"
locate x * 2 - 2, y * 2 - 1
if maze (x)(y).links (1) then print " "
else print "@"
endif
locate x * 2 - 1, y * 2 - 2
if maze (x)(y).links (3) then print " "
else print "@"
endif
if counter <= 0 then
DrawText ()
counter = frameSkip
else
counter = counter - 1
endif
x = x2
y = y2
else
done = true
endif
wend
for x = 0 to xSize * 2 - 1
locate x, ySize * 2 + 2: print "@"
next
for y = 0 to ySize * 2 - 1
locate xSize * 2 + 2, y: print "@"
next
DrawText ()
ex = xSize * 2 - 1
ey = ySize * 2 - 1
Color (255, 255, 0): locate ex, ey: print "&"
time = TickCount ()
x = 1: y = 1
while c$ <> "&"
color (255, 255, 255)
locate 0, 0: print (TickCount () - time) / 1000.0
print "@@@@@@@@@@"
xd = 0: yd = 0
if ScanKeyDown (VK_LEFT) then xd = xd - 1 endif
if ScanKeyDown (VK_RIGHT) then xd = xd + 1 endif
if ScanKeyDown (VK_UP) and y > 1 then yd = yd - 1 endif
if ScanKeyDown (VK_DOWN) then yd = yd + 1 endif
c$ = CharAt$ (x + xd, y + yd)
if c$ = "@" and xd <> 0 and yd <> 0 then
' if xd <> 0 and yd <> 0 then
if CharAt$ (x + xd, y) <> "@" and CharAt$ (x, y + yd) = "@" then
yd = 0
else
if CharAt$ (x, y + yd) <> "@" and CharAt$ (x + xd, y) = "@" then
xd = 0
endif
endif
c$ = CharAt$ (x + xd, y + yd)
endif
if c$ <> "@" then
locate x, y: print " "
x = x + xd
y = y + yd
color (255, 0, 0)
locate x, y: print "o"
endif
' SprSetPos (SprPos () + vec2 (1, 1))
SprSetAngle (SprAngle () + 0.2)
DrawText ()
WaitTimer (50)
wend
time = TickCount () - time
color (200, 200, 255)
locate xSize - 7, ySize - 2: print "Maze completed"
locate xSize - 12, ySize: print "Time taken: " + time / 1000.0 + " seconds"
DrawText ()
Sleep (1000)
locate xSize - 7, ySize + 2: print "Press any key"
DrawText ()
ClearKeys ()
while Inkey$ () = "": wend
run