I've now implemented the flood fill routine so things are coming along. This separates the dead ameobas into their zones/areas/caves. I've updated the generate 3d function so that it doesn't create un-necessary walls.
After running this program as it stands the text file returned shows something like this:
Trace file created : 06/07/11, 17:16:18
File handle used : 1
Flooding for ameoba 0,X71,Y62
Flooding for ameoba 1,X17,Y22
Flooding for ameoba 5,X6,Y61
Flooding for ameoba 9,X89,Y24
Flooding for ameoba 10,X62,Y61
Flooding for ameoba 30,X9,Y40
Flooding for ameoba 35,X28,Y90
Flooding for ameoba 42,X50,Y57
Flooding for ameoba 46,X46,Y45
Flooding for ameoba 60,X21,Y2
Flooding for ameoba 61,X21,Y71
Found 11 group(s)
Max stack elements used 496
EOF Trace file (safe program exit)
The code itself is now this:
Rem Project: Level Generator
Rem Created: Wednesday, June 01, 2011
Rem ***** Main Source File *****
` change this to speed up ameoba digging updates to the screen
USKIP_MAX=1
WL_TRACE_INIT("trace.txt")
INIT_DISPLAY(640,480)
randomize 1
INIT_AMEOBA(64,96,96)
AMEOBA_DRAW()
update_skip=USKIP_MAX
sync
` keep updating the screen while the emeobas are digging
repeat
cls
dead=AMEOBA_UPDATE()
if update_skip=0
AMEOBA_DRAW()
ink 0xff0000,0xff0000
text 0,0,str$(ameoba_dead)+" out of "+str$(ameoba_count)+" dead"
sync
update_skip=USKIP_MAX
else
dec update_skip
endif
until dead=1
` hold the screen as is with all the dead amap
while (spacekey()=0)
AMEOBA_DRAW()
ink 0xff0000,0xff0000
text 0,0,"ALL DEAD!!!"
text 0,24,"Press SPACE to generate 3D..."
sync
endwhile
` Give the user a chance to release the key
repeat until spacekey()=0
` We are doing something so inform the user
AMEOBA_DRAW()
text 0,0,"Generating 3D please wait a short while..."
sync
` convert the dungeon into 3D
MAKE_3D_LEVEL(15)
` Initialise the viewer
INIT_LEVEL(1)
` view the level
while (spacekey()=0)
UPDATE_LEVEL()
sync
endwhile
WL_TRACE_CLOSE()
end
Rem ***** Included Source File *****
rem sets up display
type TYPE_DISPLAY
width, height
endtype
function INIT_DISPLAY(w,h)
global T_DISPLAY as TYPE_DISPLAY
T_DISPLAY.width=w
T_DISPLAY.height=h
set bitmap format 20
set display mode w,h,32
sync rate 60
sync on
endfunction
Rem ***** Included Source File *****
type TYPE_AMEOBA
xpos, ypos, up, down, left, right, dead as integer
colour as dword
group as integer
endtype
function INIT_AMEOBA(count,width,height)
a as integer : b as integer
global dim ameoba(count) as TYPE_AMEOBA
global dim amap(width,height)
global ameoba_count = count
global ameoba_dead = 0
global ameoba_bm_wid = width
global ameoba_bm_hgt = height
for a=0 to count
ameoba(a).xpos = rnd(width-2)+1
ameoba(a).ypos = rnd(height-2)+1
ameoba(a).up = 0
ameoba(a).down = 0
ameoba(a).left = 0
ameoba(a).right = 0
ameoba(a).dead = 0
ameoba(a).colour=(rnd(64)+128)
ameoba(a).group=0
b=rnd(2)
while b>0
dec b
ameoba(a).colour=ameoba(a).colour*256
endwhile
amap(ameoba(a).xpos,ameoba(a).ypos)=ameoba(a).colour
next
endfunction
function AMEOBA_DRAW()
xp as float
yp as float
xpinc as float
ypinc as float
xp=0 : yp=0
xpinc=T_DISPLAY.width : xpinc=xpinc/(ameoba_bm_wid+1)
ypinc=T_DISPLAY.height : ypinc=ypinc/(ameoba_bm_hgt+1)
set current bitmap 0
for x=0 to ameoba_bm_wid
for y=0 to ameoba_bm_hgt
select amap(x,y)
case 0
ink 0x0000ff,0x0000ff
endcase
case 1
ink 0xffff00,0xffff00
endcase
case 2
ink 0x00ff00,0x00ff00
endcase
case default
ink amap(x,y),amap(x,y)
endcase
endselect
box xp,yp,xp+xpinc,yp+ypinc
yp=yp+ypinc
next
yp=0
xp=xp+xpinc
next
ink 0,0
line 1,1,T_DISPLAY.width-2,1
line 1,1,1,T_DISPLAY.height-2
line T_DISPLAY.width-2,1,T_DISPLAY.width-2,T_DISPLAY.height-2
line 1,T_DISPLAY.height-2,T_DISPLAY.width-2,T_DISPLAY.height-2
endfunction
function AMEOBA_UPDATE()
a as integer
d as integer
f as integer
dret=0
for a=0 to ameoba_count
f=0
while f=0 and ameoba(a).dead=0
d=rnd(3)
select d
case 0
if ameoba(a).up=0 then f=1
endcase
case 1
if ameoba(a).down=0 then f=1
endcase
case 2
if ameoba(a).left=0 then f=1
endcase
case 3
if ameoba(a).right=0 then f=1
endcase
endselect
endwhile
if f=0 then d=-1
select d
case 0 ` up
if ameoba(a).ypos=1 or amap(ameoba(a).xpos,ameoba(a).ypos-1)>0
ameoba(a).up=1
else
ameoba(a).up=0
ameoba(a).left=0
ameoba(a).right=0
ameoba(a).down=1
dec ameoba(a).ypos
endif
endcase
case 1 ` down
if ameoba(a).ypos>=ameoba_bm_hgt-2 or amap(ameoba(a).xpos,ameoba(a).ypos+1)>0
ameoba(a).down=1
else
ameoba(a).down=0
ameoba(a).left=0
ameoba(a).right=0
ameoba(a).up=1
inc ameoba(a).ypos
endif
endcase
case 2 ` left
if ameoba(a).xpos=1 or amap(ameoba(a).xpos-1,ameoba(a).ypos)>0
ameoba(a).left=1
else
ameoba(a).up=0
ameoba(a).down=0
ameoba(a).left=0
ameoba(a).right=1
dec ameoba(a).xpos
endif
endcase
case 3 ` right
if ameoba(a).xpos>=ameoba_bm_wid-2 or amap(ameoba(a).xpos+1,ameoba(a).ypos)>0
ameoba(a).right=1
else
ameoba(a).up=0
ameoba(a).down=0
ameoba(a).right=0
ameoba(a).left=1
inc ameoba(a).xpos
endif
endcase
endselect
if (ameoba(a).up=1 and ameoba(a).down=1 and ameoba(a).left=1 and ameoba(a).right=1 and ameoba(a).dead=0)
inc ameoba_dead
ameoba(a).dead=1
amap(ameoba(a).xpos,ameoba(a).ypos)=2
else
if ameoba(a).dead=0
amap(ameoba(a).xpos,ameoba(a).ypos)=ameoba(a).colour
endif
endif
next
if ameoba_dead>ameoba_count
dret=1
endif
endfunction dret
type TYPE_AM_STACK
x, y as integer
endtype
function AMEOBA_GROUP()
` groups are 0 by default in the array so start at 1 instead
group as integer = 1
a as integer : b as integer
elem as integer
ms as integer = 0
x as integer
y as integer
` stack for the flood fill algorithm
dim stack() as TYPE_AM_STACK
for a=0 to ameoba_count
` if the current ameoba is not in a group then process it
` This will flood fill the area and find other ameobas in it
if ameoba(a).group = 0
` do flood fill here
array insert at bottom stack()
stack().x=ameoba(a).xpos
stack().y=ameoba(a).ypos
WL_TRACE_WRITE("Flooding for ameoba "+str$(a)+",X"+str$(ameoba(a).xpos)+",Y"+str$(ameoba(a).ypos))
` Main flood loop while stack has contents
while array count( stack() ) >= 0
` pop item off the stack
elem=array count( stack() )
x=stack(elem).x
y=stack(elem).y
array delete element stack(),elem
` used to find max stack size used
if elem>ms then ms=elem
` firstly find other ameobas in the area
` yup this will slow it down a lot too
for b=1 to ameoba_count
` optimised the if statement a bit anyway
if ameoba(b).group>=0
if ameoba(b).xpos=x and ameoba(b).ypos=y
ameoba(b).group=group
endif
endif
next
` check if within the map area first
if x>=0 and x<=ameoba_bm_wid and y>=0 and y<=ameoba_bm_hgt
` check if map portion has not been visited
` and whether it's not a wall piece
if (amap(x,y) and 0xff000000)=0 and (amap(x,y) and 0x00ffffff)>0
` set it as visited (put group number in last byte)
amap(x,y)=amap(x,y) or 0xff000000
` store all other points adjacent
` once it work I will optimise this bit <--*********
` now using if's to optimise the stack a bit
` the edge of the map is always a wall too
if x+1<ameoba_bm_wid
array insert at bottom stack()
stack().x=x+1 : stack().y=y
endif
if x-1>0
array insert at bottom stack()
stack().x=x-1 : stack().y=y
endif
if y+1<ameoba_bm_hgt
array insert at bottom stack()
stack().x=x : stack().y=y+1
endif
if y-1>0
array insert at bottom stack()
stack().x=x : stack().y=y-1
endif
endif
endif
endwhile
inc group
endif
NEXT
WL_TRACE_WRITE("Found "+str$(group-1)+" group(s)")
WL_TRACE_WRITE("Max stack elements used "+str$(ms))
ENDFUNCTION
Rem ***** Included Source File *****
function MAKE_3D_LEVEL(size)
` first of all group the amap
AMEOBA_GROUP()
` now turn it into 3D
global curr=1
cflag=0
xoff=size*(ameoba_bm_wid/2)
zoff=size*(ameoba_bm_hgt/2)
for x=0 to ameoba_bm_wid
for y=0 to ameoba_bm_hgt
cflag=0 ` creation flag (if 1 then no object created)
select amap(x,y) and 0x00ffffff
case 0
` check if the wall is not surrounded by all walls
if _3D_CHECK_MAP_WALL(x,y)
make object box curr,size,size,size
position object curr,x*size-xoff,0,y*size-zoff
color object curr,0xff0000
else
cflag=1
endif
endcase
case 1
make object box curr,size,1,size
position object curr,x*size-xoff,-(size/2.0),y*size-zoff
color object curr,0x004400
endcase
case 2
make object box curr,size,1,size
position object curr,x*size-xoff,-(size/2.0),y*size-zoff
color object curr,0x000044
endcase
case default
make object box curr,size,1,size
position object curr,x*size-xoff,-(size/2.0),y*size-zoff
color object curr,amap(x,y)
endcase
endselect
if cflag=0
set object specular curr,0xffffff
set object specular power curr,3
inc curr
endif
next
next
endfunction
function INIT_LEVEL(move_speed)
global camsp=move_speed
flush as integer
` flush the mouses movement
flush=mousemovex() : flush=mousemovey()
` make an object and position it
make object cube curr,1
position object curr, 0,100,0
point object curr, 0,0,100
hide object curr
` create a light
make light 1
endfunction
function UPDATE_LEVEL()
mx as float : my as float : camy as float
mx=mousemovex()/4.0 : my=mousemovey()/4.0
yrotate object curr,wrapvalue(object angle y(curr)+mx)
xrotate object curr,wrapvalue(object angle x(curr)+my)
if upkey() then move object curr, camsp
if downkey() then move object curr, -camsp
if leftkey() then move object left curr,camsp
if rightkey() then move object right curr,camsp
position camera object position x(curr),object position y(curr),object position z(curr)
set camera to object orientation curr
position light 1,object position x(curr),object position y(curr),object position z(curr)
endfunction
function _3D_CHECK_MAP_WALL(x,y)
` This function checks the map and will allow the creation
` of walls only if they are necessary
` if we hit a none wall then ret is set to 1
ret as integer=0
` getting through it as quick as poss (doubt it though)
` another optimisation was the fact that the walls are not
` in groups (just the ground pieces) so we don't have to
` check the upper 8 bits of the dword
if x>0 and x<ameoba_bm_wid
if amap(x-1,y) or amap(x+1,y) then ret=1
else
if x=0
if amap(x+1,y) then ret=1
else
if amap(x-1,y) then ret=1
endif
endif
if y>0 and y<ameoba_bm_hgt
if amap(x,y-1) or amap(x,y+1) then ret=1
else
if y=0
if amap(x,y+1) then ret=1
else
if amap(x,y-1) then ret=1
endif
endif
endfunction ret
Rem ***** Included Source File *****
` Create a trace file so as I can track various parts of the program
function WL_TRACE_INIT(file$)
global WL_TRACE_FP as integer
c as integer : c=1
while ( c <= 32 and file open( c ) )
inc c
endwhile
if ( c <= 32 )
WL_TRACE_FP=c
else
exitfunction
endif
if ( file exist(file$) ) then delete file file$
open to write WL_TRACE_FP,file$
write string WL_TRACE_FP,"Trace file created : "+get date$()+", "+get time$()
write string WL_TRACE_FP,"File handle used : "+str$(WL_TRACE_FP)
endfunction
function WL_TRACE_CLOSE()
write string WL_TRACE_FP,"EOF Trace file (safe program exit)"
close file WL_TRACE_FP
endfunction
function WL_TRACE_WRITE(t$)
write string WL_TRACE_FP,t$
endfunctionWarning! May contain Nuts!
