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