Update:
just added load and save functionality. It saves the whole scene as a .scn file, and saves the shadow map as a bmp.
`Modeller by Ric.
`Thanks to CPU for the 3d mouse function :)
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
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,42,42
get image whitesquare,0,0,42,42
sprite whitesquare,324,44,whitesquare
gosub make_texture_sprites
type objecttype
scalex as float
scaley as float
scalez 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
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)
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_buttons
set sprite diffuse selection,200,200,200
create=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 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()=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 then exclude=0:set object light picked,1:picked=0
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 applytexture=1
gosub apply_texture
endif
endif
return
apply_texture:
texture object picked,texture
object(picked).texture=texture
return
reset_operations:
scaleon=0
rotateon=0
positionon=0
applytexture=0
for n=position to rotate
set sprite diffuse n,255,255,255
next n
set sprite diffuse textureobject,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
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_ then make object box object,5,20,5:object(object).typeofobject="box"
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
position object 1,object position x(object),object position y(object),object position z(object)
endif
position object object,object position x(1),object position y(1),object position z(1)
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
if object<>light1 and object<>light2 then scale object object,100+object(object).scalex,100+object(object).scaley,100+object(object).scalez
if mouseclick()=0
excludeso=0
if object<>light1 and object<>light2 then set object light object,1
endif
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<>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=100
if ray1<0 then ray1=1
if ray2=0 then ray2=100
if ray2<0 then ray2=1
if ray1<=20 and ray2>20
ink rgb(150,150,150),0
dot x,128-y
pixelshaded1(x,y)=1
endif
if ray2<=20 and ray1>20
ink rgb(150,150,150),0
dot x,128-y
pixelshaded2(x,y)=1
endif
if ray1<=20 and ray2<=20
ink rgb(75,75,75),0
dot x,128-y
endif
if pixelshaded1(x,y)=1 and pixelshaded2(x,y)=1
ink rgb(75,75,75),0
dot x,128-y
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,255,0),0
box 0,0,64,64
for n=1 to 200
x=rnd(64)
y=rnd(64)
ink rgb(rnd(100),255,rnd(100)),0
dot x,y
next n
grass=free_sprite()
get image grass,0,0,64,64
sprite grass,325,45,grass
size sprite grass,40,40
`concrete
ink rgb(200,200,200),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
concrete=free_sprite()
get image concrete,0,0,64,64
sprite concrete,370,45,concrete
size sprite concrete,40,40
`brick
ink rgb(250,150,100),0
box 0,0,64,64
for y=1 to 61 step 10
ink rgb(180,180,140),0
line 0,y,64,y
for x=0 to 64 step rnd(10)
line x,y,x,y+10
next x
next y
brick=free_sprite()
get image brick,0,0,64,64
sprite brick,415,45,brick
size sprite brick,40,40
`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
sprite colours,325,90,colours
size sprite colours,40,40
`white
ink rgb(255,255,255),0
box 0,0,64,64
white=free_sprite()
get image white,0,0,64,64
sprite white,370,90,white
size sprite white,40,40
`red
ink rgb(255,0,0),0
box 0,0,64,64
red=free_sprite()
get image red,0,0,64,64
sprite red,415,90,red
size sprite red,40,40
delete bitmap 1
return
savescene:
repeat
text 0,220,"enter a filename (without extension): "
sync
until scancode()>0
set cursor 0,240
input "",filename$
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 file 1,numberoflights
write float 1,light position x(1)
write float 1,light position y(1)
write float 1,light position z(1)
if numberoflights=2
write float 1,light position x(2)
write float 1,light position y(2)
write float 1,light position z(2)
endif
write file 1,numberofobjects
for object=3 to numberofobjects+2
if object exist(object)
write string 1,object(object).typeofobject
write float 1,object position x(object)
write float 1,object position y(object)
write float 1,object position z(object)
write float 1,object angle x(object)
write float 1,object angle y(object)
write float 1,object angle z(object)
write float 1,object(object).scalex
write float 1,object(object).scaley
write float 1,object(object).scalez
write file 1,object(object).texture
endif
text 0,0,"Saving"
sync
next object
close file 1
return
loadscene:
repeat
text 0,220,"enter a filename (without extension): "
sync
until scancode()>0
set cursor 0,240
input "",filename$
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 file 1,numberoflights
read float 1,lightx#
read float 1,lighty#
read float 1,lightz#
position light 1,lightx#,lighty#,lightz#
if numberoflights=2
read float 1,lightx#
read float 1,lighty#
read float 1,lightz#
if light exist(2)=0 then make light 2
position light 2,lightx#,lighty#,lightz#
endif
read file 1,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" then make object box object,5,20,5
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 float 1,x#
read float 1,y#
read float 1,z#
position object object,x#,y#,z#
read float 1,anglex#
read float 1,angley#
read float 1,anglez#
rotate object object,anglex#,angley#,anglez#
read float 1,scalex#
read float 1,scaley#
read float 1,scalez#
scale object object,100+scalex#,100+scaley#,100+scalez#
object(object).scalex=scalex#
object(object).scaley=scaley#
object(object).scalez=scalez#
read file 1,texture
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
