Source code now released for the new updated editor...
Include this file into your project:
` Used by the Loader
#constant WLSG_I_OBJ_COUNT 0
#constant WLSG_I_FOGCOLOR 4
#constant WLSG_I_BACKDROP 8
#constant WLSG_I_VIEWDIST 12
#constant WLSG_I_CAMFOV 16
#constant WLSG_I_FOGDIST 20
#constant WLSG_I_CHECKFOG 24
#constant WLSG_OBJECT_LIST 28
#constant WLSG_I_OBJECT 0
#constant WLSG_B_OBJECT_HIDEZONE 4
#constant WLSG_B_OBJECT_SCALING 5
#constant WLSG_B_COLLTYPE 6
#constant WLSG_B_COLLGROUP 7
#constant WLSG_OBJECT_NEXT 8
` Private constants
#constant WLSG_USE_DIFF 1
#constant WLSG_USE_AMB 2
#constant WLSG_USE_SPEC 4
#constant WLSG_USE_EMIS 8
#constant WLSG_USE_SPECPOW 16
#constant WLSG_USE_SMOOTH 32
#constant WLSG_USE_GHOST 64
#constant WLSG_USE_TRANSP 128
#constant WLSG_USE_FOG 256
#constant WLSG_USE_FILTER 512
#constant WLSG_USE_LIGHT 1024
#constant WLSG_USE_AMBIENT 2048
#constant WLSG_USE_CULL 4096
#constant WLSG_USE_ZONE 8192
` =========================================
` Find free memblock
` can be optimised but doesn't need to be for
` loading from disk
` returns memid or 0 if failed
function WLSG_FIND_MEMBLOCK()
curr as integer
memid as integer
curr = 1
memid = 0
while ( curr <= 255 and memblock exist(curr) )
inc curr
endwhile
if ( curr <= 255 )
memid = curr
endif
endfunction memid
` =========================================
` find free object
function WLSG_FIND_OBJECT()
curr as integer
curr = 1
while ( object exist( curr ) )
inc curr
endwhile
endfunction curr
` =========================================
` find free file handle
` return fp or 0 if failed
function WLSG_FIND_FILE()
curr as integer
fp as integer
curr = 1
fp = 0
while ( curr <=32 and file open( curr ) )
inc curr
endwhile
if ( curr <= 32 )
fp = curr
endif
endfunction fp
` =========================================
` load a wlsg file and return memblock id
function WLSG_LOAD_SCENE( file$ )
fp as integer ` file handle
curr as integer ` current object
x as float ` for read pos, rot, scale
y as float
z as float
w as word ` for reading short vals
b as byte ` for reading byte vals
l as dword ` for reading int vals
str as string
count as integer ` number of objects to read
mem as integer ` memblock id
obj as integer ` object id
zone as integer
colltype as integer
collgroup as integer
scale as integer
` holds the object numbers loaded from
` file and use them for duplicates
dim dup() as integer
empty array dup()
fp = WLSG_FIND_FILE()
` valid file pointer ID
if ( fp = 0 )
exitfunction 0
endif
open to read fp, file$
if ( file open( fp ) = 0 )
exitfunction 0
endif
` get number of objects to read
read long fp,count
` create memblock to hold level data
mem = WLSG_FIND_MEMBLOCK()
if ( mem = 0 )
close file fp
exitfunction 0
endif
make memblock mem, WLSG_OBJECT_LIST + ( WLSG_OBJECT_NEXT * count )
if ( memblock exist( mem ) = 0 )
close file fp
exitfunction 0
endif
` write object count to memblock
write memblock dword mem,WLSG_I_OBJ_COUNT,count
curr = 0
while ( count > 0 )
zone = 0
` read a byte
read byte fp,b
obj = WLSG_FIND_OBJECT()
` write the object number to the list
write memblock dword mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_I_OBJECT,obj
select b
case 42: ` ascii for '*'
` duplicate object
read long fp, l
clone object obj,dup(l)
endcase
case 90: ` ascii for 'Z'
` create zone
zone = 1 ` flag it as create zone
make object box obj,100,100,100
endcase
case default
` read file object
str=""
repeat
str = str + chr$( b )
read byte fp,b
until ( b = 0 )
load object str,obj
` store the object num in the duplicate list
array insert at bottom dup()
dup() = obj
endcase
endselect
` read position
read float fp,x
read float fp,y
read float fp,z
position object obj,x,y,z
` read rotation
read float fp,x
read float fp,y
read float fp,z
rotate object obj,x,y,z
` read scale
read float fp,x
read float fp,y
read float fp,z
scale object obj,x,y,z
if ( zone = 1 )
` process zone collision group
read long fp,l : b = l ` cast as a byte
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_OBJECT_HIDEZONE, 255
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_COLLGROUP, b
SC_SetupObject obj,l,2
hide object obj
else
` check for scaling
if ( x <> 100 or y <> 100 or z <> 100 )
scale=1
else
scale=0
endif
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_SCALING, scale
` check the hide flag
read byte fp,b
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_HIDEZONE, b
if ( b <> 0 )
hide object obj
endif
` read the collision info
read long fp,colltype
read long fp,collgroup
` if collgroup is not 0 then setup collision
if ( collgroup > 0 )
if ( colltype = 3 )
SC_SetupComplexObject obj,collgroup,2
else
SC_SetupObject obj,collgroup,colltype
endif
` allow scaling ?
if ( scale = 1 )
SC_AllowObjectScaling obj
endif
endif
` store collision in memblock
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_COLLTYPE, colltype
write memblock byte mem,WLSG_OBJECT_LIST + ( curr * WLSG_OBJECT_NEXT ) + WLSG_B_COLLGROUP, collgroup
` now read the object setup flags
read word fp,w
if ( w and WLSG_USE_DIFF )
read long fp,l
set object diffuse obj,l
endif
if ( w and WLSG_USE_AMB )
read long fp,l
set object ambience obj,l
endif
if ( w and WLSG_USE_SPEC )
read long fp,l
set object specular obj,l
endif
if ( w and WLSG_USE_EMIS )
read long fp,l
set object emissive obj,l
endif
if ( w and WLSG_USE_SPECPOW )
read long fp,l
set object specular power fp,l
endif
if ( w and WLSG_USE_SMOOTH )
read long fp,l
set object smoothing obj,l
endif
if ( w and WLSG_USE_GHOST )
ghost object on obj
endif
set object transparency obj, ( w and WLSG_USE_TRANSP ) / WLSG_USE_TRANSP
set object fog obj, ( w and WLSG_USE_FOG ) / WLSG_USE_FOG
set object filter obj, ( w and WLSG_USE_FILTER ) / WLSG_USE_FILTER
set object light obj, ( w and WLSG_USE_LIGHT ) / WLSG_USE_LIGHT
set object ambient obj, ( w and WLSG_USE_AMBIENT) / WLSG_USE_AMBIENT
set object cull obj, ( w and WLSG_USE_CULL ) / WLSG_USE_CULL
endif
inc curr
dec count
endwhile
` empty the duplicates array
empty array dup()
` now read the scene setup
read long fp,l
fog color l
write memblock dword mem,WLSG_I_FOGCOLOR,l
read long fp,l
color backdrop l
write memblock dword mem,WLSG_I_BACKDROP,l
read word fp,w : l = w ` casting to dword for safety
set camera range 1,l
write memblock dword mem,WLSG_I_VIEWDIST,l
read word fp,w : l = w
set camera FOV l
write memblock dword mem,WLSG_I_CAMFOV,l
read word fp,w : l = w
fog distance l
write memblock dword mem,WLSG_I_FOGDIST,l
read byte fp,b
if ( b )
fog on
else
fog off
endif
l = b
write memblock dword mem,WLSG_I_CHECKFOG,l
close file fp
endfunction mem
` =========================================
` free a scene (delete it all)
function WLSG_FREE_SCENE( mem as integer )
curr as integer
count as integer
obj as integer
curr = WLSG_OBJECT_LIST
count = memblock dword( mem, WLSG_OBJ_COUNT )
while ( count > 0 )
obj = memblock dword( mem, curr + WLSG_I_OBJECT )
` remove collision if set
if ( SC_CollisionStatus( obj ) )
SC_RemoveObject obj
endif
` now delete the object
delete object obj
dec count
curr = curr + WLSG_OBJECT_NEXT
endwhile
` delete the memblock
delete memblock mem
endfunction
` =========================================
` Hide a scene from view
function WLSG_HIDE_SCENE( mem as integer )
curr as integer
count as integer
obj as integer
curr = WLSG_OBJECT_LIST
count = memblock dword( mem, WLSG_I_OBJ_COUNT )
while ( count > 0 )
obj = memblock dword( mem, curr + WLSG_I_OBJECT )
hide object obj
if ( SC_CollisionStatus( obj ) )
SC_RemoveObject obj
endif
dec count
curr = curr + WLSG_NEXT
endwhile
endfunction
` =========================================
` Show a scene back into view
function WLSG_SHOW_SCENE( mem as integer )
curr as integer
count as integer
obj as integer
colltype as integer
collgroup as integer
hide as byte
curr = WLSG_OBJECT_LIST
count = memblock dword( mem, WLSG_I_OBJ_COUNT )
while ( count > 0 )
obj = memblock dword( mem, curr + WLSG_I_OBJECT )
hide = memblock byte( mem, curr + WLSG_B_HIDEZONE )
` setup a zone ?
if ( hide = 255 )
SC_SetupObject obj,memblock byte( mem, curr + WLSG_B_COLLGROUP ), 2
else
` object not hidden ?
if ( hide = 0 )
show object obj
endif
colltype = memblock byte(mem,curr + WLSG_B_COLLTYPE)
collgroup = memblock byte(mem,curr + WLSG_B_COLLGROUP)
if ( collgroup > 0 )
if ( colltype = 3 )
SC_SetupComplexObject obj, collgroup,2
else
SC_SetupObject obj,collgroup, colltype
endif
if ( memblock byte( mem, curr + WLSG_B_SCALING ) = 1 )
SC_AllowObjectScaling obj
endif
endif
endif
curr = curr + WLSG_OBJECT_NEXT
dec count
endwhile
endfunction
` =========================================
` return an objects id from the list
function WLSG_GET_OBJECT(mem as integer,num as integer)
obj as integer
obj = memblock dword( mem, WLSG_OBJECT_LIST + ( num * WLSG_OBJECT_NEXT ) + WLSG_I_OBJECT )
endfunction obj
` =========================================
Here's an example piece of code which has been tested with it:
` Main file to test the WLSG include file
` may as well use the WLSG find object routine
global pobj as integer
global level as integer
global campitch as float
global playerjump as float
global gravity as float
` for this test the media etc is in the previous dir
set dir "..\"
setup_screen()
setup_level()
create_player()
setup_camera()
do
control_player()
move_camera()
draw_hud()
sync
loop
end
` =========================================
` OTHER STUFF
function create_player()
zone as integer
playerjump=0
gravity=0.2
pobj = WLSG_FIND_OBJECT()
make object sphere pobj, 20
zone=WLSG_GET_OBJECT(level,5)
position object pobj,object position x(zone),object position y(zone),object position z(zone)
set object specular pobj,0xffffff
set object specular power pobj,5
endfunction
` =========================================
function setup_camera()
campitch=0
make light 1
endfunction
` =========================================
function move_camera()
`control camera using arrowkeys 0,5,1
position camera object position x(pobj),object position y(pobj)+20-campitch,object position z(pobj)
set camera to object orientation pobj
move camera -40
pitch camera up campitch
position light 1,camera position x(),camera position y(),camera position z()
endfunction
` =========================================
function draw_hud()
text 0,0,"FPS="+str$(screen fps())
endfunction
` =========================================
function setup_screen()
sync rate 0
sync on
autocam off
set display mode 1024, 768, 32
endfunction
` =========================================
function setup_level()
level=WLSG_LOAD_SCENE("level1.dsn")
endfunction
` =========================================
function control_player()
mx as float
my as float
mc as integer
rotx as float
roty as float
rotz as float
objx as float
objy as float
objz as float
newx as float
newy as float
newz as float
ynorm as float
move as float
strafe as float
coll as integer
move=0
strafe=0
rotx=object angle x(pobj)
roty=object angle y(pobj)
rotz=object angle z(pobj)
objx=object position x(pobj)
objy=object position y(pobj)
objz=object position z(pobj)
mx=mousemovex()/4.0
my=mousemovey()/4.0
mc=mouseclick()
campitch=campitch-my
if campitch<-40 then campitch=-40
if campitch>40 then campitch=40
roty=wrapvalue(roty+mx)
if leftkey() then strafe=strafe-1
if rightkey() then strafe=strafe+1
if upkey() then move=move+1
if downkey() then move=move-1
newx=objx+(sin(roty)*move)+(sin(roty+90)*strafe)
newz=objz+(cos(roty)*move)+(cos(roty+90)*strafe)
playerjump=playerjump-gravity
if playerjump<-10 then playerjump=-10
newy=objy+playerjump
coll=SC_SphereCastGroup(1,objx,objy,objz,newx,newy,newz,10,0)
if coll
ynorm=SC_GetCollisionNormalY()
if ynorm>0.7
if mc and 2 then playerjump=4
endif
if ynorm<0.8
newx=SC_GetCollisionSlideX()
newz=SC_GetCollisionSlideZ()
playerjump=0
endif
newy=SC_GetCollisionSlideY()
endif
position object pobj,newx,newy,newz
rotate object pobj,rotx,roty,rotz
endfunction
` =========================================
Also, in the very top post is the download with the editor, source, include file for DBP and a quick example DBP project.
Hope this helps anyone out there.
Warning! May contain Nuts!
