Sorry your browser is not supported!

sync on
autocam off

Print "This is the Control:"
print " -------------------------------------"
Print "Arrow key to move camera"
Print "W-A-S-D to rotate camera"
Print "Hold LeftClick to move vertex on X & Z axis (X mouse=X axis, Y mouse=Z axis)"
Print "Hold LeftClick to move vertex on Y axis"
Print "Press SpaceBar to hide/show vertice"
Print "Press R to change mode: Rotation/Modification"
Print "(in rotation mode, just move the mouse to rotate the sphere)"
print "Press N to use a New object"
print "Press E to SAVE your object to file "Object.CWW""
print "-----------------------------------------"
print "      ---Press Any Key to Begin---"
wait key

Gosub Initialisation_Variable
gosub selection_object


do
   if lower$(inkey$())<>"r" then r=0
   if (r=0) and (lower$(inkey$())="r") then r=1:Rotation=1:gosub Rotation

   if lower$(inkey$())<>"e" then e=0
   if (e=0) and (lower$(inkey$())="e") then gosub Save

   if lower$(inkey$())<>"n" then n=0
   if (n=0) and (lower$(inkey$())="n") then gosub selection_object

   if (mouseclick()=1) and (SelectVertex>=0) then gosub Modification
   if (mouseclick()=2) and (SelectVertex>=0) then gosub ModificationY

   gosub Souris
   gosub Inputs

   if spacekey()=0 then space=0
   if spacekey()=1 and space=0 then Space=1:gosub Cache_Vertex


   If Update=1 then Gosub Update_Object:Gosub Update_Vertex

   if lower$(inkey$())<>"h" then h=0
   if lower$(inkey$())="h" and h=0 then h=1:gosub help

   Set cursor 0,0
   print "Mode : Modification"
   print "press H for help"
   sync
loop


end
`******************************************************************************
Update_Object:
   CHANGE MESH FROM MEMBLOCK 1,1
   delete object 20000
   make object 20000,1,0
   set object rotation ZYX 20000
   position object 20000,0,0,0
   rotate object 20000,0,0,0
   color object 20000,rgb(150,0,0)
   Update=0
return
`*********************************************************************
Cache_Vertex:
   if Cache=0
      for i=1 to nb
         hide object i
      next i
      cache=1
   else
      for i=1 to nb
         show object i
      next i
      cache=0
   endif
Return
`********************************************
Souris:
   SelectObj=0-1
   selectVertex=0-1
   for i=1 to nb
      color object i,rgb(200,200,200)
      if (object visible(i)) and (object in screen(i))
         if (object screen x(i)>(MouseX()-5)) and (object screen x(i)<(MouseX()+5))
            if (object screen y(i)>(MouseY()-5)) and (object screen y(i)<(MouseY()+5))
               Color object i,rgb(0,0,255)
               SelectObj=i
               selectVertex=i-1
            endif
         endif
      endif
   next i
Return
`*******************************************
Update_Vertex:
for i=0 to (nb-1)
   Position#(i,1)=memblock float(1,offset+(12*i))
   Position#(i,2)=memblock float(1,offset+4+(12*i))
   Position#(i,3)=memblock float(1,offset+8+(12*i))
   position object i+1,Position#(i,1),Position#(i,2),Position#(i,3)
next i
Return
`*******************************************
Inputs:
   NbTouche=LeftKey()+RightKey()+Upkey()+Downkey()

   if (upkey()) and (NbTouche=1) then Direction=1
   if (downkey()) and (NbTouche=1) then Direction=5
   if (leftkey()) and (NbTouche=1)  then Direction=7
   if (rightkey()) and (NbTouche=1) then Direction=3

   if direction<>0
      oldx#=x#
      oldy#=y#
      oldz#=z#
      MoveAy#=wrapvalue(((Direction-1)*45)+Ay#)
      if direction=5 then Ax2#=ax#
      if (direction=1) then Ax2#=wrapvalue(0-ax#)
      if (direction=7) or (direction=3) then ax2#=0
      x#=oldx#+XValue(oldx#,oldz#,MoveAy#,Ax2#,5.0)
      y#=oldy#+YValue(oldx#,oldz#,MoveAy#,Ax2#,5.0)
      z#=oldz#+ZValue(oldx#,oldz#,MoveAy#,Ax2#,5.0)
      direction=0
   endif

   if Lower$(inkey$())="a" then ay#=wrapvalue(ay#-1)
   if Lower$(inkey$())="d" then ay#=wrapvalue(ay#+1)
   if Lower$(inkey$())="w" then ax#=wrapvalue(ax#+1)
   if Lower$(inkey$())="s" then ax#=wrapvalue(ax#-1)

   position camera x#,y#,z#
   rotate camera ax#,ay#,0
Return
`*********************************************************
function Xvalue(x#,z#,ay#,Ax#,L#)
zf#=(L#)*cos(ay#)
xf#=(L#)*sin(ay#)
lxzf#=sqrt(xf#^2.0+zf#^2.0)
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction x2#

function Yvalue(x#,z#,ay#,Ax#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
lxzf#=sqrt(xf#^2+zf#^2)
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction y2#

function Zvalue(x#,z#,ay#,Ax#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
lxzf#=sqrt(xf#^2+zf#^2)
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction z2#
`*********************************************************************
Modification:
   while Mouseclick()=1
      MouseX#=MouseMoveX()/2.0
      MouseY#=(0-(MouseMoveY()/2.0))
      VerteX#=NewXValue(Position#(SelectVertex,1),ay#+90,MouseX#)
      VerteZ#=NewZValue(Position#(SelectVertex,3),ay#+90,MouseX#)
      VerteX#=NewXValue(VerteX#,ay#,MouseY#)
      VerteZ#=NewZValue(VerteZ#,ay#,MouseY#)

      write memblock float 1,offset+(12*SelectVertex),VerteX#
      rem write memblock float 1,offset+4+(12*SelectVertex),Y#+(rnd(gros)-(gros/2))
      write memblock float 1,offset+8+(12*SelectVertex),VerteZ#

      Gosub Update_Object
      Gosub Update_Vertex

      Set cursor 0,0
      print "Mode : Modification"
      print "Moving vertex #"+str$(SelectVertex)+" on X & Z axis"
      sync
   endwhile
return
`*********************************************************************
ModificationY:
while Mouseclick()=2
      MouseY#=(0-(MouseMoveY()/2.0))
      VerteY#=Position#(SelectVertex,2)+MouseY#

      write memblock float 1,offset+4+(12*SelectVertex),VerteY#

      Gosub Update_Object
      Gosub Update_Vertex

      Set cursor 0,0
      print "Mode : Modification"
      print "Moving vertex #"+str$(SelectVertex)+" on Y axis"
      sync
      sync
   endwhile
return
`*****************************************************************
Rotation:
   ObAX#=0
   ObAY#=0
   rMouseX#=MouseX()
   rMouseY#=MouseY()

   While Rotation=1

      roldMouseX#=rMouseX#
      roldMouseY#=rMouseY#
      rMouseX#=MouseX()
      rMouseY#=MouseY()
      rem ObAX#=Wrapvalue(ObAX#+(roldMouseY#-rMouseY#))
      rem ObAY#=WrapValue(ObAY#+(roldMouseX#-rMouseX#))
      ObAX#=Wrapvalue((roldMouseY#-rMouseY#))
      ObAY#=WrapValue((roldMouseX#-rMouseX#))


      rotate object 20000,ObAX#,ObAY#,0
      make mesh from object 1,20000
      make memblock from mesh 1,1
      gosub Update_Vertex
      gosub Update_Object

      gosub Inputs

      Set cursor 0,0
      print "Mode : Rotation"
      print "press H for help"
      sync

      if spacekey()=0 then space=0
      if spacekey()=1 and space=0 then Space=1:gosub Cache_Vertex

      if lower$(inkey$())<>"h" then h=0
      if lower$(inkey$())="h" and h=0 then h=1:gosub help

      if lower$(inkey$())<>"r" then r=0
      if (r=0) and (lower$(inkey$())="r") then r=1:rotation=0:gosub Update_Object
   endwhile
return
`************************************************************************
Help:
   while lower$(inkey$())="h":endwhile

   while lower$(inkey$())<>"h"
      set cursor 0,0
      Print "Arrow key to move camera"
      Print "W-A-S-D to rotate camera"
      Print "Hold LeftClick to move vertex on X & Z axis (X mouse=X axis, Y mouse=Z axis)"
      Print "Hold LeftClick to move vertex on Y axis"
      Print "Press SpaceBar to hide/show vertice"
      Print "Press R to change mode: Rotation/Modification"
      Print "(in rotation mode, just move the mouse to rotate the sphere)"
      print "Press N to use a New object"
      print "Press E to SAVE your object to file "Object.CWW""
      print " "
      print "---press H to hide help---"
      sync
   endwhile
return
`************************************************************
Save:
   if file exist("Object.cww") then delete file "object.cww"

   open to write 1,"Object.CWW"
   write memblock 1,1
   close file 1

   time#=timer()
   while Timer()-time#<5000
      center text 320,240,"Saving object "Object.CWW""
      sync
   endwhile
return
`************************************************************
Initialise_Object:
   for i=1 to nb
      if object exist(i) then delete object i
   next i

   position object 20000,0,0,0
   set object rotation ZYX 20000
   rotate object 20000,0,45,0

   make mesh from object 1,20000
   make memblock from mesh 1,1

   Nb=memblock dword(1,0)
   dim Position#(Nb-1,3)

   Offset=memblock dword(1,4)
   for i=0 to (nb-1)
      Position#(i,1)=memblock float(1,offset+(12*i))
      Position#(i,2)=memblock float(1,offset+4+(12*i))
      Position#(i,3)=memblock float(1,offset+8+(12*i))
      make object cube i+1,4
      position object i+1,Position#(i,1),Position#(i,2),Position#(i,3)
   next i

   Gosub Update_Object
Return
`***************************************************************
Initialisation_Variable:
   make object plain 1,1,1
   delete object 1

   gros=0
   Update=1
   Modif=0
   z#=0-100
   nb=1
return
`**********************************************************
Selection_Object:
debb:
   if object exist(20000) then delete object 20000

   while object exist(20000)=0
      center text 320,100,"Wich object do you want?"
      center text 320,200,"1=Sphere"
      center text 320,220,"2=Cube"
      center text 320,240,"3=Cylinder"
      center text 320,260,"4=Cone"
      center text 320,280,"5=Plain"
      center text 320,300,"6=Triangle"
      center text 320,320,"7=Import a .CWW"
      center text 320,340,"8=Import a .X"

      if inkey$()="1" then Make object sphere 20000,50
      if inkey$()="2" then Make object Cube 20000,50
      if inkey$()="3" then Make object Cylinder 20000,50
      if inkey$()="4" then Make object Cone 20000,50
      if inkey$()="5" then Make object Plain 20000,50,50
      if inkey$()="6" then Make object Triangle 20000,0-25,0-25,0,0,25,0,25,0-25,0
      if inkey$()="7"
         cls
         backdrop off
         set cursor 0,0
         while inkey$()<>"":endwhile
         Input "FileName(write the .cww)=",Name$
         if file exist(Name$)
            open to read 1,Name$
            Read Memblock 1,1
            close file 1
            make mesh from memblock 1,1
            make object 20000,1,0
         else
            Backdrop on
            goto debb
         endif
         backdrop on
      endif
      if inkey$()="8"
         cls
         backdrop off
         set cursor 0,0
         while inkey$()<>"":endwhile
         Input "FileName(write the .X)=",Name$
         if file exist(Name$):Load Object Name$,20000:else:Backdrop on:goto debb:endif
         backdrop on
      endif

      sync
   endwhile

   Gosub Initialise_Object
return