Remstart
   ------------------------------------------------------------------
   Project:       View 3D.X Object
   Version:       0.00.001 ;D
   Author:        Volker Stepprath of Testaware
   Language:      DarkBASIC Professional v1.057
   Description:   Display & rotate any 3d.x object
   Date:          30. December 2004 / 14:50:42
   ------------------------------------------------------------------
   Hint 1:        Only for beginners in 3d programming
   Hint 2:        Use keys A, W, X, Y, Z, STRG, LMB/RMB to rotate
   Hint 3:        Key RETURN save actually display in Captured3D.bmp
   ------------------------------------------------------------------
Remend

sync on : sync rate 100
`* color backdrop 0        : Rem * Try different rgb() values

xo=1                       : Rem * Number of object

a$="Models/JETFIGHT2.x"    : Rem * Name of DirectX 3D file
b$="Models/JETFIGHT2.bmp"  : Rem * Image for texturing

_Load3DObject(xo,a$,b$)    : Rem * Install 3D Object
_View3DObject(xo)          : Rem * Display 3D Object

`* Examples for standard 3D Objects
for i=1 to 7
   _Make3DObject(xo,i,b$)
   _View3DObject(xo)
   _ClearKey()
next i

FUNCTION _Load3DObject(xo,a$,b$)

   `* Load & install an object
   `* xo = Number of object
   `* a$ = Filename of object
   `* b$ = Image filename for texturing (if needed)
   `* ------------------------------------------------------------------

   if object exist(xo) then delete object xo

   load object a$,xo

   if b$<>""
      load image b$,1,1
      texture object xo,1
   endif

ENDFUNCTION

FUNCTION _Make3DObject(xo,m,b$)

   `* Create standard object
   `* xo = Number of object
   `* m  = Mode, see case
   `* b$ = Image filename for texturing
   `* ------------------------------------------------------------------

   if object exist(xo) then delete object xo

   select m
      case 1 : make object cube        xo,5                 : endcase
      case 2 : make object sphere      xo,5,50,50           : endcase
      case 3 : make object box         xo,5,6,2             : endcase
      case 4 : make object cone        xo,5                 : endcase
      case 5 : make object cylinder    xo,5                 : endcase
      case 6 : make object triangle    xo,0,0,0,1,1,0,0,1,0 : endcase
      case 7 : make object plain       xo,5,5               : endcase
      case default : make object cube  xo,5                 : endcase
   endselect

   if b$<>""
      load image b$,1,1
      texture object xo,1
   endif

ENDFUNCTION

FUNCTION _View3DObject(xo)

   `* Display 3D.x object
   `* xo = Number of object
   `* ------------------------------------------------------------------

   po=10 : Rem * [LMB/RMB] Z-Position zoom in/out
   aw=1  : Rem * [A]       All xyz rotations on/off
   wf=0  : Rem * [W]       Wireframe on/off
   xw=1  : Rem * [X]       X-Rotation on/off
   yw=1  : Rem * [Y]       Y-Rotation on/off
   zw=1  : Rem * [Z]       Z-Rotation on/off

   position object xo,0,0,po

   repeat

      `* Returnkey to save actually view as bitmap file
      if returnkey()<>0
         get image 2,0,0,screen width(),screen height(),1
         sync
         save image "Captured3D.bmp",2
         _ClearKey()
      endif

      `* Controlkey to display object as it's default
      if controlkey()<>0
         x=0 : y=0 : z=0 : aw=0 : xw=0 : yw=0 : zw=0
      endif

      `* Use keys to switch angle rotation
      a$=inkey$()
      if a$<>""
         a$=upper$(a$)
         if a$="A" then aw=abs(aw-1) : xw=aw : yw=aw: zw=aw
         if a$="W" then wf=abs(wf-1) : set object wireframe xo,wf
         if a$="X" then xw=abs(xw-1)
         if a$="Y" then yw=abs(yw-1)
         if a$="Z" then zw=abs(zw-1)
         _ClearKey()
      endif

      `* Left mousekey zoom in, right to zoom out
      if mouseclick()<>0
         a=mouseclick()
         if a=1 then dec po,2 else inc po,2
         position object xo,0,0,po
         sync
      endif

      x=x-xw
      y=y-yw
      z=z-zw

      rotate object xo,wrapvalue(x),wrapvalue(y),wrapvalue(z)
      sync

   until a$=" "

   delete object xo

ENDFUNCTION

FUNCTION _ClearKey
   repeat : sync : until inkey$()=""
ENDFUNCTION