i made this map generator for someone real quick
so here i am sharing this one with you guys too.
it basicly creating new objects in front of you and eraces the ones that too far from you.
sync on
sync rate 60
autocam off
type TObjList
ObjNum as Integer
InUse as Boolean
endtype
dim ObjList(0) as TObjList
backdrop on
color backdrop 0
global RandomCreateTime as Integer
randomize timer()
do
text 0,0,"FPS: "+str$(screen fps())
text 0,15,"Total Polygons: "+str$(statistic(1))
text 0,30,"Total Objects: "+str$(TotalDrawnedObjects())
RunEngine()
sync
loop
function RunEngine()
move camera 1
yrotate camera camera angle y()+(rightkey()-leftkey())
if RandomCreateTime < Timer()
CreateObjectInFront()
RandomCreateTime = timer()+rnd(300)
endif
RemovingOldObjects()
endfunction
function RemovingOldObjects()
a as integer
for a =0 to array count(ObjList(0))-1
if ObjList(a).Inuse = 1
if Dist(object position x(ObjList(a).ObjNum),object position y(ObjList(a).ObjNum),object position z(ObjList(a).ObjNum)) > 300
ObjList(a).Inuse = 0
delete object ObjList(a).ObjNum
endif
endif
next a
endfunction
function TotalDrawnedObjects()
a as integer
res as integer
Res = 0
for a =0 to array count(ObjList(0))-1
if ObjList(a).INuse = 1 then inc Res
next a
endfunction Res
function FreeObject()
a as integer
a = 0
repeat
inc a
until object exist(a)=0
endfunction a
function FindFreeObjList()
a as integer
for a = 0 to array count(ObjList(0))-1
if ObjList(a).InUse = 0 then exitfunction a
next a
a = -1
endfunction a
function CreateObjectInFront()
Obj as integer
Obj = FindFreeObjList()
if Obj = -1
Dim ObjList(array count(ObjList(0))+1) as TObjList
Obj = array count(ObjList(0))-1
endif
ObjList(Obj).INUse = 1
ObjList(Obj).ObjNum = FreeObject()
O as Integer
O = rnd(1)
if O = 0 then make object cube ObjList(Obj).ObjNum,rnd(5)+2
if O = 1 then make object sphere ObjList(Obj).objNum,rnd(5)+2
position object ObjList(Obj).ObjNum,camera position x(),camera position y(),camera position z()
yrotate object ObjList(Obj).ObjNum,camera angle y()
move object ObjList(Obj).ObjNum,200
yrotate object ObjList(Obj).ObjNum,rnd(90)
move object up ObjList(Obj).ObjNum,rnd(90)-45
move object left ObjList(Obj).ObjNum,rnd(90)-45
endfunction
function Dist(PosX as Integer,PosY as Integer,PosZ as Integer)
CamX as Integer
CamY as Integer
CamZ as Integer
CamX = camera position x()
CamY = camera position y()
CamZ = camera position z()
dis#=sqrt(((CamX-PosX)^2)+((CamY-posY)^2)+((CamZ-PosZ)^2))
endfunction dis#
Left/right keys to turn the camera.
enjoy.
Edit:
Small Fixes, more objects, and works smoother
sync on
sync rate 60
autocam off
type TObjList
ObjNum as Integer
InUse as Boolean
endtype
dim ObjList(0) as TObjList
backdrop on
color backdrop 0
global RandomCreateTime as Integer
randomize timer()
SetupSourceObjects()
do
text 0,0,"FPS: "+str$(screen fps())
text 0,15,"Total Polygons: "+str$(statistic(1))
text 0,30,"Total Objects: "+str$(TotalDrawnedObjects())
RunEngine()
sync
loop
function SetupSourceObjects()
make object cube 1,5
hide object 1
make object sphere 2,5
hide object 2
endfunction
function RunEngine()
move camera 1
yrotate camera camera angle y()+(rightkey()-leftkey())
if RandomCreateTime < Timer()
CreateObjectInFront()
RandomCreateTime = timer()+rnd(100)
endif
RemovingOldObjects()
endfunction
function RemovingOldObjects()
a as integer
for a =0 to array count(ObjList(0))-1
if ObjList(a).Inuse = 1
if Dist(object position x(ObjList(a).ObjNum),object position y(ObjList(a).ObjNum),object position z(ObjList(a).ObjNum)) > 300
ObjList(a).Inuse = 0
delete object ObjList(a).ObjNum
endif
endif
next a
endfunction
function TotalDrawnedObjects()
a as integer
res as integer
Res = 0
for a =0 to array count(ObjList(0))-1
if ObjList(a).INuse = 1 then inc Res
next a
endfunction Res
function FreeObject()
a as integer
a = 0
repeat
inc a
until object exist(a)=0
endfunction a
function FindFreeObjList()
a as integer
for a = 0 to array count(ObjList(0))-1
if ObjList(a).InUse = 0 then exitfunction a
next a
a = -1
endfunction a
function CreateObjectInFront()
Obj as integer
Obj = FindFreeObjList()
if Obj = -1
Dim ObjList(array count(ObjList(0))+1) as TObjList
Obj = array count(ObjList(0))-1
endif
ObjList(Obj).INUse = 1
ObjList(Obj).ObjNum = FreeObject()
O as Integer
O = rnd(1)+1
clone object ObjList(Obj).ObjNum,O
position object ObjList(Obj).ObjNum,camera position x(),camera position y(),camera position z()
yrotate object ObjList(Obj).ObjNum,camera angle y()
move object ObjList(Obj).ObjNum,200
yrotate object ObjList(Obj).ObjNum,rnd(90)
move object up ObjList(Obj).ObjNum,rnd(90)-45
move object left ObjList(Obj).ObjNum,rnd(500)-250
endfunction
function Dist(PosX as Integer,PosY as Integer,PosZ as Integer)
CamX as Integer
CamY as Integer
CamZ as Integer
CamX = camera position x()
CamY = camera position y()
CamZ = camera position z()
dis#=sqrt(((CamX-PosX)^2)+((CamY-posY)^2)+((CamZ-PosZ)^2))
endfunction dis#
