`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#=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
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
 
 
 
 
`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