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