3D Jolly Wrapper by Jolly Roger

[pistol350]

Edit : I forgot to add a ".x" file as a mesh + a ".bmp" file as a texture to test the wrapper.now see the attached file above.thanks graham ^^

That's a great tools
To use to wrap textures on your models.

autodefine "off"
'Requires IBasic 1.97 or greater.
'Jolly Roger May 2003
IF GETDXVERSION < 7
   MESSAGEBOX 0,"This program requires" + chr$(13) + "DirectX 7.0 or greater","Error"
   END
ENDIF

DECLARE "kernel32",GetTickCount(),int
DEF win:window
DEF scene,camera,light,lastframetime,timesincelastframe,shape,yaxispivot,run:INT
DEF wrap[13],mult,angle:FLOAT
DEF ox,oy,oz,dx,dy,dz,ux,uy,uz,ou,ov,su,sv,bbox[6],xmin,xmax,ymin,ymax,zmin,zmax:FLOAT
DEF mode,wraptype,axis:STRING
DEF oldmousex,oldmousey,mousex,mousey,error:INT
DEF button1x,button2x,button3x,wrapbuttonsy,axisbuttonsy,parameterbuttonsy:INT
DEF buttonwidth,buttonheight,halfbuttonwidth:INT
DEF saveobjectbuttony,saveobjectbuttonx,showsavedOKtext:INT
DEF objectfilename,texturefilename:STRING
saveobjectbuttony=420:saveobjectbuttonx=450
button1x=300:button2x=400:button3x=500:buttonwidth=80:halfbuttonwidth=buttonwidth/2
buttonheight=20:wrapbuttonsy=5:axisbuttonsy=wrapbuttonsy+5+buttonheight:parameterbuttonsy=wrapbuttonsy+10+2*buttonheight
ox=0:oy=0:oz=0:dx=0:dy=0:dz=1:ux=0:uy=1:uz=0:ou=0:ov=0:su=1:sv=1
oldmousex=-1
'**********************************************************************************
'Amend lines below to load your object and texture
'N.B. Texture must be an 8,24 or 32 bit bitmap.A size of 256x256 pixels recommended
objectfilename=GETSTARTPATH+"saill.x"
texturefilename=GETSTARTPATH+"refmap.bmp"
'**********************************************************************************
'open a window
WINDOW win,0,0,640,480,@NOCAPTION|@NOAUTODRAW,0,"Jolly Wrapper",mainwindow
error=CREATE3DSCREEN(win,640,480)
   'error=1
IF error<>0
  'Cannot open windowed Direct3D screen.Try opening it fullscreen.
  error=CREATE3DSCREEN(win,640,480,16)
  IF error<>0
   MESSAGEBOX win, "Could not create Direct3D screen","Error"
   CLOSEWINDOW win
   END
  ENDIF
ENDIF

D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEGOURAUD

DRAWMODE win,@TRANSPARENT

'The parent scene frame
scene = D3DSCENE(win)
D3DCOMMAND scene,@SETSCENEBACKCOLOR,.2,.2,1

'Create the camera
camera = D3DCAMERA(scene)
D3DCOMMAND camera,@SETORIENTATION,scene,0,0,1,0,1,0

'Create and orient a light source
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1.2,1.2,1.2)
D3DCOMMAND light,@SETORIENTATION,scene,-1,-1,1, -1,1,1

'Create dummy object to use for rotating shape around y axis
yaxispivot=D3DSHAPE(scene,@SHAPECUSTOM)

loadshapeandtexture

lastframetime=GetTickCount()-1
run=1

'process messages until somebody closes us
WAITUNTIL run=0

'delete all the frames
D3DDELETE light
D3DDELETE camera
D3DDELETE shape
D3DDELETE yaxispivot
D3DDELETE scene
SETCURSOR win,@CSCUSTOM,0
closewindow win
end


SUB mainwindow
SELECT @class
   CASE @IDCHAR
      IF (@CODE = ASC("Q")) | (@CODE = ASC("q")) THEN run = 0
   CASE @IDCREATE
      centerwindow win
   CASE @IDCLOSEWINDOW
      run=0
    CASE @IDLBUTTONUP
        oldmousex=-1
    CASE @IDLBUTTONDN
        showsavedOKtext=0
        mousex=@MOUSEX:mousey=@MOUSEY
        IF mousey<parameterbuttonsy+buttonheight
          oldmousex=-1
          IF mousex>button1x THEN checkforclickontopbuttons
        ELSE
          IF mousey>saveobjectbuttony
            oldmousex=-1
            IF mousey<saveobjectbuttony+buttonheight THEN checkforclickonsavebutton
          ELSE
            oldmousex=mousex:oldmousey=mousey
          ENDIF
        ENDIF
    CASE @IDMOUSEMOVE
        mousex=@MOUSEX:mousey=@MOUSEY
        IF GETKEYSTATE(0x01) & GETKEYSTATE(0x01)
         IF oldmousex<>-1
          IF mousey>parameterbuttonsy+buttonheight
            IF mode="scale"
              su=su-(mousex-oldmousex)/500
              sv=sv-(mousey-oldmousey)/500
            ENDIF
            IF mode="origin"
              ou=ou+(mousex-oldmousex)/500
              ov=ov+(mousey-oldmousey)/500
            ENDIF
            IF mode="orientation"
              angle=angle+(mousex-oldmousex)/60
              IF axis="x"
                uz=COS(angle):uy=SIN(angle)
              ENDIF
              IF axis="y"
                ux=COS(angle):uz=SIN(angle)
              ENDIF
              IF axis="z"
                uy=COS(angle):ux=SIN(angle)
              ENDIF           
            ENDIF
            oldmousex=mousex:oldmousey=mousey
            applywrap
          ENDIF
         ENDIF
        ENDIF
   CASE @IDDXUPDATE
      'find time since last frame to make things run at a constant speed
      timesincelastframe=GetTickCount()-lastframetime
      if timesincelastframe>2
        lastframetime=GetTickCount()
        mult=timesincelastframe/8
         'Rotate the object using the arrow keys
            'Up arrow
         IF(GETKEYSTATE(0x26))
            D3DCOMMAND shape,@ADDROTATION,1,0,0,.01*mult
         ENDIF
            'Down arrow
         IF(GETKEYSTATE(0x28))
            D3DCOMMAND shape,@ADDROTATION,1,0,0,-.01*mult
         ENDIF
            'Left arrow
         IF(GETKEYSTATE(0x25))
            D3DCOMMAND yaxispivot,@ADDROTATION,0,1,0,.01*mult
         ENDIF
            'Right arrow
         IF(GETKEYSTATE(0x27))
            D3DCOMMAND yaxispivot,@ADDROTATION,0,1,0,-.01*mult
         ENDIF
           'Move the camera using the W and S keys
           'W key
           IF GETKEYSTATE(0x57)
           D3DCOMMAND camera,@ADDTRANSLATION,0,0,mult*.1
           ENDIF
           'S key
           IF GETKEYSTATE(0x53)
           D3DCOMMAND camera,@ADDTRANSLATION,0,0,-mult*.1
           ENDIF   
      'render the scene to the DirectX surface
      D3DRENDER scene,camera
      'add any 2D elements after the scene is rendered.
        drawtextandbuttons
        IF showsavedOKtext=1
          FRONTPEN win,RGB(0,255,0):MOVE win,5,240:PRINT win,"Object saved"
        ENDIF
        'Show the DirectX surface
      DXFLIP win,0,0
  ENDIF
ENDSELECT
RETURN

SUB applywrap
  wrap =ox,oy,oz, dx,dy,dz, ux,uy,uz, ou,ov, su,sv
  IF wraptype="flat" THEN D3DCOMMAND shape,@CREATEWRAP,0,@WRAPFLAT,wrap
  IF wraptype="cylinder" THEN D3DCOMMAND shape,@CREATEWRAP,0,@WRAPCYLINDER,wrap
  IF wraptype="sphere" THEN D3DCOMMAND shape,@CREATEWRAP,0,@WRAPSPHERE,wrap
RETURN

SUB drawtextandbuttons
        RECT win,button1x,wrapbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button2x,wrapbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button3x,wrapbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button1x,axisbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button2x,axisbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button3x,axisbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button1x,parameterbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button2x,parameterbuttonsy,buttonwidth,buttonheight,0,0
        RECT win,button3x,parameterbuttonsy,buttonwidth,buttonheight,0,0
        FRONTPEN win,RGB(255,255,255)
      MOVE win,5,450:PRINT win,"Rotate the object with the arrow keys.Move camera with W & S keys.Q or ALT+F4 to exit"
        MOVE win,5,430:PRINT win,"Click and drag to alter ",mode
        MOVE win,5,7:PRINT win,"Click to select wrap type"
        MOVE win,5,32:PRINT win,"Click to select texture z axis"
        MOVE win,5,56:PRINT win,"Click to select parameter to alter with mouse"
        IF mode="origin"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,320,56:PRINT win,"origin"
        IF mode="scale"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,420,56:PRINT win,"scale"
        IF mode="orientation"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,505,56:PRINT win,"orientation"

        IF axis="x"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,335,32:PRINT win,"x"
        IF axis="y"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,435,32:PRINT win,"y"
        IF axis="z"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,535,32:PRINT win,"z"

        IF wraptype="flat"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,325,7:PRINT win,"Flat"
        IF wraptype="cylinder"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,415,7:PRINT win,"Cylinder"
        IF wraptype="sphere"
           FRONTPEN win,RGB(255,0,0)
        ELSE
           FRONTPEN win,RGB(255,255,255)
        ENDIF
        MOVE win,520,7:PRINT win,"Sphere"
        FRONTPEN win,RGB(255,255,255)
        RECT win,saveobjectbuttonx,saveobjectbuttony,buttonwidth,buttonheight,0,0
        MOVE win,450,saveobjectbuttony+2:PRINT win,"Save object"
RETURN

SUB checkforclickontopbuttons
       IF mousey>parameterbuttonsy & mousey<parameterbuttonsy+buttonheight
           IF ABS(mousex-(button1x+halfbuttonwidth))<halfbuttonwidth
             mode="origin"
           ENDIF
           IF ABS(mousex-(button2x+halfbuttonwidth))<halfbuttonwidth
             mode="scale"
           ENDIF
           IF ABS(mousex-(button3x+halfbuttonwidth))<halfbuttonwidth
             mode="orientation"
           ENDIF
           oldmousex=-1
        ENDIF

        IF mousey>axisbuttonsy & mousey<axisbuttonsy+buttonheight
           IF ABS(mousex-(button1x+halfbuttonwidth))<halfbuttonwidth
             axis="x":angle=0:dx=1:dy=0:dz=0:ux=0:uy=0:uz=1
             applywrap
           ENDIF
           IF ABS(mousex-(button2x+halfbuttonwidth))<halfbuttonwidth
             axis="y":angle=0:dx=0:dy=1:dz=0:ux=1:uy=0:uz=0
             applywrap
           ENDIF
           IF ABS(mousex-(button3x+halfbuttonwidth))<halfbuttonwidth
             axis="z":angle=0:dx=0:dy=0:dz=1:ux=0:uy=1:uz=0
             applywrap
           ENDIF
        ENDIF

        IF mousey>wrapbuttonsy & mousey<wrapbuttonsy+buttonheight
           IF ABS(mousex-(button1x+halfbuttonwidth))<halfbuttonwidth
             wraptype="flat":angle=0:axis="z"
             dx=0:dy=0:dz=1:ux=0:uy=1:uz=0:su=1:sv=1:ou=0:ov=0
             IF xmax<>xmin
               su=1/(xmax-xmin)
               ou=xmin*su
             ENDIF
             IF ymax<>ymin
               sv=1/(ymin-ymax)
               ov=ymax*sv
             ENDIF
             applywrap
           ENDIF
           IF ABS(mousex-(button2x+halfbuttonwidth))<halfbuttonwidth
             wraptype="cylinder":angle=0:axis="y"
             ou=0:su=1:dx=0:dy=1:dz=0:ux=1:uy=0:uz=0:sv=1:ov=0
             IF ymax<>ymin
               sv=1/(ymin-ymax)
               ov=ymax*sv
             ENDIF
             applywrap
           ENDIF
           IF ABS(mousex-(button3x+halfbuttonwidth))<halfbuttonwidth
             wraptype="sphere":angle=0:axis="y"
             dx=0:dy=1:dz=0:ux=0:uy=0:uz=1:ou=0:ov=0:su=1:sv=1
             applywrap
           ENDIF
        ENDIF
RETURN

SUB loadshapeandtexture
    shape=D3DSHAPE(yaxispivot,@SHAPECUSTOM)
    D3DCOMMAND shape,@LOADSHAPE,objectfilename,0
    ox=0:oy=0:oz=0:dx=0:dy=0:dz=1:ux=0:uy=1:uz=0:ou=0:ov=0:su=1:sv=1
    'Find bounding box
    D3DCOMMAND shape,@GETBOX,bbox
    xmin=bbox[0]:ymin=bbox[1]:zmin=bbox[2]:xmax=bbox[3]:ymax=bbox[4]:zmax=bbox[5]
    IF xmax<>xmin
      su=1/(xmax-xmin)
      ou=xmin*su
    ENDIF
    IF ymax<>ymin
      sv=1/(ymin-ymax)
      ov=ymax*sv
    ENDIF
    mode="scale":axis="z":wraptype="flat"
    wrap =ox,oy,oz, dx,dy,dz, ux,uy,uz, ou,ov, su,sv
    D3DCOMMAND shape,@CREATEWRAP,0,@WRAPFLAT,wrap
    D3DCOMMAND shape,@LOADTEXTURE,texturefilename
    'Set camera position so shapes of different sizes appear a similar size on screen
    D3DCOMMAND camera,@SETPOSITION,scene,0,0,-5*(xmax+ymax+zmax-xmin-ymin-zmin)/3
RETURN

SUB checkforclickonsavebutton
  IF ABS(mousex-(saveobjectbuttonx+halfbuttonwidth))<halfbuttonwidth
    'Save object button clicked
    D3DCOMMAND shape,@SAVESHAPE,LEFT$(objectfilename,INSTR(objectfilename,".x")-1)+"-textured.x",@FORMATTEXT,@SAVEALL
    showsavedOKtext=1
  ENDIF
RETURN

[GWS]

Couple of graphic files missing for the demo .. 

Graham

[Steven Picard]

It's a shame that Jolly Rogers and some of the other guys aren't around anymore.  I thought Boris contributed some really neat stuff like his Life with the optimized assembly (IBPro).

[pistol350]

Sorry Graham!
I attached a zip file with a mesh a found somewhere ? and a bimap file that i also found somewhere 

PS : Just a tips for those who don't know.
When people like me post so long codes  , all you have to do is use "Ctrl" button + mouse left click and the all code will be selected.

Regards!
peter .B