Found a bit of time this evening, so here is my present to the challenge community - use at your own peril! It is the updated No-media modeller and code exporter, all in one. Just to be clear, for those that don't know, this is a drag and drop level editor that needs no media, and can be used to create no-media levels very easily.
It's incredibly simple to use:
1. Create a project folder, with this program in it.
2. Run the program, and create your scene.
3. Press the save button. Look in your project folder, and lo and behold, as well as the saved scene, which can be loaded back into the modeller for further editing, the complete code needed to recreate the scene, including data statements, has been created for you and is ready to run!
A couple of pointers for using the editor itself:
1. Use the left mouse button for x-z positioning/scaling
2. Use the right mouse button for y positioning/scaling
3. Don't use the 'erase' button - it's bugged at the moment I'm afraid.
Please feel free to give feedback regarding bugs/problems/improvements etc.
`No-media modeller and exporter by Ric.
`Thanks to CPU for the 3d mouse function :)
`Erase button is bugged - don't use until fixed!
set display mode 800,600,32
backdrop on
color backdrop 0
autocam off
sync on
position camera 64,30,-64
hide light 0
make light 1
set ambient light 50
numberoflights=1
position light 1,0,30,0
make object cube 1,1
hide object 1
Make Object plain 2,128,128
Position Object 2,64,0,64
xrotate object 2,-90
grid=free_image()
ink rgb(255,255,255),0
box 0,0,500,500
ink rgb(200,200,200),0
for x=0 to 500 step 20
for y=0 to 500 step 20
box x,y,x+10,y+10
next y
next x
get image grid,0,0,500,500
texture object 2,grid
whitesquare=free_sprite()
ink rgb(255,255,255),0
box 0,0,32,32
get image whitesquare,0,0,32,32
sprite whitesquare,4,204,whitesquare
gosub make_texture_sprites
type objecttype
boxx as float
boxy as float
boxz as float
scalex as float
scaley as float
scalez as float
scaleu as float
scalev as float
scaledu as float
scaledv as float
storeuscale as float
storevscale as float
texture as integer
typeofobject as string
endtype
type TYPE_XYZfloat
x as float
y as float
z as float
endtype
global GU_XYZReturn as TYPE_XYZfloat
global mx#
global my#
global create
snapvalue=1
scalefactor#=0.99
make camera 1
color backdrop 1,rgb(0,0,0)
position camera 1,64,90,64
point camera 1,64,0,64
set camera view 1,80,40,screen width()/2-80,190
make camera 2
color backdrop 2,rgb(100,100,100)
position camera 2,64,0.1,-10
point camera 2,64,0,64
set camera view 2,screen width()/2+80,40,screen width()-80,190
set current camera 0
textureobject=free_sprite()
make_button(textureobject,"apply texture",131,20,324,160)
empty=free_sprite()
make_button(empty,"",630,28,86,6)
set sprite diffuse empty,200,200,250
cube=free_sprite()
make_button(cube,"cube",50,20,50+40,10)
box_=free_sprite()
make_button(box_,"box",50,20,102+40,10)
sphere=free_sprite()
make_button(sphere,"sphere",50,20,154+40,10)
cone=free_sprite()
make_button(cone,"cone",50,20,206+40,10)
cylinder=free_sprite()
make_button(cylinder,"cylinder",50,20,258+40,10)
lights=free_sprite()
make_button(lights,"lights",50,20,310+40,10)
shadows=free_sprite()
make_button(shadows,"shadows",50,20,362+40,10)
position=free_sprite()
make_button(position,"position",50,20,414+40,10)
scale=free_sprite()
make_button(scale,"scale",50,20,466+40,10)
rotate=free_sprite()
make_button(rotate,"rotate",50,20,518+40,10)
load=free_sprite()
make_button(load,"load",50,20,570+40,10)
save=free_sprite()
make_button(save,"save",50,20,622+40,10)
snap1=free_sprite()
make_button(snap1,"Snap=1",50,20,310,40)
snap2=free_sprite()
make_button(snap2,"Snap=2",50,20,310,60)
snap4=free_sprite()
make_button(snap4,"Snap=4",50,20,310,80)
snap10=free_sprite()
make_button(snap10,"Snap=10",50,20,310,100)
scaleu=free_sprite()
make_button(scaleu,"Scale U",50,20,362,40)
scalev=free_sprite()
make_button(scalev,"Scale V",50,20,362,60)
erase=free_sprite()
make_button(erase,"Erase",50,20,362,80)
set sprite diffuse position,200,200,200
operation=position
positionon=1
ink rgb(0,255,0),0
do
mx#=mousemovex()
my#=mousemovey()
3dmouse()
3dcamera()
line 0,200,screen width(),200
gosub process_events
text 0,0,str$(excludero)
sync
loop
function make_button(spritenumber,btext$,bwidth#,bheight#,bx,by)
create bitmap 1,screen width(),screen height()
for n#=0.0 to bheight#
grey#=(140*n#/bheight#)+100
ink rgb(grey#,grey#,grey#),0
line 0,n#,bwidth#,n#
next n#
for n#=2.0 to bheight#-2
grey#=(140-140*n#/bheight#)+100
ink rgb(grey#,grey#,grey#),0
line 2,n#,bwidth#-2,n#
next n#
ink rgb(255,255,255),0
set text font "arial"
set text size 12
text bwidth#/2.0-text width(btext$)/2,bheight#/2.0-text height(btext$)/2.0,btext$
get image spritenumber,0,0,bwidth#,bheight#,1
delete bitmap 1
sprite spritenumber,bx,by,spritenumber
endfunction
function free_sprite
repeat
inc n
until sprite exist(n)=0 and image exist(n)=0
endfunction n
function pick_sprite(lower,upper)
for spritenumber=lower to upper
if mousex()>=sprite x(spritenumber) and mousex()<=sprite x(spritenumber)+sprite width(spritenumber) and mousey()>=sprite y(spritenumber) and mousey()<=sprite y(spritenumber)+sprite height(spritenumber)
pick=spritenumber
endif
next spritenumber
endfunction pick
function pick_sized_sprite(lower,upper,width,height)
for spritenumber=lower to upper
if mousex()>=sprite x(spritenumber) and mousex()<=sprite x(spritenumber)+width and mousey()>=sprite y(spritenumber) and mousey()<=sprite y(spritenumber)+height
pick=spritenumber
endif
next spritenumber
endfunction pick
process_events:
`button click events
pick=pick_sprite(cube,shadows)
if pick>0 and pick<=lights and mouseclick()=1
selection=pick
gosub reset_operations
gosub reset_buttons
set sprite diffuse selection,200,200,200
create=1
positionon=1
endif
if mouseclick()=1 and pick_sprite(save,save)=save then gosub savescene
if mouseclick()=1 and pick_sprite(load,load)=load then gosub loadscene
if mouseclick()=1 and pick_sprite(snap1,snap1)=snap1 then snapvalue=1
if mouseclick()=1 and pick_sprite(snap2,snap2)=snap2 then snapvalue=2
if mouseclick()=1 and pick_sprite(snap4,snap4)=snap4 then snapvalue=4
if mouseclick()=1 and pick_sprite(snap10,snap10)=snap10 then snapvalue=10
if create=1 then gosub create_object
if pick=shadows and mouseclick()=1
gosub reset_buttons
if light1>0 then gosub calculate_shadows
endif
if mouseclick()>0
operation=pick_sprite(position,rotate)
if operation>0
gosub reset_operations
set sprite diffuse operation,200,200,200
if operation=position then positionon=1
if operation=scale then scaleon=1
if operation=rotate then rotateon=1
endif
endif
if mouseclick()=1 and pick_sprite(scaleu,scaleu)=scaleu
gosub reset_operations
set sprite diffuse scaleu,200,200,200
scaleuon=1
endif
if mouseclick()=1 and pick_sprite(scalev,scalev)=scalev
gosub reset_operations
set sprite diffuse scalev,200,200,200
scalevon=1
endif
if mouseclick()=1 and pick_sprite(erase,erase)=erase then gosub reset_operations:eraseon=1
if mouseclick()=0
excludescale=0
excludeso=0
endif
if mouseclick()=0
excludero=0
excludeso=0
excluderoto=0
if object>0
if object exist(object) and object<>light1 and object<>light2 then set object light object,1
endif
endif
`texture selection
if mouseclick()=1
if pick_sized_sprite(grass,red,40,40)>0 then texture=pick_sized_sprite(grass,red,40,40)
if texture>0 then sprite whitesquare,sprite x(texture)-1,sprite y(texture)-1,whitesquare
if pick_sprite(textureobject,textureobject)>0 and texture>0 then gosub reset_operations:applytexture=1:set sprite diffuse textureobject,200,200,200
endif
`object click events
pickobject=pick object(mousex(),mousey(),3,numberofobjects+2)
if mouseclick()>0 and mouseclick()<3 and exclude=0 and pickobject>2 then picked=pickobject:exclude=1:set object light picked,0
if mouseclick()=0 and picked>2
exclude=0:set object light picked,1:picked=0
endif
if picked>2 and mouseclick()<3
if positionon=1 then gosub reposition_object
if rotateon=1 then gosub rotate_object
if scaleon=1 then gosub scale_object
if scaleuon=1 then gosub scaleu_object
if scalevon=1 then gosub scalev_object
if eraseon=1 then delete object picked
if applytexture=1
gosub apply_texture
endif
endif
return
apply_texture:
texture object picked,texture
object(picked).texture=texture
return
reset_operations:
eraseon=0
scaleon=0
rotateon=0
positionon=0
applytexture=0
scaleuon=0
scalevon=0
for n=position to rotate
set sprite diffuse n,255,255,255
next n
set sprite diffuse textureobject,255,255,255
set sprite diffuse scaleu,255,255,255
set sprite diffuse scalev,255,255,255
return
reset_buttons:
for spritenumber=cube to shadows
set sprite diffuse spritenumber,255,255,255
next spritenumber
return
rotate_object:
object=picked
if create=0
`set cursor to object position first time only
if excluderoto=0
excluderoto=1
position object 1,object position x(object),object position y(object),object position z(object)
endif
if object<>light1 and object<>light2
if mouseclick()=1
turn object right object,mx#
pitch object up object,-my#
endif
if mouseclick()=2
roll object right object,-my#
endif
endif
if mouseclick()=0
excluderoto=0
if object<>light1 and object<>light2 then set object light object,1
endif
endif
return
function free_object
repeat
inc n
until object exist(n)=0
endfunction n
Function 3dmouse()
`left mouse moves in the XZ direction
if create=1 or mouseclick()=1
SYS_screenToXZ(mousex(), mousey(), 0, object position y(1))
position object 1, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
else
`right mouse moves in the Y direction
if mouseclick() = 2
tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(1), object position z(1))
position object 1, object position x(1), tmp#, object position z(1)
endif
endif
EndFunction
function 3dcamera
if upkey()=1 then move camera 0.2
if downkey()=1 then move camera -0.2
if leftkey()=1 then turn camera left 90:move camera 0.2:turn camera right 90
if rightkey()=1 then turn camera right 90:move camera 0.2:turn camera left 90
if mouseclick()=3 then turn camera right mx#/2.0
if inkey$()="a" then pitch camera up 90:move camera 0.2:pitch camera down 90
if inkey$()="z" then pitch camera down 90:move camera 0.2:pitch camera up 90
endfunction
create_object:
position object 1,object position x(1),0,object position z(1)
if mousey()>200 and mouseclick()=1
inc numberofobjects
dim object(numberofobjects+2) as objecttype
object=free_object()
if selection=cube then make object cube object,5:object(object).typeofobject="cube"
if selection=box_
if object-1>0 and object(object-1).typeofobject="box"
xb#=object size x(object-1)
yb#=object size y(object-1)
zb#=object size z(object-1)
make object box object,xb#,yb#,zb#
`scale object object,object(object-1).scalex,object(object-1).scaley,object(object-1).scalez
`object(object).scalex=object(object-1).scalex
`object(object).scaley=object(object-1).scaley
`object(object).scalez=object(object-1).scalez
else
make object box object,5,20,5
endif
object(object).typeofobject="box"
object(object).boxx=object size x(object)
object(object).boxy=object size y(object)
object(object).boxz=object size z(object)
endif
if selection=sphere then make object sphere object,5,10,10:object(object).typeofobject="sphere"
if selection=cone then make object cone object,5:object(object).typeofobject="cone"
if selection=cylinder then make object cylinder object,5:object(object).typeofobject="cylinder"
if selection=lights and light2>0 then gosub reset_buttons:goto getoutofhere
if selection=lights
make object sphere object,2,10,10:object(object).typeofobject="light"
color object object,rgb(255,255,0)
set object light object,0
if light1>0 then light2=object:make light 2:numberoflights=2
if light1=0 then light1=object
endif
if texture>0 and object<>light1 and object<>light2
texture object object,texture
object(object).texture=texture
else
if object<>light1 and object<>light2 then color object object,rgb(rnd(255),rnd(255),rnd(255))
endif
position object object,object position x(1),object position y(1),object position z(1)
if object=light1 then position light 1,object position x(1),0.1,object position z(1)
if object=light2 then position light 2,object position x(1),0.1,object position z(1)
set object cull object,0
gosub reset_buttons
create=0
endif
getoutofhere:
return
reposition_object:
object=picked
if create=0
`set cursor to object position first time only
if excludero=0
excludero=1
`get offset
offsetx#=-object position x(object)+(get pick vector x()+camera position x())
offsety#=-object position y(object)+(get pick vector y()+camera position y())
offsetz#=-object position z(object)+(get pick vector z()+camera position z())
position object 1,object position x(object)+offsetx#,object position y(object)+offsety#,object position z(object)+offsetz#
endif
position object object,snapvalue*int((object position x(1)-offsetx#)/snapvalue),snapvalue*int((object position y(1)-offsety#)/snapvalue),snapvalue*int((object position z(1)-offsetz#)/snapvalue)
if mouseclick()=0
excludero=0
if object<>light1 and object<>light2 then set object light object,1
endif
if object=light1 then position light 1,object position x(light1),object position y(light1),object position z(light1)
if object=light2 then position light 2,object position x(light2),object position y(light2),object position z(light2)
endif
return
scale_object:
object=picked
if create=0
`set cursor to object position first time only
if excludeso=0
excludeso=1
position object 1,object position x(object),object position y(object),object position z(object)
endif
if mouseclick()=1
inc object(object).scalex,mx#
inc object(object).scalez,-my#
endif
if mouseclick()=2
inc object(object).scaley,-my#
endif
snapvalue=snapvalue*2
if object<>light1 and object<>light2 then scale object object,snapvalue*int((100+object(object).scalex)/snapvalue),snapvalue*int((100+object(object).scaley)/snapvalue),snapvalue*int((100+object(object).scalez)/snapvalue)
snapvalue=snapvalue/2
if object size x(object)<.1 then scale object object,200,100,100
if object size y(object)<.1 then scale object object,100,200,100
if object size z(object)<.1 then scale object object,100,100,200
if mouseclick()=0
excludeso=0
if object<>light1 and object<>light2 then set object light object,1
endif
endif
return
scaleu_object:
object=picked
if create=0
`set cursor to object position first time only
if excludesuo=0
excludesuo=1
position object 1,object position x(object),object position y(object),object position z(object)
endif
if mouseclick()=1 `and excludescale=0
excludescale=1
inc object(object).scaleu
scale object texture object,1*scalefactor#,1
endif
if mouseclick()=2 `and excludescale=0
excludescale=1
dec object(object).scaleu
scale object texture object,1/scalefactor#,1
endif
endif
if mouseclick()=0
if object<>light1 and object<>light2 then set object light object,1
endif
return
scalev_object:
object=picked
if create=0
`set cursor to object position first time only
if excludesvo=0
excludesvo=1
position object 1,object position x(object),object position y(object),object position z(object)
endif
if mouseclick()=1 `and excludescale=0
excludescale=1
inc object(object).scalev
scale object texture object,1,1*scalefactor#
endif
if mouseclick()=2 `and excludescale=0
excludescale=1
dec object(object).scalev
scale object texture object,1,1/scalefactor#
endif
endif
if mouseclick()=0
if object<>light1 and object<>light2 then set object light object,1
endif
return
calculate_shadows:
undim pixelshaded1(128,128)
undim pixelshaded2(128,128)
dim pixelshaded1(128,128)
dim pixelshaded2(128,128)
if light1>0
create bitmap 1,128,128
set current bitmap 1
ink rgb(255,255,255),0
box 0,0,128,128
ink rgb(10,10,10),0
for y=0 to 128
for x=0 to 128
for object=3 to numberofobjects+2
if object exist(object)=1
if object<>light1 and object<>light2
ray1#=intersect object(object,x,0,y,object position x(light1),object position y(light1),object position z(light1))
if light2>0 then ray2#=intersect object(object,x,0,y,object position x(light2),object position y(light2),object position z(light2)) else ray2=0
if ray1#=0 then ray1#=1000
if ray1#<0 then ray1#=1
if ray2#=0 then ray2#=1000
if ray2#<0 then ray2#=1
if ray1#<=100 and ray2#>100
tone=100+ray1#*2
if pixelshaded2(x,y)=1 or pixelshaded1(x,y)=1 then tone=tone/1.5
if tone>255 then tone=255
ink rgb(tone,tone,tone),0
dot x,128-y
pixelshaded1(x,y)=1
endif
if ray2#<=100 and ray1#>100
tone=100+ray2#*2
if pixelshaded1(x,y)=1 or pixelshaded2(x,y)=1 then tone=tone/1.5
if tone>255 then tone=255
ink rgb(tone,tone,tone),0
dot x,128-y
pixelshaded2(x,y)=1
endif
if ray1#<=100 and ray2#<=100
tone=50+(ray1#+ray2#)
if tone>255 then tone=255
ink rgb(tone,tone,tone),0
dot x,128-y
endif
endif
endif
next object
next x
next y
blur bitmap 1,3
shadowmap=free_image()
get image shadowmap,0,0,128,128
delete bitmap 1
set light mapping on 2,shadowmap
endif `(light1 exist)
return
function free_image
repeat
inc image
until image exist(image)=0
endfunction image
function SYS_screenToXZ(screenx as integer, screeny as integer, camera as integer, Yplain as float)
local pick as TYPE_XYZfloat
local height as float
local scalar as float
if camera <> 0
set current camera camera
endif
height = camera position y()
pick screen screenx, screeny, 1.0
pick.x = get pick vector x()
pick.y = get pick vector y()
pick.z = get pick vector z()
`scalar = Yplain - (height/pick.y)
scalar = -1*((height - Yplain)/pick.y)
`since it is impossible
GU_XYZReturn.x = (camera position x() + scalar*pick.x)
GU_XYZReturn.y = Yplain
GU_XYZReturn.z = (camera position z() + scalar*pick.z)
if camera <> 0
set current camera 0
endif
endfunction
function SYS_screenToY(screenx as integer, screeny as integer, camera as integer, Xpos as float, Zpos as float)
local vec0A as integer = 1
local vec1A as integer = 2
local vecB as integer = 3
local vecC as integer = 4
local tmp as float
local rtrn as float
tmp = make vector3(vec0A)
tmp = make vector3(vec1A)
tmp = make vector3(vecB)
tmp = make vector3(vecC)
rem after we make the vectors perform math...
pick screen screenx, screeny, 1.0
set vector3 vec0A, Xpos, 0, Zpos
set vector3 vec1A, 0, 1, 0
set vector3 vecB, get pick vector x(), get pick vector y(), get pick vector z()
cross product vector3 vecC, vec1A, vecB
cross product vector3 vecC, vecC, vecB
normalize vector3 vecC, vecC
tmp = X Vector3(vecC)*camera position x() + Y Vector3(vecC)*camera position y() + Z Vector3(vecC)*camera position z()
rtrn = (tmp - dot product vector3(vec0A, vecC)) / dot product vector3(vec1A, vecC)
tmp = delete vector3(vec0A)
tmp = delete vector3(vec1A)
tmp = delete vector3(vecB)
tmp = delete vector3(vecC)
endfunction rtrn
make_texture_sprites:
create bitmap 1,64,64
`grass
ink rgb(0,105,0),0
box 0,0,64,64
for n=1 to 500
x=rnd(64)
y=rnd(64)
ink rgb(rnd(40),50+rnd(150),rnd(40)),0
dot x,y
next n
blur bitmap 1,1
grass=free_sprite()
get image grass,0,0,64,64
`sandstone
ink rgb(200,100,0),0
box 0,0,64,64
for n=1 to 500
x=rnd(64)
y=rnd(64)
ink rgb(100,70,rnd(30)),0
dot x,y
next n
blur bitmap 1,3
sandstone=free_sprite()
get image sandstone,0,0,64,64
`wood
ink rgb(200,150,120),0
box 0,0,64,64
for n=1 to 40
a=rnd(64)
b=a+rnd(10)-5
ink rgb(100,50,rnd(50)),0
line a,0,b,64
next n
blur bitmap 1,3
wood=free_sprite()
get image wood,0,0,64,64
`mesh
ink 0,0
box 0,0,64,64
ink rgb(150,150,150),0
for x=1 to 64 step 8
line 0,x,64,x
line x,0,x,64
next x
blur bitmap 1,3
mesh=free_sprite()
get image mesh,0,0,64,64
`marble
ink rgb(200,230,230),0
box 0,0,64,64
for n=1 to 500
x=rnd(64)
y=rnd(64)
ink rgb(150+rnd(20),150+rnd(20),150+rnd(20)),0
box x,y,x+rnd(5),y+rnd(5)
next n
blur bitmap 1,3
marble=free_sprite()
get image marble,0,0,64,64
`plaster
ink rgb(240,220,210),0
box 0,0,64,64
for n=1 to 500
x=rnd(64)
y=rnd(64)
ink rgb(200+rnd(20),190+rnd(20),180+rnd(20)),0
box x,y,x+rnd(5),y+rnd(5)
next n
blur bitmap 1,3
plaster=free_sprite()
get image plaster,0,0,64,64
`concrete
ink rgb(180,180,180),0
box 0,0,64,64
for n=1 to 200
x=rnd(64)
y=rnd(64)
ink rgb(150+rnd(100),150+rnd(100),150+rnd(100)),0
dot x,y
next n
blur bitmap 1,3
concrete=free_sprite()
get image concrete,0,0,64,64
`brick
ink rgb(250,150,100),0
box 0,0,64,64
for n=1 to 600
x=rnd(64)
y=rnd(64)
ink rgb(125,75,rnd(50)),0
dot x,y
next n
ink rgb(230,230,230),0
for y=1 to 61 step 10
line 0,y,64,y
for x=0 to 64 step 6+rnd(4)
line x,y,x,y+10
next x
next y
blur bitmap 1,3
brick=free_sprite()
get image brick,0,0,64,64
`colours
box 0,0,64,64,rgb(250,0,0),rgb(0,255,0),rgb(0,0,255),rgb(255,255,0)
colours=free_sprite()
get image colours,0,0,64,64
`stones
ink rgb(220,200,190),0
box 0,0,64,64
for n=1 to 500
x=rnd(64)
y=rnd(64)
ink rgb(180+rnd(20),170+rnd(20),160+rnd(20)),0
box x,y,x+rnd(5),y+rnd(5)
next n
ink rgb(250,250,250),0
for y=1 to 61 step 10
line 0,y,64,y
for x=0 to 64 step 6+rnd(4)
line x,y,x,y+10
next x
next y
blur bitmap 1,2
stones=free_sprite()
get image stones,0,0,64,64
`white
ink rgb(255,255,255),0
box 0,0,64,64
white=free_sprite()
get image white,0,0,64,64
`red
ink rgb(255,0,0),0
box 0,0,64,64
red=free_sprite()
get image red,0,0,64,64
delete bitmap 1
for n=grass to red
inc xpos
sprite n,(xpos*35)-30,205,n
size sprite n,30,30
next n
return
savescene:
ink rgb(0,255,0),0
filename$=""
repeat
text 0,260,"enter a filename to save (without extension): "
if keydown=0
keydown=1
filename$=filename$+inkey$()
endif
if scancode()=0 then keydown=0
text 0,280,filename$
sync
until returnkey()=1
if shadowmap>0
if image exist(shadowmap)
if file exist(filename$+"_shadowmap"+".bmp") then delete file filename$+"_shadowmap"+".bmp"
save image filename$+"_shadowmap"+".bmp",shadowmap
endif
endif
if file exist(filename$+".scn") then delete file filename$+".scn"
open to write 1,filename$+".scn"
write string 1,str$(numberoflights)
write string 1,str$(light position x(1))
write string 1,str$(light position y(1))
write string 1,str$(light position z(1))
if numberoflights=2
write string 1,str$(light position x(2))
write string 1,str$(light position y(2))
write string 1,str$(light position z(2))
endif
write string 1,str$(numberofobjects)
for object=3 to numberofobjects+2
if object exist(object)
write string 1,object(object).typeofobject
if object(object).typeofobject="box"
write string 1,str$(object(object).boxx)
write string 1,str$(object(object).boxy)
write string 1,str$(object(object).boxz)
endif
write string 1,str$(object position x(object))
write string 1,str$(object position y(object))
write string 1,str$(object position z(object))
write string 1,str$(object angle x(object))
write string 1,str$(object angle y(object))
write string 1,str$(object angle z(object))
write string 1,str$(object(object).scalex)
write string 1,str$(object(object).scaley)
write string 1,str$(object(object).scalez)
write string 1,str$(object(object).scaleu)
write string 1,str$(object(object).scalev)
write string 1,str$(object(object).texture)
endif
text 0,0,"Saving"
sync
next object
close file 1
open to read 1,filename$+".scn"
if file exist(filename$+"_export.dba") then delete file filename$+"_export.dba"
open to write 2,filename$+"_export.dba"
write string 2,"REM No-media Game Environment By Ric."
write string 2,""
write string 2,"if check display mode(1024,768,32)=1 then set display mode 1024,768,32"
write string 2,"sync on"
write string 2,"autocam off"
write string 2,"position camera 64,32,-64"
write string 2,"hide light 0"
write string 2,"gosub setup_type"
write string 2,""
write string 2,""
write string 2,""
write string 2,"scalefactor#=0.99"
write string 2,"gosub make_textures"
write string 2,"gosub make_game_environment"
write string 2,"if light1>0 then hide object light1"
write string 2,"if light2>0 then hide object light2"
write string 2,"gosub calculate_shadows"
write string 2,""
write string 2,""
write string 2,"do"
write string 2,"control camera using arrowkeys 0,0.1,1"
write string 2,"sync"
write string 2,"loop"
write string 2,""
write string 2,""
write string 2,"setup_type:"
write string 2,""
write string 2,"type objecttype"
write string 2," boxx as float"
write string 2," boxy as float"
write string 2," boxz as float"
write string 2," scalex as float"
write string 2," scaley as float"
write string 2," scalez as float"
write string 2," scaleu as float"
write string 2," scalev as float"
write string 2," scaledu as float"
write string 2," scaledv as float"
write string 2," storeuscale as float"
write string 2," storevscale as float"
write string 2," texture as integer"
write string 2," typeofobject as string"
write string 2," endtype"
write string 2,""
write string 2,"return"
write string 2,""
write string 2,""
write string 2,"function free_object"
write string 2,""
write string 2,"repeat"
write string 2,"inc n"
write string 2,"until object exist(n)=0"
write string 2,""
write string 2,"endfunction n"
write string 2,""
write string 2,"calculate_shadows:"
write string 2,"undim pixelshaded1(128,128)"
write string 2,"undim pixelshaded2(128,128)"
write string 2,"dim pixelshaded1(128,128)"
write string 2,"dim pixelshaded2(128,128)"
write string 2,"if light1>0"
write string 2,"create bitmap 1,128,128"
write string 2,"set current bitmap 1"
write string 2,"ink rgb(255,255,255),0"
write string 2,"box 0,0,128,128"
write string 2,"ink rgb(10,10,10),0"
write string 2,"for y=0 to 128"
write string 2,"for x=0 to 128"
write string 2,"for object=3 to numberofobjects+2"
write string 2,"if object exist(object)=1"
write string 2,"if object<>light1 and object<>light2"
write string 2,"ray1#=intersect object(object,x,0,y,object position x(light1),object position y(light1),object position z(light1))"
write string 2,"if light2>0 then ray2#=intersect object(object,x,0,y,object position x(light2),object position y(light2),object position z(light2)) else ray2=0"
write string 2,"if ray1#=0 then ray1#=1000"
write string 2,"if ray1#<0 then ray1#=1"
write string 2,"if ray2#=0 then ray2#=1000"
write string 2,"if ray2#<0 then ray2#=1"
write string 2,"if ray1#<=100 and ray2#>100"
write string 2," tone=100+ray1#*2"
write string 2," if pixelshaded2(x,y)=1 or pixelshaded1(x,y)=1 then tone=tone/1.5"
write string 2," if tone>255 then tone=255"
write string 2," ink rgb(tone,tone,tone),0"
write string 2," dot x,128-y"
write string 2," pixelshaded1(x,y)=1"
write string 2,"endif"
write string 2,"if ray2#<=100 and ray1#>100"
write string 2," tone=100+ray2#*2"
write string 2," if pixelshaded1(x,y)=1 or pixelshaded2(x,y)=1 then tone=tone/1.5"
write string 2," if tone>255 then tone=255"
write string 2," ink rgb(tone,tone,tone),0"
write string 2," dot x,128-y"
write string 2," pixelshaded2(x,y)=1"
write string 2,"endif"
write string 2,"if ray1#<=100 and ray2#<=100"
write string 2," tone=50+(ray1#+ray2#)"
write string 2," if tone>255 then tone=255"
write string 2," ink rgb(tone,tone,tone),0"
write string 2," dot x,128-y"
write string 2,"endif"
write string 2,"endif"
write string 2,"endif"
write string 2,"next object"
write string 2,"next x"
write string 2,"next y"
write string 2,"blur bitmap 1,3"
write string 2,"shadowmap=free_image()"
write string 2,"get image shadowmap,0,0,128,128"
write string 2,"delete bitmap 1"
write string 2,"set light mapping on ground,shadowmap"
write string 2,"endif `(light1 exist)"
write string 2,""
write string 2,"return"
write string 2,""
write string 2,"function free_image()"
write string 2,""
write string 2,"repeat"
write string 2," inc image"
write string 2,"until image exist(image)=0"
write string 2,""
write string 2,"endfunction image"
write string 2,""
write string 2,""
write string 2,""
write string 2,"make_textures:"
write string 2,""
write string 2,"create bitmap 1,500,500"
write string 2,""
write string 2,"grid=free_image()"
write string 2,"ink rgb(255,255,255),0"
write string 2,"box 0,0,500,500"
write string 2,"ink rgb(200,200,200),0"
write string 2,"for x=0 to 500 step 20"
write string 2,"for y=0 to 500 step 20"
write string 2,"box x,y,x+10,y+10"
write string 2,"next y"
write string 2,"next x"
write string 2,"get image grid,0,0,500,500"
write string 2,""
write string 2,"delete bitmap 1"
write string 2,""
write string 2,"create bitmap 1,64,64"
write string 2,""
write string 2,"`white"
write string 2,""
write string 2,"whitesquare=free_image()"
write string 2,"ink rgb(255,255,255),0"
write string 2,"box 0,0,32,32"
write string 2,"get image whitesquare,0,0,32,32"
write string 2,""
write string 2,"`grass"
write string 2,""
write string 2,"ink rgb(0,105,0),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 500"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(rnd(40),50+rnd(150),rnd(40)),0"
write string 2,"dot x,y"
write string 2,"next n"
write string 2,"blur bitmap 1,1"
write string 2,"grass=free_image()"
write string 2,"get image grass,0,0,64,64"
write string 2,""
write string 2,"`sandstone"
write string 2,"ink rgb(200,100,0),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 500"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(100,70,rnd(30)),0"
write string 2,"dot x,y"
write string 2,"next n"
write string 2,"blur bitmap 1,3"
write string 2,"sandstone=free_image()"
write string 2,"get image sandstone,0,0,64,64"
write string 2,""
write string 2,"`wood"
write string 2,"ink rgb(200,150,120),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 40"
write string 2,"a=rnd(64)"
write string 2,"b=a+rnd(10)-5"
write string 2,"ink rgb(100,50,rnd(50)),0"
write string 2,"line a,0,b,64"
write string 2,"next n"
write string 2,"blur bitmap 1,3"
write string 2,"wood=free_image()"
write string 2,"get image wood,0,0,64,64"
write string 2,""
write string 2,"`mesh"
write string 2,""
write string 2,"ink 0,0"
write string 2,"box 0,0,64,64"
write string 2,"ink rgb(150,150,150),0"
write string 2,"for x=1 to 64 step 8"
write string 2,"line 0,x,64,x"
write string 2,"line x,0,x,64"
write string 2,"next x"
write string 2,"blur bitmap 1,3"
write string 2,"mesh=free_image()"
write string 2,"get image mesh,0,0,64,64"
write string 2,""
write string 2,"`marble"
write string 2,"ink rgb(200,230,230),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 500"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(150+rnd(20),150+rnd(20),150+rnd(20)),0"
write string 2,"box x,y,x+rnd(5),y+rnd(5)"
write string 2,"next n"
write string 2,"blur bitmap 1,3"
write string 2,"marble=free_image()"
write string 2,"get image marble,0,0,64,64"
write string 2,""
write string 2,"`plaster"
write string 2,"ink rgb(240,220,210),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 500"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(200+rnd(20),190+rnd(20),180+rnd(20)),0"
write string 2,"box x,y,x+rnd(5),y+rnd(5)"
write string 2,"next n"
write string 2,"blur bitmap 1,3"
write string 2,"plaster=free_image()"
write string 2,"get image plaster,0,0,64,64"
write string 2,""
write string 2,""
write string 2,"`concrete"
write string 2,"ink rgb(180,180,180),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 200"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(150+rnd(100),150+rnd(100),150+rnd(100)),0"
write string 2,"dot x,y"
write string 2,"next n"
write string 2,"blur bitmap 1,3"
write string 2,"concrete=free_image()"
write string 2,"get image concrete,0,0,64,64"
write string 2,""
write string 2,"`brick"
write string 2,"ink rgb(250,150,100),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 600"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(125,75,rnd(50)),0"
write string 2,"dot x,y"
write string 2,"next n"
write string 2,"ink rgb(230,230,230),0"
write string 2,"for y=1 to 61 step 10"
write string 2,"line 0,y,64,y"
write string 2,"for x=0 to 64 step 6+rnd(4)"
write string 2,"line x,y,x,y+10"
write string 2,"next x"
write string 2,"next y"
write string 2,"blur bitmap 1,3"
write string 2,"brick=free_image()"
write string 2,"get image brick,0,0,64,64"
write string 2,""
write string 2,"`colours"
write string 2,"box 0,0,64,64,rgb(250,0,0),rgb(0,255,0),rgb(0,0,255),rgb(255,255,0)"
write string 2,"colours=free_image()"
write string 2,"get image colours,0,0,64,64"
write string 2,""
write string 2,"`stones"
write string 2,"ink rgb(220,200,190),0"
write string 2,"box 0,0,64,64"
write string 2,"for n=1 to 500"
write string 2,"x=rnd(64)"
write string 2,"y=rnd(64)"
write string 2,"ink rgb(180+rnd(20),170+rnd(20),160+rnd(20)),0"
write string 2,"box x,y,x+rnd(5),y+rnd(5)"
write string 2,"next n"
write string 2,"ink rgb(250,250,250),0"
write string 2,"for y=1 to 61 step 10"
write string 2,"line 0,y,64,y"
write string 2,"for x=0 to 64 step 6+rnd(4)"
write string 2,"line x,y,x,y+10"
write string 2,"next x"
write string 2,"next y"
write string 2,"blur bitmap 1,2"
write string 2,"stones=free_image()"
write string 2,"get image stones,0,0,64,64"
write string 2,""
write string 2,""
write string 2,"`white"
write string 2,"ink rgb(255,255,255),0"
write string 2,"box 0,0,64,64"
write string 2,"white=free_image()"
write string 2,"get image white,0,0,64,64"
write string 2,""
write string 2,"`red"
write string 2,"ink rgb(255,0,0),0"
write string 2,"box 0,0,64,64"
write string 2,"red=free_image()"
write string 2,"get image red,0,0,64,64"
write string 2,""
write string 2,"delete bitmap 1"
write string 2,""
write string 2,""
write string 2,"return"
write string 2,""
write string 2,""
write string 2,""
write string 2,"make_game_environment:"
write string 2,""
write string 2,"ground=free_object()"
write string 2,"Make Object plain ground,128,128"
write string 2,"Position Object ground,64,0,64"
write string 2,"xrotate object ground,-90"
write string 2,""
write string 2,"read numberoflights$"
write string 2,"numberoflights=val(numberoflights$)"
write string 2,"read lightx$"
write string 2,"lightx#=val(lightx$)"
write string 2,"read lighty$"
write string 2,"lighty#=val(lighty$)"
write string 2,"read lightz$"
write string 2,"lightz#=val(lightz$)"
write string 2,"if light exist(1)=0 then make light 1"
write string 2,"position light 1,lightx#,lighty#,lightz#"
write string 2,"if numberoflights=2"
write string 2," read lightx$"
write string 2," lightx#=val(lightx$)"
write string 2," read lighty$"
write string 2," lighty#=val(lighty$)"
write string 2," read lightz$"
write string 2," lightz#=val(lightz$)"
write string 2," if light exist(2)=0 then make light 2"
write string 2," position light 2,lightx#,lighty#,lightz#"
write string 2,"endif"
write string 2,"read numberofobjects$"
write string 2,"numberofobjects=val(numberofobjects$)"
write string 2,"undim object(numberofobjects+2)"
write string 2,"dim object(numberofobjects+2) as objecttype"
write string 2,"for object=3 to numberofobjects+2"
write string 2,""
write string 2," read typeofobject$"
write string 2," object(object).typeofobject=typeofobject$"
write string 2," if typeofobject$="cube" then make object cube object,5"
write string 2," if typeofobject$="box""
write string 2," read boxx$"
write string 2," boxx#=val(boxx$)"
write string 2," read boxy$"
write string 2," boxy#=val(boxy$)"
write string 2," read boxz$"
write string 2," boxz#=val(boxz$)"
write string 2," make object box object,boxx#,boxy#,boxz#"
write string 2," object(object).boxx=boxx#"
write string 2," object(object).boxy=boxy#"
write string 2," object(object).boxz=boxz#"
write string 2," endif"
write string 2," if typeofobject$="sphere" then make object sphere object,5,10,10"
write string 2," if typeofobject$="cone" then make object cone object,5"
write string 2," if typeofobject$="cylinder" then make object cylinder object,5"
write string 2," if typeofobject$="light""
write string 2," make object sphere object,2,10,10"
write string 2," color object object,rgb(255,255,0)"
write string 2," set object light object,0"
write string 2," if light1=0 then light1=object else light2=object"
write string 2," endif"
write string 2," read x$"
write string 2," x#=val(x$)"
write string 2," read y$"
write string 2," y#=val(y$)"
write string 2," read z$"
write string 2," z#=val(z$)"
write string 2," position object object,x#,y#,z#"
write string 2," read anglex$"
write string 2," anglex#=val(anglex$)"
write string 2," read angley$"
write string 2," angley#=val(angley$)"
write string 2," read anglez$"
write string 2," anglez#=val(anglez$)"
write string 2," rotate object object,anglex#,angley#,anglez#"
write string 2," read scalex$"
write string 2," scalex#=val(scalex$)"
write string 2," read scaley$"
write string 2," scaley#=val(scaley$)"
write string 2," read scalez$"
write string 2," scalez#=val(scalez$)"
write string 2," scale object object,100+scalex#,100+scaley#,100+scalez#"
write string 2," object(object).scalex=scalex#"
write string 2," object(object).scaley=scaley#"
write string 2," object(object).scalez=scalez#"
write string 2," read scaleu$"
write string 2," scaleuval=val(scaleu$)"
write string 2," read scalev$"
write string 2," scalevval=val(scalev$)"
write string 2," object(object).scaleu=scaleuval"
write string 2," object(object).scalev=scalevval"
write string 2," scale object texture object,scalefactor#^scaleuval,scalefactor#^scalevval"
write string 2," read texturename$"
write string 2," texture=val(texturename$)"
write string 2," object(object).texture=texture"
write string 2," texture object object,texture"
write string 2," set object collision on object"
write string 2,""
write string 2,"wait 100"
write string 2,"next object"
write string 2,""
write string 2,""
write string 2,"return"
quote$=chr$(34)
repeat
read string 1,string$
write string 2,"data "+quote$+string$+quote$
until file end(1)=1
close file 1
close file 2
return
loadscene:
filename$=""
repeat
text 0,260,"enter a filename to load (without extension): "
if keydown=0
keydown=1
filename$=filename$+inkey$()
endif
if scancode()=0 then keydown=0
text 0,280,filename$
sync
until returnkey()=1
if file exist(filename$+"_shadowmap"+".bmp")
shadowmap=free_image()
load image filename$+"_shadowmap"+".bmp",shadowmap
set light mapping on 2,shadowmap
endif
if file exist(filename$+".scn")
`delete existing scene
light1=0
light2=0
for object=3 to numberofobjects+2
if object exist(object)
delete object object
endif
next object
open to read 1,filename$+".scn"
read string 1,numberoflights$
numberoflights=val(numberoflights$)
read string 1,lightx$
lightx#=val(lightx$)
read string 1,lighty$
lighty#=val(lighty$)
read string 1,lightz$
lightz#=val(lightz$)
position light 1,lightx#,lighty#,lightz#
if numberoflights=2
read string 1,lightx$
lightx#=val(lightx$)
read string 1,lighty$
lighty#=val(lighty$)
read string 1,lightz$
lightz#=val(lightz$)
if light exist(2)=0 then make light 2
position light 2,lightx#,lighty#,lightz#
endif
read string 1,numberofobjects$
numberofobjects=val(numberofobjects$)
undim object(numberofobjects+2)
dim object(numberofobjects+2) as objecttype
for object=3 to numberofobjects+2
if file end(1)=0
read string 1,typeofobject$
object(object).typeofobject=typeofobject$
if typeofobject$="cube" then make object cube object,5
if typeofobject$="box"
read string 1,boxx$
boxx#=val(boxx$)
read string 1,boxy$
boxy#=val(boxy$)
read string 1,boxz$
boxz#=val(boxz$)
make object box object,boxx#,boxy#,boxz#
object(object).boxx=boxx#
object(object).boxy=boxy#
object(object).boxz=boxz#
endif
if typeofobject$="sphere" then make object sphere object,5,10,10
if typeofobject$="cone" then make object cone object,5
if typeofobject$="cylinder" then make object cylinder object,5
if typeofobject$="light"
make object sphere object,2,10,10
color object object,rgb(255,255,0)
set object light object,0
if light1=0 then light1=object else light2=object
endif
read string 1,x$
x#=val(x$)
read string 1,y$
y#=val(y$)
read string 1,z$
z#=val(z$)
position object object,x#,y#,z#
read string 1,anglex$
anglex#=val(anglex$)
read string 1,angley$
angley#=val(angley$)
read string 1,anglez$
anglez#=val(anglez$)
rotate object object,anglex#,angley#,anglez#
read string 1,scalex$
scalex#=val(scalex$)
read string 1,scaley$
scaley#=val(scaley$)
read string 1,scalez$
scalez#=val(scalez$)
scale object object,100+scalex#,100+scaley#,100+scalez#
object(object).scalex=scalex#
object(object).scaley=scaley#
object(object).scalez=scalez#
read string 1,scaleu$
scaleuval=val(scaleu$)
read string 1,scalev$
scalevval=val(scalev$)
object(object).scaleu=scaleuval
object(object).scalev=scalevval
scale object texture object,scalefactor#^scaleuval,scalefactor#^scalevval
read string 1,texturename$
texture=val(texturename$)
object(object).texture=texture
texture object object,texture
endif
text 0,0,"Loading"
sync
next object
else
text 0,0,"File not found"
sync
wait 1000
endif `(file exist)
close file 1
return
