Sorry your browser is not supported!

Rem Project: ARRAYinators 3d modeller

`thanks cpu for the vector function and tutorial

Rem ***** Main Source File *****


`Setup
sync on
sync rate 0
set display mode 800,600,32

position camera 20,20,20
point camera 0,0,0
autocam off
set camera aspect 1.5
  set camera view 0,0+(300*1),800,300+(300*1)
  color backdrop 0


make camera 1
color backdrop 1,rgb(100,100,100)
position camera 1,32,4,32
point camera 1,0,0,0
set camera view 1,80,40,screen width()/2-80,190



make camera 2
color backdrop 2,rgb(100,100,100)
position camera 2,0,80,0
point camera 2,0,0,0
set camera view 2,screen width()/2+80,40,screen width()-80,190


set current camera 0

create bitmap 100,20,20 : set current bitmap 100
ink rgb(128,128,128),0 : box 0,0,10,10 : box 10,10,20,20
ink rgb(300,300,300),0 : box 0,10,10,20 : box 10,0,20,10
get image 100,0,0,20,20

`3D backdrop
make matrix 1, 100,100,10,10
position matrix 1, -50,0,-50
set matrix wireframe on 1
update matrix 1

prepare matrix texture 1,100,4,4


global mposx#
global mposy#






global objnum=1

global usernum=1

`Create Images--

`Menu Bar
create bitmap 1,screen width(),30 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 10,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1

`Menus
create bitmap 1,150,200 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 11,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1



`Text
ink rgb(0,0,0),0
set text font "tahoma"
set text size 20

`Create Menu Arrays
Dim gui_state(4)
for m=1 to 4
   gui_state(m)=1
next m





set text to bold

ink rgb(255,255,255),0



global camAng as float = 40.0
global camDistance as float = 20.0
global camroll as float

lightnum=1
userlightnum=1
dim typeofobject(100)

type TYPE_XYZfloat
   x as float
   y as float
   z as float
endtype

global GU_XYZReturn as TYPE_XYZfloat

draw sprites first

open=0

dim typeobj$(100)

do


main:

`left mouse moves in the XZ direction
   if mouseclick() = 1 and object exist(usernum) and scancode()=50
      SYS_screenToXZ(mousex(), mousey(), 0, object position y(usernum))
      position object usernum, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
      hold=1
   else
   `right mouse moves in the Y direction
      if mouseclick() = 2 and object exist(usernum) and scancode()=50
         tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(usernum), object position z(usernum))
         position object usernum, object position x(usernum), tmp#, object position z(usernum)
         hold=1
      endif
      endif


      open=0

if scancode()<>50 then hold=0

if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

   `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1



   position camera cos(camAngle)*camDistance, 15+camroll, sin(camAng)*camDistance


if inkey$()="l" then gosub select_light

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")

`menu selection
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<3397 and mousey()=>61 and mousey()=<76 then gosub make_cube
if mouseclick()=1 and hold=0 and mousex()=>357 and mousex()=<390 and mousey()=>105 and mousey()=<116 then gosub make_box
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<422 and mousey()=>143 and mousey()=<157 then gosub make_cone
if mouseclick()=1 and hold=0 and mousex()=>360 and mousex()=<423 and mousey()=>187 and mousey()=<198 then gosub make_cylinder
if mouseclick()=1 and hold=0 and mousex()=>209 and mousex()=<261 and mousey()=>62 and mousey()=<75 then gosub rotate
if mouseclick()=1 and hold=0 and mousex()=>207 and mousex()=<307 and mousey()=>140 and mousey()=<156 then gosub scale
if mouseclick()=1 and hold=0 and mousex()=>507 and mousex()=<551 and mousey()=>527 and mousey()=<529 then gosub light

`save
if mouseclick()=1 and hold=0 and mousex()=>59 and mousex()=<97 and mousey()=>143 and mousey()=<159
repeat
text 0,220,"enter a filename: "
sync
until scancode()>0
set cursor 0,240
input "",filename$
if file exist(filename$+".txt") then delete file filename$+".txt"
open to write 1,filename$+".txt"

objnums=objnum






write file 1,objnums


for object=1 to objnum-1
if object exist(object)
    write string 1,typeobj$(object)
    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,sx#
    write float 1,sy#
    write float 1,sz#
  endif
  text 250,250,"Saving"
  sync
next object

close file 1

endif


if mouseclick()=1 and hold=0 and mousex()=>61 and mousex()=<104 and mousey()=>101 and mousey()=<117



repeat
text 0,220,"enter a filename : "
sync
until scancode()>0
set cursor 0,240
input "",filename$

if file exist(filename$+".txt")


open to read 1,filename$+".txt"

read file 1,objnums


objnum=objnums

for object = 1 to objnum-1
if object exist(object)
delete object object
endif
next object



for object=1 to objnum-1

   read string 1,typeofobject$



    read float 1,x#
    read float 1,y#
    read float 1,z#



    read float 1,angx#
    read float 1,angy#
    read float 1,angz#



    read float 1,sx#
    read float 1,sy#
    read float 1,sz#

    sx#=sx#
    sy#=sy#
    sz#=sz#


   if typeofobject$ = "cube" then make object cube object,6
    if typeofobject$ = "box" then make object box object,3,3,6
    if typeofobject$ = "cone" then make object cone object,6
    if typeofobject$ = "cylinder" then make object cylinder object,6

if object exist(object) then rotate object object,angx#,angy#,angz#
if object exist(object) then position object object,x#,y#,z#
if object exist(object) then scale object object,sx#,sy#,sz#


text 250,250,"Loading"
  sync
next object
else
text 250,250,"File not found"
sync
wait 1000
endif `(file exist)
endif


close file 1




if scancode()=211 then gosub delete_object

if object exist(usernum) then show object usernum


`print position
set cursor 40,500
if object exist(usernum) then  print "z:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)



`print angle
set cursor 500,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 500,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 500,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum



point camera 0,0,0

   sync
   loop

make_cube:

make object cube objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cube"

inc objnum


return

make_box:

make object box objnum,3,3,6
position object objnum,0,0,0
typeobj$(objnum)="box"




inc objnum


return

make_cone:

make object cone objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cone"



inc objnum



return

make_cylinder:

make object cylinder objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cylinder"

inc objnum


return


`Create Menu Bar
Function Menu_Bar(num1,num2,menu1$,menu2$,menu3$,menu4$)
if sprite exist(num1)=0
   sprite num1,0,0,10
endif
size sprite num1,screen width(),30
text 50,5,menu1$ : text 200,5,menu2$ : text 350,5,menu3$ : text 500,5,menu4$
if mousex()>50 and mousex()<50+text width(menu1$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(1)=2
endif
if mousex()>200 and mousex()<200+text width(menu2$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(2)=2
endif
if mousex()>350 and mousex()<350+text width(menu3$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(3)=2
endif
if mousex()>500 and mousex()<500+text width(menu4$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(4)=2
endif
if gui_state(2)=2 and mousey()<50 and mousex()<50+text width(menu1$) then gui_state(2)=1 : gui_state(1)=2
if gui_state(3)=2 and mousey()<50 and mousex()<200+text width(menu2$) then gui_state(3)=1 : gui_state(2)=2
if gui_state(4)=2 and mousey()<50 and mousex()<350+text width(menu3$) then gui_state(4)=1 : gui_state(3)=2
if gui_state(1)=2 and mousey()<50 and mousex()>200 and mousex()<200+text width(menu2$) then gui_state(1)=1 : gui_state(2)=2
if gui_state(2)=2 and mousey()<50 and mousex()>350 and mousex()<350+text width(menu3$) then gui_state(2)=1 : gui_state(3)=2
if gui_state(3)=2 and mousey()<50 and mousex()>500 and mousex()<500+text width(menu4$) then gui_state(3)=1 : gui_state(4)=2
for m=1 to 4
if gui_state(m)=2 and mousey()>50 and mouseclick()=1 then gui_state(m)=1
next m
sprite num2,0,0,11 : hide sprite num2
if gui_state(1)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,50,30,11
endif
if gui_state(2)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,200,30,11
endif
if gui_state(3)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,350,30,11
endif
if gui_state(4)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,500,30,11
endif
if sprite exist(num2)=1 then size sprite num2,150,200
Endfunction



Function Sub_Menu(num,sub1$,sub2$,sub3$,sub4$)

if num=1 then in=60
if num=2 then in=210
if num=3 then in=360
if num=4 then in=510
if gui_state(num)=2
text in,60,sub1$ : text in,100,sub2$ : text in,140,sub3$ : text in,180,sub4$
endif

Endfunction

rotate:
do

mmx#=mousemovex()
mmy#=mousemovey()


if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)


if mouseclick()=1 and object exist(usernum)
turn object right usernum,mmx#
pitch object up usernum,-mmy#
endif

if mouseclick()=2 and object exist(usernum)
roll object right usernum,-mmy#
endif

if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")

`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)


 `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance

set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum

if mouseclick()=1 and hold=0 and mousex()=>251 and mousex()=<395 and mousey()=>416 and mousey()=<437
set cursor 250,520
input "Current Object",usernum
endif

if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif


loop


delete_object:



if object exist(usernum) then delete object usernum



return

scale:
global sx#=300.0
global sy#=300.0
global sz#=300.0


do

mmx#=mousemovex()
mmy#=mousemovey()

if object exist(usernum) and mouseclick()=1 and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

if mouseclick()=1 then sx=sx+mmx#
if mouseclick()=1 then sy=sy+mmy#
if mouseclick()=2 then sz=sz+mmx#


if object exist(usernum) then scale object usernum,sx,sy,sz

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")


`camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance


set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)

if inkey$()="e" then return



`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum

if mouseclick()=1 and hold=0 and mousex()=>251 and mousex()=<395 and mousey()=>416 and mousey()=<437
set cursor 250,520
input "Current Object",usernum
endif

if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif


if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return


loop

light:


make light lightnum
position light lightnum,0,0,0
show light lightnum
inc lightnum

return

select_light:

input "select light number",userlightnum

return


`note that y plain is used so that if your default build plain is higher than 0 you can specify it
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

Rem Project: ARRAYinators 3d modeller

`thanks cpu for the vector function and tutorial

Rem ***** Main Source File *****


`Setup
sync on
sync rate 0
set display mode 800,600,32

position camera 20,20,20
point camera 0,0,0
autocam off
set camera aspect 1.5
  set camera view 0,0+(300*1),800,300+(300*1)
  color backdrop 0


make camera 1
color backdrop 1,rgb(100,100,100)
position camera 1,32,4,32
point camera 1,0,0,0
set camera view 1,80,40,screen width()/2-80,190



make camera 2
color backdrop 2,rgb(100,100,100)
position camera 2,0,80,0
point camera 2,0,0,0
set camera view 2,screen width()/2+80,40,screen width()-80,190


set current camera 0

create bitmap 100,20,20 : set current bitmap 100
ink rgb(128,128,128),0 : box 0,0,10,10 : box 10,10,20,20
ink rgb(300,300,300),0 : box 0,10,10,20 : box 10,0,20,10
get image 100,0,0,20,20

`3D backdrop
make matrix 1, 100,100,10,10
position matrix 1, -50,0,-50
set matrix wireframe on 1
update matrix 1

prepare matrix texture 1,100,4,4


global mposx#
global mposy#



global gScreenshot_number


global objnum=1

global usernum=1

`Create Images--

`Menu Bar
create bitmap 1,screen width(),30 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 10,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1

`Menus
create bitmap 1,150,200 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 11,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1



`Text
ink rgb(0,0,0),0
set text font "tahoma"
set text size 20

`Create Menu Arrays
Dim gui_state(4)
for m=1 to 4
   gui_state(m)=1
next m





set text to bold

ink rgb(255,255,255),0



global camAng as float = 40.0
global camDistance as float = 20.0
global camroll as float

lightnum=1
userlightnum=1
dim typeofobject(100)

type TYPE_XYZfloat
   x as float
   y as float
   z as float
endtype

global GU_XYZReturn as TYPE_XYZfloat

draw sprites first

open=0

dim typeobj$(100)

objlightnum=100

do


main:


if object exist(objlightnum) then set light to object position userlightnum,objlightnum



`left mouse moves in the XZ direction
   if mouseclick() = 1 and object exist(usernum) and scancode()=50
      SYS_screenToXZ(mousex(), mousey(), 0, object position y(usernum))
      position object usernum, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
      hold=1
   else
   `right mouse moves in the Y direction
      if mouseclick() = 2 and object exist(usernum) and scancode()=50
         tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(usernum), object position z(usernum))
         position object usernum, object position x(usernum), tmp#, object position z(usernum)
         hold=1
      endif
      endif


      open=0

if scancode()<>50 then hold=0

if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

   `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1



   position camera cos(camAngle)*camDistance, 15+camroll, sin(camAng)*camDistance


if inkey$()="l" then gosub select_light

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","render to file")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","directx object")

`menu selection
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<3397 and mousey()=>61 and mousey()=<76 then gosub make_cube
if mouseclick()=1 and hold=0 and mousex()=>357 and mousex()=<390 and mousey()=>105 and mousey()=<116 then gosub make_box
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<422 and mousey()=>143 and mousey()=<157 then gosub make_cone
if mouseclick()=1 and hold=0 and mousex()=>360 and mousex()=<423 and mousey()=>187 and mousey()=<198 then gosub make_cylinder
if mouseclick()=1 and hold=0 and mousex()=>209 and mousex()=<261 and mousey()=>62 and mousey()=<75 then gosub rotate
if mouseclick()=1 and hold=0 and mousex()=>207 and mousex()=<307 and mousey()=>140 and mousey()=<156 then gosub scale
if mouseclick()=1 and hold=0 and mousex()=>507 and mousex()=<551 and mousey()=>527 and mousey()=<529 then gosub light
if mouseclick()=1 and hold=0 and mousex()=>58 and mousex()=<94 and mousey()=>181 and mousey()=<200 then end
if mouseclick()=1 and hold=0 and mousex()=>510 and mousex()=<626 and mousey()=>140 and mousey()=<159 then gosub texture
if mouseclick()=1 and hold=0 and mousex()=>509 and mousex()=<625 and mousey()=>176 and mousey()=<198 then gosub directx
if mouseclick()=1 and hold=0 and mousex()=>211 and mousex()=<315 and mousey()=>182 and mousey()=<199 then screenshot()


`save
if mouseclick()=1 and hold=0 and mousex()=>59 and mousex()=<97 and mousey()=>143 and mousey()=<159
repeat
text 0,220,"enter a filename: "
sync
until scancode()>0
set cursor 0,240
input "",filename$
if file exist(filename$+".txt") then delete file filename$+".txt"
open to write 1,filename$+".txt"

objnums=objnum






write file 1,objnums


for object=1 to objnum-1
if object exist(object)
    write string 1,typeobj$(object)
    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,sx#
    write float 1,sy#
    write float 1,sz#
  endif
  text 250,250,"Saving"
  sync
next object

close file 1

endif


if mouseclick()=1 and hold=0 and mousex()=>61 and mousex()=<104 and mousey()=>101 and mousey()=<117



repeat
text 0,220,"enter a filename : "
sync
until scancode()>0
set cursor 0,240
input "",filename$

if file exist(filename$+".txt")


open to read 1,filename$+".txt"

read file 1,objnums


objnum=objnums

for object = 1 to objnum-1
if object exist(object)
delete object object
endif
next object



for object=1 to objnum-1

   read string 1,typeofobject$



    read float 1,x#
    read float 1,y#
    read float 1,z#



    read float 1,angx#
    read float 1,angy#
    read float 1,angz#



    read float 1,sx#
    read float 1,sy#
    read float 1,sz#

    sx#=sx#
    sy#=sy#
    sz#=sz#


   if typeofobject$ = "cube" then make object cube object,6
    if typeofobject$ = "box" then make object box object,3,3,6
    if typeofobject$ = "cone" then make object cone object,6
    if typeofobject$ = "cylinder" then make object cylinder object,6

if object exist(object) then rotate object object,angx#,angy#,angz#
if object exist(object) then position object object,x#,y#,z#
if object exist(object) then scale object object,sx#,sy#,sz#


text 250,250,"Loading"
  sync
next object
else
text 250,250,"File not found"
sync
wait 1000
endif `(file exist)
endif


close file 1




if scancode()=211 then gosub delete_object

if object exist(usernum) then show object usernum


`print position
set cursor 40,500
if object exist(usernum) then  print "z:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)



`print angle
set cursor 500,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 500,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 500,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum



point camera 0,0,0

   sync
   loop

make_cube:

make object cube objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cube"

inc objnum


return

make_box:

make object box objnum,3,3,6
position object objnum,0,0,0
typeobj$(objnum)="box"




inc objnum


return

make_cone:

make object cone objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cone"



inc objnum



return

make_cylinder:

make object cylinder objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cylinder"

inc objnum


return


`Create Menu Bar
Function Menu_Bar(num1,num2,menu1$,menu2$,menu3$,menu4$)
if sprite exist(num1)=0
   sprite num1,0,0,10
endif
size sprite num1,screen width(),30
text 50,5,menu1$ : text 200,5,menu2$ : text 350,5,menu3$ : text 500,5,menu4$
if mousex()>50 and mousex()<50+text width(menu1$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(1)=2
endif
if mousex()>200 and mousex()<200+text width(menu2$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(2)=2
endif
if mousex()>350 and mousex()<350+text width(menu3$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(3)=2
endif
if mousex()>500 and mousex()<500+text width(menu4$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(4)=2
endif
if gui_state(2)=2 and mousey()<50 and mousex()<50+text width(menu1$) then gui_state(2)=1 : gui_state(1)=2
if gui_state(3)=2 and mousey()<50 and mousex()<200+text width(menu2$) then gui_state(3)=1 : gui_state(2)=2
if gui_state(4)=2 and mousey()<50 and mousex()<350+text width(menu3$) then gui_state(4)=1 : gui_state(3)=2
if gui_state(1)=2 and mousey()<50 and mousex()>200 and mousex()<200+text width(menu2$) then gui_state(1)=1 : gui_state(2)=2
if gui_state(2)=2 and mousey()<50 and mousex()>350 and mousex()<350+text width(menu3$) then gui_state(2)=1 : gui_state(3)=2
if gui_state(3)=2 and mousey()<50 and mousex()>500 and mousex()<500+text width(menu4$) then gui_state(3)=1 : gui_state(4)=2
for m=1 to 4
if gui_state(m)=2 and mousey()>50 and mouseclick()=1 then gui_state(m)=1
next m
sprite num2,0,0,11 : hide sprite num2
if gui_state(1)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,50,30,11
endif
if gui_state(2)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,200,30,11
endif
if gui_state(3)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,350,30,11
endif
if gui_state(4)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,500,30,11
endif
if sprite exist(num2)=1 then size sprite num2,150,200
Endfunction



Function Sub_Menu(num,sub1$,sub2$,sub3$,sub4$)

if num=1 then in=60
if num=2 then in=210
if num=3 then in=360
if num=4 then in=510
if gui_state(num)=2
text in,60,sub1$ : text in,100,sub2$ : text in,140,sub3$ : text in,180,sub4$
endif

Endfunction

rotate:
do

mmx#=mousemovex()
mmy#=mousemovey()


if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)


if mouseclick()=1 and object exist(usernum)
turn object right usernum,mmx#
pitch object up usernum,-mmy#
endif

if mouseclick()=2 and object exist(usernum)
roll object right usernum,-mmy#
endif

if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")

`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)


 `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance

set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum


if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif

sync
loop


delete_object:



if object exist(usernum) then delete object usernum



return

scale:
global sx#=300.0
global sy#=300.0
global sz#=300.0


do

mmx#=mousemovex()
mmy#=mousemovey()

if object exist(usernum) and mouseclick()=1 and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

if mouseclick()=1 then sx=sx+mmx#
if mouseclick()=1 then sy=sy+mmy#
if mouseclick()=2 then sz=sz+mmx#


if object exist(usernum) then scale object usernum,sx,sy,sz

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")


`camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance


set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)





`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum





if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif


if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return

sync
loop

light:


make object sphere objlightnum,3
make light lightnum
show light lightnum
inc lightnum



return

select_light:

input "select light number",userlightnum

return


`note that y plain is used so that if your default build plain is higher than 0 you can specify it
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

texture:

global imagenumber=2

repeat
text 0,220,"enter a image name with extension: "
sync
until scancode()>0
set cursor 0,240
input "",imagename$

do


load image imagename$,imagenumber

texture object usernum,imagenumber

inc imagenumber

return


sync
loop

directx:

repeat
text 0,220,"enter a object(without extension): "
sync
until scancode()>0
set cursor 0,240
input "",objectname$

load object objectname$,objnum

position object objnum,0,0,0

inc objnum

return




FUNCTION screenshot()

   name$ = "Screen " + str$(gScreenshot_number) + ".bmp"

   temp_image = 100
   get image temp_image, 0,0+(300*1),800,300+(300*1)
   save image name$, temp_image
   delete image temp_image
   gScreenshot_number = gScreenshot_number + 1
   inc temp_image

ENDFUNCTION

Rem Project: ARRAYinators 3d modeller

`thanks cpu for the vector function and tutorial

Rem ***** Main Source File *****


`Setup
sync on
sync rate 0
set display mode 800,600,32

position camera 20,20,20
point camera 0,0,0
autocam off
set camera aspect 1.5
  set camera view 0,0+(300*1),800,300+(300*1)
  color backdrop 0


make camera 1
color backdrop 1,rgb(100,100,100)
position camera 1,32,4,32
point camera 1,0,0,0
set camera view 1,80,40,screen width()/2-80,190



make camera 2
color backdrop 2,rgb(100,100,100)
position camera 2,0,80,0
point camera 2,0,0,0
set camera view 2,screen width()/2+80,40,screen width()-80,190


set current camera 0

create bitmap 100,20,20 : set current bitmap 100
ink rgb(128,128,128),0 : box 0,0,10,10 : box 10,10,20,20
ink rgb(300,300,300),0 : box 0,10,10,20 : box 10,0,20,10
get image 100,0,0,20,20

`3D backdrop
make matrix 1, 100,100,10,10
position matrix 1, -50,0,-50
set matrix wireframe on 1
update matrix 1

prepare matrix texture 1,100,4,4


global mposx#
global mposy#



global gScreenshot_number


global objnum=1

global usernum=1

`Create Images--

`Menu Bar
create bitmap 1,screen width(),30 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 10,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1

`Menus
create bitmap 1,150,200 : set current bitmap 1
ink rgb(200,200,200),0
box 1,1,bitmap width(1),bitmap height(1)
ink rgb(20,20,20),0
line 1,1,bitmap width(1),1 : line 1,1,1,bitmap height(1)
ink rgb(230,230,230),0
line bitmap width(1),1,bitmap width(1),bitmap height(1)
line 1,bitmap height(1),bitmap width(1),bitmap height(1)
get image 11,0,0,bitmap width(1),bitmap height(1)
set current bitmap 0 : delete bitmap 1



`Text
ink rgb(0,0,0),0
set text font "tahoma"
set text size 20

`Create Menu Arrays
Dim gui_state(4)
for m=1 to 4
   gui_state(m)=1
next m





set text to bold

ink rgb(255,255,255),0



global camAng as float = 40.0
global camDistance as float = 20.0
global camroll as float

lightnum=1
userlightnum=1
dim typeofobject(100)

type TYPE_XYZfloat
   x as float
   y as float
   z as float
endtype

global GU_XYZReturn as TYPE_XYZfloat

draw sprites first

open=0

dim typeobj$(100)

objlightnum=100

do


main:


if object exist(objlightnum) then set light to object position userlightnum,objlightnum



`left mouse moves in the XZ direction
   if mouseclick() = 1 and object exist(usernum) and scancode()=50
      SYS_screenToXZ(mousex(), mousey(), 0, object position y(usernum))
      position object usernum, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
      hold=1
   else
   `right mouse moves in the Y direction
      if mouseclick() = 2 and object exist(usernum) and scancode()=50
         tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(usernum), object position z(usernum))
         position object usernum, object position x(usernum), tmp#, object position z(usernum)
         hold=1
      endif
      endif


      open=0

if scancode()<>50 then hold=0

if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

   `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1



   position camera cos(camAngle)*camDistance, 15+camroll, sin(camAng)*camDistance


if inkey$()="l" then gosub select_light

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","render to file")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","directx object")

`menu selection
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<3397 and mousey()=>61 and mousey()=<76 then gosub make_cube
if mouseclick()=1 and hold=0 and mousex()=>357 and mousex()=<390 and mousey()=>105 and mousey()=<116 then gosub make_box
if mouseclick()=1 and hold=0 and mousex()=>361 and mousex()=<422 and mousey()=>143 and mousey()=<157 then gosub make_cone
if mouseclick()=1 and hold=0 and mousex()=>360 and mousex()=<423 and mousey()=>187 and mousey()=<198 then gosub make_cylinder
if mouseclick()=1 and hold=0 and mousex()=>209 and mousex()=<261 and mousey()=>62 and mousey()=<75 then gosub rotate
if mouseclick()=1 and hold=0 and mousex()=>207 and mousex()=<307 and mousey()=>140 and mousey()=<156 then gosub scale
if mouseclick()=1 and hold=0 and mousex()=>507 and mousex()=<551 and mousey()=>527 and mousey()=<529 then gosub light
if mouseclick()=1 and hold=0 and mousex()=>58 and mousex()=<94 and mousey()=>181 and mousey()=<200 then end
if mouseclick()=1 and hold=0 and mousex()=>510 and mousex()=<626 and mousey()=>140 and mousey()=<159 then gosub texture
if mouseclick()=1 and hold=0 and mousex()=>509 and mousex()=<625 and mousey()=>176 and mousey()=<198 then gosub directx
if mouseclick()=1 and hold=0 and mousex()=>211 and mousex()=<315 and mousey()=>182 and mousey()=<199 then screenshot()
if mouseclick()=1 and hold=0 and mousex()=>509 and mousex()=<564 and mousey()=>98 and mousey()=<118 then gosub make_sphere

`save mesh
if inkey$()="s"
repeat
text 0,220,"enter a filename: "
sync
until scancode()>0
set cursor 0,240
input "",filename$

if file exist(filname$)
if object exist(usernum) then make mesh from object 1,usernum
if object exist(usernum) then save mesh filename$,1
endif
endif

`save
if mouseclick()=1 and hold=0 and mousex()=>59 and mousex()=<97 and mousey()=>143 and mousey()=<159
repeat
text 0,220,"enter a filename: "
sync
until scancode()>0
set cursor 0,240
input "",filename$
if file exist(filename$+".txt") then delete file filename$+".txt"
open to write 1,filename$+".txt"

objnums=objnum






write file 1,objnums


for object=1 to objnum-1
if object exist(object)
    write string 1,typeobj$(object)
    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,sx#
    write float 1,sy#
    write float 1,sz#
  endif
  text 250,250,"Saving"
  sync
next object

close file 1

endif


if mouseclick()=1 and hold=0 and mousex()=>61 and mousex()=<104 and mousey()=>101 and mousey()=<117



repeat
text 0,220,"enter a filename : "
sync
until scancode()>0
set cursor 0,240
input "",filename$

if file exist(filename$+".txt")


open to read 1,filename$+".txt"

read file 1,objnums


objnum=objnums

for object = 1 to objnum-1
if object exist(object)
delete object object
endif
next object



for object=1 to objnum-1

   read string 1,typeofobject$



    read float 1,x#
    read float 1,y#
    read float 1,z#



    read float 1,angx#
    read float 1,angy#
    read float 1,angz#



    read float 1,sx#
    read float 1,sy#
    read float 1,sz#

    sx#=sx#
    sy#=sy#
    sz#=sz#


   if typeofobject$ = "cube" then make object cube object,6
    if typeofobject$ = "box" then make object box object,3,3,6
    if typeofobject$ = "cone" then make object cone object,6
    if typeofobject$ = "cylinder" then make object cylinder object,6

if object exist(object) then rotate object object,angx#,angy#,angz#
if object exist(object) then position object object,x#,y#,z#
if object exist(object) then scale object object,sx#,sy#,sz#


text 250,250,"Loading"
  sync
next object
else
text 250,250,"File not found"
sync
wait 1000
endif `(file exist)
endif


close file 1




if scancode()=211 then gosub delete_object

if object exist(usernum) then show object usernum


`print position
set cursor 40,500
if object exist(usernum) then  print "z:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)



`print angle
set cursor 500,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 500,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 500,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum



point camera 0,0,0

   sync
   loop

make_cube:

make object cube objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cube"

inc objnum


return

make_sphere:

make object sphere objnum,6
position object objnum,0,0,0
typeobj$(objnum)="sphere"

inc objnum


return






make_box:

make object box objnum,3,3,6
position object objnum,0,0,0
typeobj$(objnum)="box"




inc objnum


return

make_cone:

make object cone objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cone"



inc objnum



return

make_cylinder:

make object cylinder objnum,6
position object objnum,0,0,0
typeobj$(objnum)="cylinder"

inc objnum


return


`Create Menu Bar
Function Menu_Bar(num1,num2,menu1$,menu2$,menu3$,menu4$)
if sprite exist(num1)=0
   sprite num1,0,0,10
endif
size sprite num1,screen width(),30
text 50,5,menu1$ : text 200,5,menu2$ : text 350,5,menu3$ : text 500,5,menu4$
if mousex()>50 and mousex()<50+text width(menu1$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(1)=2
endif
if mousex()>200 and mousex()<200+text width(menu2$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(2)=2
endif
if mousex()>350 and mousex()<350+text width(menu3$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(3)=2
endif
if mousex()>500 and mousex()<500+text width(menu4$) and mousey()>0 and mousey()<50 and mouseclick()=1
   gui_state(4)=2
endif
if gui_state(2)=2 and mousey()<50 and mousex()<50+text width(menu1$) then gui_state(2)=1 : gui_state(1)=2
if gui_state(3)=2 and mousey()<50 and mousex()<200+text width(menu2$) then gui_state(3)=1 : gui_state(2)=2
if gui_state(4)=2 and mousey()<50 and mousex()<350+text width(menu3$) then gui_state(4)=1 : gui_state(3)=2
if gui_state(1)=2 and mousey()<50 and mousex()>200 and mousex()<200+text width(menu2$) then gui_state(1)=1 : gui_state(2)=2
if gui_state(2)=2 and mousey()<50 and mousex()>350 and mousex()<350+text width(menu3$) then gui_state(2)=1 : gui_state(3)=2
if gui_state(3)=2 and mousey()<50 and mousex()>500 and mousex()<500+text width(menu4$) then gui_state(3)=1 : gui_state(4)=2
for m=1 to 4
if gui_state(m)=2 and mousey()>50 and mouseclick()=1 then gui_state(m)=1
next m
sprite num2,0,0,11 : hide sprite num2
if gui_state(1)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,50,30,11
endif
if gui_state(2)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,200,30,11
endif
if gui_state(3)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,350,30,11
endif
if gui_state(4)=2
If sprite exist(num2)=1 then delete sprite num2
sprite num2,500,30,11
endif
if sprite exist(num2)=1 then size sprite num2,150,200
Endfunction



Function Sub_Menu(num,sub1$,sub2$,sub3$,sub4$)

if num=1 then in=60
if num=2 then in=210
if num=3 then in=360
if num=4 then in=510
if gui_state(num)=2
text in,60,sub1$ : text in,100,sub2$ : text in,140,sub3$ : text in,180,sub4$
endif

Endfunction

rotate:
do

mmx#=mousemovex()
mmy#=mousemovey()


if object exist(usernum) and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)


if mouseclick()=1 and object exist(usernum)
turn object right usernum,mmx#
pitch object up usernum,-mmy#
endif

if mouseclick()=2 and object exist(usernum)
roll object right usernum,-mmy#
endif

if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")

`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)


 `camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance

set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum


if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif

sync
loop


delete_object:



if object exist(usernum) then delete object usernum



return

scale:
global sx#=300.0
global sy#=300.0
global sz#=300.0


do

mmx#=mousemovex()
mmy#=mousemovey()

if object exist(usernum) and mouseclick()=1 and mouseclick()=2 then usernum = pick object (mousex(),mousey(),1,objnum-1)

if mouseclick()=1 then sx=sx+mmx#
if mouseclick()=1 then sy=sy+mmy#
if mouseclick()=2 then sz=sz+mmx#


if object exist(usernum) then scale object usernum,sx,sy,sz

`Create a menu bar
menu_bar(10,11,"File","tools","Basic primitives","add")
sub_menu(1,"New","Open","save","Exit")
sub_menu(2,"rotate object","exit mode","scale object","light mode")
sub_menu(3,"cube","box","cone","cylinder")
sub_menu(4,"Light","sphere","texture object","Exit")


`camera movement
   if upkey() = 1 then dec camDistance, 0.2
   if downkey() = 1 then inc camDistance, 0.2
   if rightkey() = 1 then inc camAng,0.3
   if leftkey() = 1 then dec camAng,0.3

   if controlkey() = 1 then dec camroll, 0.1
   if shiftkey() = 1 then inc camroll, 0.1

   position camera cos(camAngle)*camDistance+5, 15+camroll, sin(camAng)*camDistance


set cursor 40,500
if object exist(usernum) then  print "x:",object position x(usernum)

set cursor 40,520
if object exist(usernum) then  print "y:",object position y(usernum)

set cursor 40,540
if object exist(usernum)then print "x:",object position x(usernum)





`print angle
set cursor 400,500
if object exist(usernum) then  print "Z Angle:",object angle x(usernum)

set cursor 400,520
if object exist(usernum) then  print "Y Angle:",object angle y(usernum)

set cursor 400,540
if object exist(usernum)then print "X Angle:",object angle x(usernum)

set cursor 250,520
if object exist(usernum)then print "Current object:",usernum





if scancode()=13 and object exist(usernum+1)
inc usernum,1
endif
if scancode()=12 and usernum>1
if object exist(usernum-1)
dec usernum,1
endif
endif


if mouseclick()=1 and mousex()=>209 and mousex()=<291 and mousey()=>104 and mousey()=<118 then return

sync
loop

light:


make object sphere objlightnum,3
make light lightnum
show light lightnum
inc lightnum



return

select_light:

input "select light number",userlightnum

return


`note that y plain is used so that if your default build plain is higher than 0 you can specify it
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

texture:

global imagenumber=2

repeat
text 0,220,"enter a image name with extension: "
sync
until scancode()>0
set cursor 0,240
input "",imagename$

do


load image imagename$,imagenumber

texture object usernum,imagenumber

inc imagenumber

return


sync
loop


directx:

repeat
text 0,220,"enter a object(without extension): "
sync
until scancode()>0
set cursor 0,240
input "",objectname$

load object objectname$,objnum

position object objnum,0,0,0

inc objnum

return



FUNCTION screenshot()

   name$ = "Screen " + str$(gScreenshot_number) + ".bmp"

   temp_image = 100
   get image temp_image, 0,0+(300*1),800,300+(300*1)
   save image name$, temp_image
   delete image temp_image
   gScreenshot_number = gScreenshot_number + 1
   inc temp_image

ENDFUNCTION

`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

    Fourth: Ztoasted... nice entry but your toast next to some of the others =)

   First: The Dynamic Kryptonite, AKA TDK!  - Well done, hope no one argue with me but it was a tight squeeze, concidering I almost
 notched you down one because almost all the move scale and rotate commands didn't work properly or wierdly in the main window, but seeing how the work fine in the others, combined with your interface, 
object browser... well, GOOD JOB!

   Third: Realy Inovative Intellegence - Pure Inovation got you this one Rii... Its a shame you didn't carry it further

  Second: Running Inovation Currently, AKA Ric - Also very, very well done, nearly squeezed ahead, if you'd had a nicer interface, a tad 
more features and you would have had it, the Lightmapping was realy awsome I might add =)

Rem Project: Xmas Tree
Rem Created: 29/11/2005 13:07:09

Rem ***** Main Source File *****

Set Display Mode 800,600,32
Sync On
Sync Rate 0
AutoCam Off
Color Backdrop RGB(100,100,120)
Hide Mouse
Randomize Timer()
Gosub MakeTextures
Make Matrix 1,10000,10000,50,50
Prepare Matrix Texture 1,1001,1,1
Position Matrix 1,-5000,-400,-5000
Randomize Matrix 1,50
Update Matrix 1
Gosub MakeTree
Gosub Decorate

Position Camera 0,100,-700
Point Camera 0,0,0
XDist#=800.0: ZDist#=800.0
Do
  X# = WrapValue(X# + .05)
  Z# = WrapValue(Z# + .1)
  Position Camera newxvalue(Object Position X(1),X#,XDist#),  0,  newzvalue(Object Position Z(1),Z#,ZDist#)
  Point Camera 0,0,0
  Sync
Loop

MakeTree:
  Make Object Cylinder 100, 30
  Color Object 100,RGB(30,0,0):Scale Object 100,50,500,50: Position Object 100,0,-300,0
  Set Object 100,1,0,1,1,1,1,0
  For N=1 To 18
    Make Object Plain N, 800,600
    Texture Object N,1000
    YRotate Object N,WrapValue(N*20)
    Set Object N,1,1,1,0,0,0,0
    Set Object Smoothing N,100
  Next N
Return

Decorate:
  For N=1 To 9
    Make Object Sphere N+80, 20
    Set Object N+80,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+80,RGB(R,G,B): Position Object N+80,0,150,0
    Set Object Emissive N+80,RGB(R/2,G/2,B/2)
    YRotate Object N+80,WrapValue(N*40-10)
    Move Object N+80,100
  Next N
  For N=1 To 9
    Make Object Sphere N+70, 20
    Set Object N+70, 1, 1, 1, 1, 1, 0, 0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+70,RGB(R,G,B): Position Object N+70,0,95,0
    Set Object Emissive N+70,RGB(R/2,G/2,B/2)
    YRotate Object N+70,WrapValue(N*40+10)
    Move Object N+70,115
  Next N
  For N=1 To 9
    Make Object Sphere N+19, 20
    Set Object N+19,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+19,RGB(R,G,B): Position Object N+19,0,30,0
    Set Object Emissive N+19,RGB(R/2,G/2,B/2)
    YRotate Object N+19,WrapValue(N*40-10)
    Move Object N+19,140
  Next N
  For N=1 To 9
    Make Object Sphere N+30, 20
    Set Object N+30,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+30,RGB(R,G,B): Position Object N+30,0,-45,0
    Set Object Emissive N+30,RGB(R/2,G/2,B/2)
    YRotate Object N+30,WrapValue(N*40+10)
    Move Object N+30,175
  Next N
  For N=1 To 9
    Make Object Sphere N+40, 20
    Set Object N+40,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+40,RGB(R,G,B): Position Object N+40,0,-130,0
    Set Object Emissive N+40,RGB(R/2,G/2,B/2)
    YRotate Object N+40,WrapValue(N*40-10)
    Move Object N+40,205
  Next N
  For N=1 To 9
    Make Object Sphere N+50, 20
    Set Object N+50,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+50,RGB(R,G,B): Position Object N+50,0,-225,0
    Set Object Emissive N+50,RGB(R/2,G/2,B/2)
    YRotate Object N+50,WrapValue(N*40+10)
    Move Object N+50,240
  Next N
  For N=1 To 9
    Make Object Sphere N+60, 20
    Set Object N+60,1,1,1,1,1,0,0
    R=Rnd(1)*255: G=Rnd(1)*255: B=Rnd(1)*255: If R=0 and G=0 and B=0 Then R=255
    Color Object N+60,RGB(R,G,B): Position Object N+60,0,-310,0
    Set Object Emissive N+60,RGB(R/2,G/2,B/2)
    YRotate Object N+60,WrapValue(N*40-10)
    Move Object N+60,240
  Next N
  For N=1 To 10
    Make Object Cylinder N+89,100
    R=N*15
    Texture Object N+89,1002:Scale Object N+89,(11-N)*40+R,(11-N)*40+R,(11-N)*40+R: Position Object N+89,0,(N*80)-330-(R*2),0
    Set Object N+89,1,1,0,1,1,1,0
    Set Object Emissive N+89,RGB(R/2,G/2,B/2)
    YRotate Object N+89,Rnd(360)
    ZRotate Object N+89,Rnd(40)-20
  Next N
Return

MakeTextures:
  Create Bitmap 1,800,600
  Rem Tree
  CLS RGB(0,50,0)
  For N=1 To 5000
    Ink RGB(0,Rnd(255),0),0
    X1=Rnd(520): Y1=Rnd(520)
    X2=X1+Rnd(20)-10
    Y2=Y1+Rnd(20)-10
    Line X1,Y1,X2,Y2
  Next N
  Ink RGB(255,255,255),0
  For N=1 To 5000
    X1=Rnd(520): Y1=Rnd(520)
    Box X1,Y1,X1+1,Y1+1
  Next N
  Gapy#=4: Gapx#=0: Slope#=1.0
  For N1 = 0 To 17
    Ink 0,0
    For Ny = Int(N1*Gapy#) To Int((N1+2)*Gapy#)
      Line 0,  Ny,  Int(250-Gapx#),  Ny
      Line 512,  Ny,  Int(260+Gapx#),  Ny
      Inc Gapx#,Slope#
    Next Ny
    Gapx#=0: Inc Gapy#,4: Inc Slope#,0.1
  Next N1
  Blur Bitmap 1,1
  Get Image 1000,0,2,512,514,0
  Rem Snow
  CLS RGB(255,255,255)
  For N=1 To 5000
    Col=Rnd(55)+200
    Ink RGB(Col,255,Col),0
    X1=Rnd(520): Y1=Rnd(520)
    Dot X1,Y1
    Circle X1,Y1,Rnd(10)
  Next N
  Blur Bitmap 1,4
  Get Image 1001,0,1,513,513,0
  Rem Garland
  CLS 0
  For N1= 1 To 1
    sine#=10: velocity#=0
    For X=0 To 512
      IF sine#>=0
        Dec velocity#,.02
      ELSE
        Inc velocity#,.02
      Endif
      Inc sine#,velocity#
      Ink RGB(255,255,255),0
      Line X,sine#+256,X+Rnd(20)-10,sine#+256+Rnd(20)-10
      Line X,sine#+256,X+Rnd(30)-15,sine#+256+Rnd(30)-15
      Line X,sine#+256,X+Rnd(40)-20,sine#+256+Rnd(40)-20
    Next X
  Next N1
  Get Image 1002,0,1,513,513,0
  Delete Bitmap 1
Return

sync on
autocam off
sync rate 60

make_specularmap()
make_snowmap()
make_shader_snow()

rotate light 0,140,0,0

load effect "snowshader.fx",1,1
set effect constant integer 1,"SpecularPower",15


LightDir = 1
null = Make Vector4(LightDir)
SET VECTOR4 LightDir, light direction x(0), light direction y(0), light direction z(0), 0
set effect constant vector 1,"LightDir",LightDir

`Making our textures.&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
create bitmap 1,64,64
set current bitmap 1
ink rgb(5,5,5),0
CircleFill(32, 32, 30, rgb(5,5,5))
get image 1,0,0,64,64
ink 0,0
cls
ink rgb(128,0,0),0
box 0,0,50,64
box 0,0,64,5
box 0,20,64,25
box 0,40,64,45
box 0,60,64,64
get image 2,0,0,64,64
set current bitmap 0
delete bitmap 1

`&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

`********WORLD***********
make object plain 3,200,200
scale object texture 3,8,8
rotate object 3,-90,0,0
set object effect 3,1

`*******SNOWMAN************
make object sphere 2,4
set object effect 2,1
position object 2,0,1,20


` HEAD - Limb 1.
make object sphere 4,3
make mesh from object 1,4
delete object 4
add limb 2,1,1
link limb 2,0,1
offset limb 2,1,0,3,0
set limb effect 2,1,1
delete mesh 1

`COAL MOUTH - Limb 2.
make object sphere 11,0.4,4,4
make mesh from object 11,11
delete object 11
add limb 2,2,11
delete mesh 11
link limb 2,1,2
offset limb 2,2,0.2,-0.35,1.4
color limb 2,2,rgb(5,5,5)

`CARROT NOSE - Limb 3.
make object cone 7,1
scale object 7,50,130,50
make mesh from object 7,7
delete object 7
add limb 2,3,7
link limb 2,1,3
delete mesh 7
offset limb 2,3,0,0.15,1.8
rotate limb 2,3,95,0,0
color limb 2,3,rgb(255,175,0)

`RIGHT EYE - Limb 4.
make object sphere 9,0.45,4,4
make mesh from object 9,9
add limb 2,4,9
link limb 2,1,4
offset limb 2,4,-0.65,0.45,1.2
color limb 2,4,rgb(5,5,5)
delete object 9
delete mesh 9

`LEFT EYE - Limb 5.
make object sphere 10,0.45,4,4
make mesh from object 10,10
add limb 2,5,10
link limb 2,1,5
offset limb 2,5,0.65,0.45,1.2
color limb 2,5,rgb(5,5,5)
delete object 10
delete mesh 10

` HAT BRIM - Limb 6.
make object plain 5,4,4
set object cull 5,0
rotate object 5,-90,0,0
make mesh from object 5,5
add limb 2,6,5
link limb 2,1,6
offset limb 2,6,0,0.94,0
texture limb 2,6,1
delete object 5
delete mesh 5

`HAT PILLAR - Limb 7.
make object cylinder 6,2.25
make mesh from object 6,6
add limb 2,7,6
link limb 2,6,7
offset limb 2,7,0,0.8,0
color limb 2,7,rgb(5,5,5)
delete object 6
delete mesh 6

`HAT TOP - Limb 8.
make object plain 8,2.35,2.35
rotate object 8,-90,0,15
make mesh from object 8,8
add limb 2,8,8
link limb 2,7,8
texture limb 2,8,1
offset limb 2,8,0,1.29,0
delete object 8
delete mesh 8

`SCARF - Limb 9
make object cylinder 12,2.4
scale object 12,100,25,100
color object 12,rgb(128,0,0)
rotate object 12,0,0,5
make mesh from object 12,12
add limb 2,9,12
link limb 2,0,9
offset limb 2,9,0,1.75,0
color limb 2,9,rgb(128,0,0)
delete object 12
delete mesh 12


`SCARF TASSLES
make object plain 13,2,1
rotate object 13,0,40,90
texture object 13,2
set object transparency 13,1
scale object texture 13,1,4
make mesh from object 13,13
add limb 2,10,13
link limb 2,9,10
offset limb 2,10,0,-0.6,1.7
texture limb 2,10,2
delete object 13
delete mesh 13


`&&&&&&&&& MAKE THE SNOWMAN TRANSPARENT
set object transparency 2,4
set object cull 2,0


position object 2,40,1,0

PERFORM CHECKLIST FOR EFFECT VALUES 1

set ambient light 4
color light 0,rgb(255,255,255)

position camera 0,0,3.25,40
rotate camera 0,0,180,0




make_logcabin()









do



control camera using arrowkeys 0,1,1

`rotate limb 2,1,0,sin(timer()/10)*10,0
rotate limb 2,1,-abs(sin(timer()/6)*10)+10,0,0

`position object 2,object position x(2),abs(sin(timer()/6)*3)+1,object position z(2)

sync

loop







function CircleFill(x, y, radius, colour)
   ink colour, 0
   circle x, y, radius
   FloodFill(x, y, colour)
endfunction

function EllipseFill(x, y, radiusX, radiusY, colour)
   ink colour, 0
   ellipse x, y, radiusX, radiusY
   FloodFill(x, y, colour)
endfunction

function FloodFill(x, y, fillColour as dword)
   backgroundColour = point(x, y) : rem this should work in all bpp display modes
   if backgroundColour = fillColour then exitfunction
   ink fillColour, 0              : rem setup the fill colour as foreground, and background as black (this is not used)
   lock pixels

   __FloodFill(x, y, backgroundColour)

   unlock pixels
endfunction

function __FloodFill(x, y, backgroundColour as dword)
   BitmapWidth  = bitmap width()

   rem do current row as far as possible
   x1 = x - 1
   while (x1 >= 0) and (point(x1, y) = backgroundColour)
      dec x1
   endwhile
   rem from current point find righthand extent
   x2 = x + 1
   while (x2 < BitmapWidth) and (point(x2, y) = backgroundColour)
      inc x2
   endwhile
   inc x1
   if x2 - x1 > 0
      line x1, y, x2, y : rem draw a line between the extents

      for z = 1 to 2
         if z = 1
            y2 = y - 1 : rem process line of pixels above working along all breaks in the line
         else
            y2 = y + 1 : rem process line of pixels below working along all breaks in the line
         endif

         if (y > 0 and z = 1) or (y < bitmap height() - 1 and z = 2)
            x4 = x1
            while x4 > 0 and point(x4, y2) = backgroundColour
               dec x4
            endwhile
            x5 = x2 - 1
            while x5 < BitmapWidth - 1 and point(x5, y2) = backgroundColour
               inc x5
            endwhile
            newExtent = 1
            for x3 = x4 to x5 - 1
               if point(x3, y2) = backgroundColour
                  if newExtent = 1
                     newExtent = 0
                     xstart = x3
                  endif
               else
                  if newExtent = 0
                     __FloodFill(xstart, y2, backgroundColour)
                     newExtent = 1
                  endif
               endif
            next
            if newExtent = 0 then __FloodFill(xstart, y2, backgroundColour)
         endif
      next
   endif
endfunction





function make_shader_snow()

string1$ = "float4x4 matWorldViewProj : WorldViewProjection; float4x4 matWorld   : World; float3 vecEye : cameraposition;"
string2$ = "float4 LightDir : Direction < string Object = "+CHR$(34)+"DirectionalLight"+CHR$(34)+"; string Space = "+CHR$(34)+"World"+CHR$(34)+"; > = {-1.0f, 1.0f, -1.0f, 0.0f};"
string3$ = "int SpecularPower = 15;"
string4$ = "texture diffuseTexture : Diffuse < string name = "+CHR$(34)+"snow_texture.bmp"+CHR$(34)+"; >;"
string5$ = "texture specularTexture : Specular < string name = "+CHR$(34)+"snow_specular.bmp"+CHR$(34)+"; >;"
string6$ = "struct VS_OUTPUT { float4 Pos : POSITION; float2 Tex : TEXCOORD0; float3 Norm : TEXCOORD1; float3 View : TEXCOORD2; float3 Light : TEXCOORD3; };"
string7$ = "VS_OUTPUT VS(float4 Pos : POSITION, float3 Normal : NORMAL, float2 Tex : TEXCOORD) { VS_OUTPUT Out = (VS_OUTPUT)0; Out.Pos = mul(Pos, matWorldViewProj);  Out.Light = LightDir; float3 PosWorld = normalize(mul(Pos, matWorld)); Out.View = vecEye - PosWorld; Out.Norm = mul(Normal, matWorld); Out.Tex = Tex.xy; return Out; }"
string8$ = "sampler SpecularMapSampler = sampler_state { texture = <specularTexture>; AddressU  = CLAMP; AddressV  = CLAMP; AddressW  = CLAMP; MIPFILTER = LINEAR; MINFILTER = LINEAR; MAGFILTER = LINEAR; };"
string9$ = "sampler DiffuseMapSampler = sampler_state {texture = <diffuseTexture>; AddressU  = CLAMP; AddressV  = CLAMP; AddressW  = CLAMP; MIPFILTER = LINEAR; MINFILTER = LINEAR; MAGFILTER = LINEAR;};"
string10$ = "float4 PS(float2 Tex: TEXCOORD0, float3 Norm : TEXCOORD1, float3 View : TEXCOORD2, float3 Light: TEXCOORD3) : COLOR"
string11$ = "{ float4 psOut; float3 SpecLevel = tex2D(SpecularMapSampler, Tex).xyz; float4 diffuse = tex2D(DiffuseMapSampler, Tex); float4 ambient = {0.2, 0.25, 0.25, 1.0}; float3 Normal = normalize(Norm); float3 LightDir = -normalize(Light);"
string12$ = "float3 ViewDir = normalize(View); float4 diff = saturate(dot(Normal, LightDir)); float3 H = normalize(LightDir + ViewDir); float4 Specular = pow(saturate(dot(Normal, H)), SpecularPower); psOut.rgb = ambient + (diffuse * diff + Specular * SpecLevel); psOut.a = 1.0f; return(psOut);}"
string13$ = "technique textured { pass p0 { VertexShader = compile vs_1_1 VS(); PixelShader  = compile ps_2_0 PS(); } }"



if file exist("snowshader.fx") = 1
   delete file "snowshader.fx"
endif
   open to write 1,"snowshader.fx"

   write string 1,string1$: write string 1,string2$: write string 1,string3$: write string 1,string4$: write string 1,string5$
   write string 1,string6$: write string 1,string7$: write string 1,string8$: write string 1,string9$: write string 1,string10$
   write string 1,string11$: write string 1,string12$: write string 1,string13$
   close file 1

endfunction


function make_specularmap()

create bitmap 1,128,128
set current bitmap 1
ink rgb(255,255,255),0
for i = 0 to 400
   dot rnd(127),rnd(127)
next i

get image 10,0,0,128,128
save image "snow_specular.bmp",10

set current bitmap 0
delete bitmap 1
delete image 10
endfunction



function make_snowmap()

create bitmap 1,128,128
set current bitmap 1
ink rgb(220,230,255),0
box 0,0,128,128
ink rgb(255,255,255),0
for i = 0 to 200
   dot rnd(127),rnd(127)
next i

ink rgb(0,0,255),0
for i = 0 to 100
   dot rnd(127),rnd(127)
next i

blur bitmap 1,4

get image 10,0,0,128,128
save image "snow_texture.bmp",10
set current bitmap 0
delete image 10,
delete bitmap 1

endfunction




function make_logcabin()

`biglog = free_object()
`make object cylinder biglog,4
`scale object biglog,100,1000,100
`rotate object biglog,90,0,0

for i = 0 to 3
   make object cylinder 900+i,4
   scale object 900+i,75,1000,75
   rotate object 900+i,90,0,0
   position object 900+i,-10,(i*3)+1,0
   color object 900+i,rgb(128,64,0)
next i

for i = 0 to 2
   make object cylinder 910+i,4
   scale object 910+i,75,400,75
   rotate object 910+i,90,0,0
   position object 910+i,10,(i*3)+1,-12
   color object 910+i,rgb(128,64,0)
next i

for i = 0 to 2
   make object cylinder 915+i,4
   scale object 915+i,75,400,75
   rotate object 915+i,90,0,0
   position object 915+i,10,(i*3)+1,12
   color object 915+i,rgb(128,64,0)
next i

make object cylinder 919,4
scale object 919,75,1000,75
rotate object 919,90,0,0
position object 919,10,(3*3)+1,0
color object 919,rgb(128,64,0)


make object box 920,20,0.5,40
position object 920,0,0,0
color object 920,rgb(128,64,0)


for i = 0 to 3
   make object cylinder 921+i,4
   scale object 921+i,75,500,75
   rotate object 921+i,90,90,0
   position object 921+i,0,(i*3)+1,-20
   color object 921+i,rgb(128,64,0)
next i

for i = 0 to 3
   make object cylinder 925+i,4
   scale object 925+i,75,500,75
   rotate object 925+i,90,90,0
   position object 925+i,0,(i*3)+1,20
   color object 925+i,rgb(128,64,0)
next i

make object box 929,20,0.5,48
position object 929,7.5,15,0
rotate object 929,0,0,-40
set object effect 929,1

make object box 930,20,0.5,48
position object 930,-7.5,15,0
rotate object 930,0,0,40
set object effect 930,1


make object cylinder 932,4
scale object 932,75,300,75
position object 932,10,5.25,20
color object 932,rgb(128,64,0)

make object cylinder 933,4
scale object 933,75,300,75
position object 933,-10,5.25,20
color object 933,rgb(128,64,0)

make object cylinder 934,4
scale object 934,75,300,75
position object 934,10,5.25,-20
color object 934,rgb(128,64,0)

make object cylinder 935,4
scale object 935,75,300,75
position object 935,-10,5.25,-20
color object 935,rgb(128,64,0)

make object triangle 936,10,11,20,-10,11,20,0,20,20
color object 936,rgb(128,64,0)
`x,y,z 10,11,-20,
`x,y,z -10,11,-20,
`x,y,z 0,14,20

make object triangle 937,10,11,-20,-10,11,-20,0,14,20


endfunction



Function free_image()
   i=100
   Do
      If Image Exist(i)=0 then Exit
      inc i
   Loop
Endfunction i

Function free_object()
   i=100
   Do
      If Object Exist(i)=0 then Exit
      inc i
   Loop
Endfunction i


Function Get_Ground_Height_Not_Player(TerrainID,x#,z#)

   local_grounddistance# = intersect object (TerrainID,x#,500,z#,x#,-500,z#)
   local_height# = 500 - local_grounddistance#

EndFunction local_height#