Panoramic-Draw3D

label abt, ld, sv, wis, tst, rdrw, rst, drw, pen, tpen, cam, camed, err
on_error_goto err
dim x, y, z, a$, xpos, ypos, ctr, pn$, kl$, fl$, pns, fs$, i$(10), obj
data "3d_box", "3d_cone","3d_cube", "3d_cylinder", "3d_dodecahedron", "3d_plane", "3d_sphere", "3d_teapot", "3d_text", "3d_torus"
data "width", "height", "depth", "3d_x_position", "3d_y_position", "3d_z_position", "3d_x_scale","3d_y_scale","3d_z_scale", "3d_x_rotate", "3d_y_rotate", "3d_z_rotate"
data 100,100,100,0,0,0,100,100,100,0,0,0
data "cam_x_position", "cam_y_position", "cam_z_position", "point_x_position", "point_y_position", "point_z_position", "light_x_position", "light_y_position", "light_z_position"
caption 0,"Panoramic Draw3D"
width 0,240
height 0,800
color 0, 255,255,255
main_menu 100
sub_menu 101:parent 101,100:caption 101,"Load":on_click 101,ld
sub_menu 102:parent 102,100:caption 102,"Save":on_click 102,sv
sub_menu 103:parent 103,100:caption 103,"Clear":on_click 103,wis
sub_menu 104:parent 104,100:caption 104,"Help":on_click 104,abt
open_dialog 109
save_dialog 110
form 1:color 1,255,255,255
left 1,240:height 1,800:width 1,800
alpha 2
top 2,10:left 2,25:width 2,70:caption 2, "3D-object:"
combo 3
top 3,7:left 3,80:width 3,120:height 3,25
for x = 1 to 10
 read a$
 item_add 3, a$
next x
on_change 3, drw
for x=4 to 15
read a$
 alpha x: caption x, a$
 left x,5:top x,x*20-20:width x,70
 scroll_bar x+12
 left x+12,80:top x+12,x*20-20:width x+12,110
 edit x+24:left x+24,195:top x+24,x*20-22:width x+24,35
next x
for x=16 to 24
 min x,1:max x,500
next x
for x=19 to 21
 min x,-500:max x,500
next x
 min 25,0:max 25,360: rem rotate x
 min 26,0:max 26,360: rem rotate y
 min 27,0:max 27,360: rem rotate z
for x=4 to 15
 read y
 text x+24,y
 position x+12,y
 on_change x+12,rst
 on_change x+24,rdrw
next x
button 40:caption 40,"Add!":on_click 40,tst
left 40,3:top 40,395:width 40,225
memo 41
left 41,3:top 41,425:width 41,225:height 41,100
item_add 41, "dim x,obj(100) : rem reserve space for 100 3d-objects"
item_add 41, "scene3d 1 : rem create 3d-world"
item_add 41, "full_space 1 : rem spread onto window"
item_add 41, "for x = 1 to 100"
item_add 41, "obj(x)=100+x : rem assign numbers to 3d_objects"
item_add 41, "next x"
item_add 41, "rem first 3d_object obj(1) gets reference number 101 etc."
edit 43: text 43, "3d_text"
top 43,30:left 43,25:width 43,175: on_change 43, drw
container 42
left 42,3:top 42,300:width 42,225:height 42,95
alpha 44:parent 44,42:font_bold 44
left 44,10:top 44,1:width 44,10:caption 44,"  3d_color  "
alpha 45:parent 45,42
left 45,5:top 45,20:width 45,20:caption 45,"Red"
scroll_bar 46:parent 46,42:min 46,0:max 46,255:position 46,0:on_change 46,pen
left 46,40:top 46,20:width 46,145
edit 47:parent 47,42:text 47,"0": on_change 47,tpen
left 47,190:top 47,18:width 47,30
alpha 48:parent 48,42
left 48,5:top 48,45:width 48,20:caption 48,"Green"
scroll_bar 49:parent 49,42:min 49,0:max 49,255:position 49,0:on_change 49,pen
left 49,40:top 49,45:width 49,145
edit 50:parent 50,42:text 50,"0":on_change 50,tpen
left 50,190:top 50,43:width 50,30
alpha 51:parent 51,42
left 51,5:top 51,70:width 51,20:caption 51,"Blue"
scroll_bar 52:parent 52,42:min 52,0:max 52,255:position 52,0:on_change 52,pen
left 52,40:top 52,70:width 52,145
edit 53:parent 53,42:text 53,"0":on_change 53,tpen
left 53,190:top 53,68:width 53,30
for x=54 to 62
 read a$
 alpha x: caption x, a$
 left x,5:top x,(x-27.5)*20:width x,70
 scroll_bar x+9: min x+9,-1000:max x+9,1000:position x+9,0
 left x+9,80:top x+9,(x-27.5)*20:width x+9,110
 edit x+18:left x+18,195:top x+18,(x-27.5)*20:width x+18,35:text x+18, "0"
next x
position 68,360
position 65,500
for x=54 to 62
 on_change x+9,cam
 on_change x+18,camed
next x
COMMAND_TARGET_IS 1
scene3d 199
full_space 199
y=200
end
rem ---------------------------------------------------------------------
pen:
 text 47, str$(position (46))
 text 50, str$(position (49))
 text 53, str$(position (52))
 font_color 44,position (46), position (49), position (52)
 3d_color y,position (46), position (49), position (52)
return
tpen:
 position 46, val(text$(47))
 position 49, val(text$(50))
 position 52, val(text$(53))
 font_color 44,position (46), position (49), position (52)
 3d_color y,position (46), position (49), position (52)
return
abt:
 message "Panoramic 3D Draw. Programmed by Lode Van de Velde."+chr$(13)+chr$(13)+"Choose the 3d-object, configure parameters and click the 'add'-button to get the code. Camera, light and pointing is also saved to file. Note that on saving an object, a new one is created on the exact same position as the previous one and may therefore not be visible, yet it can be manipulated."
return
sv:
 item_add 41, "CAM_POSITION "+str$(position (63)/100)+","+str$(position (64)/100)+","+str$(position (65)/100)
 item_add 41, "POINT_POSITION "+str$(position (66)/100)+","+str$(position (67)/100)+","+str$(position (68)/100)
 item_add 41, "LIGHT_POSITION "+str$(position (69)/100)+","+str$(position (70)/100)+","+str$(position (71)/100)
 fs$ = File_Name$(110)
 file_save 41, fs$
return
wis:
 3d_delete_all
return
tst:
 a$=" obj("+str$(y-149)+"), "
 select item_index(3): rem 1-10="3d_box", "3d_cone","3d_cube", "3d_cylinder", "3d_dodecahedron", "3d_plane", "3d_sphere", "3d_teapot", "3d_text", "3d_torus"
 case 0
  item_add 41, "3d_box"+a$+str$(position(16)/100)+","+ str$(position (17)/100)+","+ str$(position (18)/100)
 case 1
  item_add 41, item_index$(3)+a$+str$(position(16)/100)+","+ str$(position (17)/100)+","+ str$(position (18)/100)
 case 2
  item_add 41, item_index$(3)+a$+str$(position(16)/100)+","+ str$(position (17)/100)
 case 3
  item_add 41, item_index$(3)+a$+str$(position(16)/100)
 case 4
  item_add 41, item_index$(3)+a$+str$(position(16)/100)+","+ str$(position (17)/100)+","+ str$(position (18)/100)
 case 5
  item_add 41, item_index$(3)+a$
 case 6
  item_add 41, item_index$(3)+a$
 case 7
  item_add 41, item_index$(3)+a$+str$(position(16)/100)
 case 8
  item_add 41, item_index$(3)+a$
 case 9
    item_add 41, item_index$(3)+a$ + chr$(34)+text$(43)+chr$(34)
 case 10
  item_add 41, item_index$(3)+a$+str$(position(16)/100)+","+ str$(position (17)/100)
 end_select
 item_add 41, "3d_color"+a$ +str$(position (46))+","+ str$(position (49))+","+ str$(position (52))
 item_add 41, "3d_x_position"+a$+str$(position(19)/100)
 item_add 41, "3d_y_position"+a$+str$(position(20)/100)
 item_add 41, "3d_z_position"+a$+str$(position(21)/100)
 item_add 41, "3d_x_scale"+a$+str$(position(22)/100)
 item_add 41, "3d_y_scale"+a$+str$(position(23)/100)
 item_add 41, "3d_z_scale"+a$+str$(position(24)/100)
 item_add 41, "3d_x_rotate"+a$+str$(position(25))
 item_add 41, "3d_y_rotate"+a$+str$(position(26))
 item_add 41, "3d_z_rotate"+a$+str$(position(27))
 y=y+1
return
drw:
 if o3d_object_exists(y)= 1 then 3d_delete y
 select item_index(3) : rem 1-10 = "3d_box", "3d_cone","3d_cube", "3d_cylinder", "3d_dodecahedron", "3d_plane", "3d_sphere", "3d_teapot", "3d_text", "3d_torus"
 case 0
  3d_box y, position(16)/100, position(17)/100, position(18)/100
 case 1
  3d_box y, position(16)/100, position(17)/100, position(18)/100
 case 2
  3d_cone y, position(16)/100, position(17)/100
 case 3
  3d_cube y, position(16)/100
 case 4
  3d_cylinder y, position(16)/100, position(17)/100, position(18)/100
 case 5
  3d_dodecahedron y
 case 6
  3d_plane y
 case 7
  3d_sphere y, position(16)/100
 case 8
  3d_teapot y
 case 9
  3d_text y, text$(43)
 case 10
  3d_torus y, position(16)/100, position(17)/100
 end_select
 3d_color y,position (46), position (49), position (52)
 3d_x_position y, position(19)/100
 3d_y_position y, position(20)/100
 3d_z_position y, position(21)/100
 3d_x_scale y, position(22)/100
 3d_y_scale y, position(23)/100
 3d_z_scale y, position(24)/100
 3d_x_rotate y, position(25)
 3d_y_rotate y, position(26)
 3d_z_rotate y, position(27)
return
rdrw:
 for x=4 to 15
  position x+12, val(text$(x+24))
 next x
 gosub drw
return
rst:
 for x=4 to 15
  text x+24, str$(position(x+12))
 next x
 gosub drw
return
cam:
 for x=63 to 71
  text x+9, str$(position (x))
 next x
 CAM_POSITION position (63)/100,position (64)/100,position (65)/100
 POINT_POSITION position (66)/100,position (67)/100,position (68)/100
 LIGHT_POSITION position (69)/100,position (70)/100,position (71)/100
 gosub drw
return
camed:
 for x=63 to 71
  position (x), val(text$(x+9))
 next x
 CAM_POSITION position (63)/100,position (64)/100,position (65)/100
 POINT_POSITION position (66)/100,position (67)/100,position (68)/100
 LIGHT_POSITION position (69)/100,position (70)/100,position (71)/100
 gosub drw
return
ld:
 gosub wis
 obj=200
 fs$ = File_Name$(109)
 file_load 41,fs$
 for x=1 to count(41)
  a$=ltrim$(rtrim$(item_read$(41,x)))+",0,0,0,0"
  if instr(a$," ")<>0 then i$(1)=left$(a$,instr(a$," ")-1):a$=right$(a$,len(a$)-instr(a$," "))
  if instr(a$,",")<>0 then i$(2)=left$(a$,instr(a$,",")-1):a$=right$(a$,len(a$)-instr(a$,","))
  if instr(a$,",")<>0 then i$(3)=left$(a$,instr(a$,",")-1):a$=right$(a$,len(a$)-instr(a$,","))
  if instr(a$,",")<>0 then i$(4)=left$(a$,instr(a$,",")-1):a$=right$(a$,len(a$)-instr(a$,","))
  if instr(a$,",")<>0 then i$(5)=left$(a$,instr(a$,",")-1)
  rem message i$(1)+" "+i$(2)+" "+i$(3)+" "+i$(4)+" "+i$(5)
  if i$(1)="CAM_POSITION" then cam_position val(i$(2)),val(i$(3)),val(i$(4)):position 63, val(i$(2))*100:position 64,val(i$(3))*100:position 65,val(i$(4))*100
  if i$(1)="POINT_POSITION" then point_position val(i$(2)),val(i$(3)),val(i$(4)):position 66,val(i$(2))*100:position 67,val(i$(3))*100:position 68,val(i$(4))*100
  if i$(1)="LIGHT_POSITION" then light_position val(i$(2)),val(i$(3)),val(i$(4)):position 69,val(i$(2))*100:position 70,val(i$(3))*100:position 71,val(i$(4))*100
  if i$(1)="3d_box" then 3d_box obj,val(i$(3)),val(i$(4)),val(i$(5)):obj=obj+1
  if i$(1)="3d_cone" then 3d_cone obj,val(i$(3)),val(i$(4)):obj=obj+1
  if i$(1)="3d_cube" then 3d_cube obj,val(i$(3)):obj=obj+1
  if i$(1)="3d_cylinder" then 3d_cylinder obj,val(i$(3)),val(i$(4)),val(i$(5)):obj=obj+1
  if i$(1)="3d_dodecahedron" then 3d_dodecahedron obj:obj=obj+1
  if i$(1)="3d_plane" then 3d_plane obj:obj=obj+1
  if i$(1)="3d_sphere" then 3d_sphere obj,val(i$(3)):obj=obj+1
  if i$(1)="3d_teapot" then 3d_teapot obj:obj=obj+1
  if i$(1)="3d_text" then 3d_text obj,i$(3):obj=obj+1
  if i$(1)="3d_torus" then 3d_torus obj,val(i$(3)),val(i$(4)):obj=obj+1
  if i$(1)="3d_color" then 3d_color obj-1,val(i$(3)),val(i$(4)),val(i$(5))
  if i$(1)= "3d_x_position" then 3d_x_position obj-1,val(i$(3))
  if i$(1)= "3d_y_position" then 3d_y_position obj-1,val(i$(3))
  if i$(1)= "3d_z_position" then 3d_z_position obj-1,val(i$(3))
  if i$(1)= "3d_x_scale" then 3d_x_scale obj-1,val(i$(3))
  if i$(1)= "3d_y_scale" then 3d_y_scale obj-1,val(i$(3))
  if i$(1)= "3d_z_scale" then 3d_z_scale obj-1,val(i$(3))
  if i$(1)= "3d_x_rotate" then 3d_x_rotate obj-1,val(i$(3))
  if i$(1)= "3d_y_rotate" then 3d_y_rotate obj-1,val(i$(3))
  if i$(1)= "3d_z_rotate" then 3d_z_rotate obj-1,val(i$(3))
  for z=1 to 5
  i$(z)=""
  next z
 next x
y=obj
return
err:
return