3D animation -Morphing experiment by Jolly Roger

[pistol350]

Mates, Jolly Roger is great.
Give this a try!

Code Select Expand


'Morphing experiment
'Takes data for two Jolly Modeller objects with the same number of layers
'and produces a sequence of intermediate object which when shown in series
'generates a morphing 3D object
'Jolly Roger May 2004
AUTODEFINE "OFF"
IF GETDXVERSION < 7
   MESSAGEBOX 0,"This program requires" + chr$(13) + "DirectX 7.0 or greater","Error"
   END
ENDIF

DECLARE "kernel32",GetTickCount(),INT


DECLARE morph_object(numberofsections:INT)
DEF numberoflayers,lcn[100],r[8],g[8],b[8],t[8],n:INT
DEF d[500]:FLOAT

DEF win:WINDOW
DEF error,run:INT
DEF mult,angle:FLOAT
DEF scene,camera,light,lastframetime,timesincelastframe,yaxispivot,l,direction:INT
DEF layer,colour,xcentre,zcentre,starty[100],xradius,zradius:INT
DEF startred[100],startgreen[100],startblue[100],starttrans[100]:FLOAT
DEF red[100],green[100],blue[100],trans[100],y[100],dy[100]:FLOAT
DEF dred[100],dgreen[100],dblue[100],dtrans[100]:FLOAT
DEF vertexnumber,numberofframes,frame,starttime,timetaken,morphframespersecond:INT
DEF pos[3],orient[6]:FLOAT
DEF startsideleft[100],startsideright[100],startfrontleft[100],startfrontright[100]:INT
DEF dsideleft[100],dsideright[100],dfrontleft[100],dfrontright[100]:FLOAT

'**********************
'Alter the variables in the line below to alter the morph speed and smoothness
numberofframes=10:morphframespersecond=10
'**********************

DEF shape[numberofframes]:INT
direction=1
'Open a window
WINDOW win,0,0,640,480,@CAPTION|@NOAUTODRAW,0,"Morph experiment",mainwindow

'Create a 3D screen for object preview
error=CREATE3DSCREEN(win,640,480)
IF error<>0
   'Couldn't open windowed Direct3D screen.Try opening 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
FRONTPEN win,RGB(255,255,255)
BACKPEN win,0
DRAWMODE win,@TRANSPARENT

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

'Create and position the camera
camera = D3DCAMERA(scene)
D3DCOMMAND camera,@SETPOSITION,scene,0,0,-600
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 for y axis pivot
yaxispivot=D3DSHAPE(scene,@SHAPECUSTOM)

'Read start object data
'Set all layer colour numbers to zero before read data
FOR l=0 TO 99:lcn[l]=0:NEXT l
readfirstframedata
FOR layer=0 TO numberoflayers-1
  starty[layer]=d[layer*5]:startfrontleft[layer]=d[layer*5+1]:startfrontright[layer]=d[layer*5+2]
  startsideleft[layer]=d[layer*5+3]:startsideright[layer]=d[layer*5+4]
  colour=lcn[layer]
  startred[layer]=r[colour]:startgreen[layer]=g[colour]:startblue[layer]=b[colour]
  starttrans[layer]=t[colour]
NEXT layer
'Read target object data and fill the arrays which hold the
'data used to change the object each frame
'Set all layer colour numbers to zero before read data
FOR l=0 TO 99:lcn[l]=0:NEXT l
readlastframedata
FOR layer=0 TO numberoflayers-1
  dy[layer]=(d[layer*5]-starty[layer])/(numberofframes-1)
  colour=lcn[layer]
  dred[layer]=(r[colour]-startred[layer])/(numberofframes-1)
  dgreen[layer]=(g[colour]-startgreen[layer])/(numberofframes-1)
  dblue[layer]=(b[colour]-startblue[layer])/(numberofframes-1)
  dtrans[layer]=(t[colour]-starttrans[layer])/(numberofframes-1)
  dfrontleft[layer]=(d[layer*5+1]-startfrontleft[layer])/(numberofframes-1)
  dfrontright[layer]=(d[layer*5+2]-startfrontright[layer])/(numberofframes-1)
  dsideleft[layer]=(d[layer*5+3]-startsideleft[layer])/(numberofframes-1)
  dsideright[layer]=(d[layer*5+4]-startsideright[layer])/(numberofframes-1)
NEXT layer
'Copy initial values to arrays used to generate object
FOR layer=0 TO numberoflayers-1
  d[layer*5]=starty[layer]:red[layer]=startred[layer]:green[layer]=startgreen[layer]
  blue[layer]=startblue[layer]:trans[layer]=starttrans[layer]
  d[layer*5+1]=startfrontleft[layer]:d[layer*5+2]=startfrontright[layer]
  d[layer*5+3]=startsideleft[layer]:d[layer*5+4]=startsideright[layer]
NEXT layer
'Generate object for each frame of morph
FOR frame=0 TO numberofframes-1
  'Create object
  shape[frame]=morph_object(16)
  IF frame<>0
    'Move object out of the way
    D3DCOMMAND shape[frame],@SETPOSITION,scene,0,0,10000
  ENDIF
  'Make all frame objects children of yaxispivot
  D3DCOMMAND yaxispivot,@ADDCHILD,shape[frame]
  'Alter data in arrays to that for next frame
  FOR layer=0 TO numberoflayers-1
    d[layer*5]=d[layer*5]+dy[layer]:red[layer]=red[layer]+dred[layer]:green[layer]=green[layer]+dgreen[layer]
    blue[layer]=blue[layer]+dblue[layer]:trans[layer]=trans[layer]+dtrans[layer]
    d[layer*5+1]=d[layer*5+1]+dfrontleft[layer]
    d[layer*5+2]=d[layer*5+2]+dfrontright[layer]
    d[layer*5+3]=d[layer*5+3]+dsideleft[layer]
    d[layer*5+4]=d[layer*5+4]+dsideright[layer]
  NEXT layer
NEXT frame

frame=0

STARTTIMER win,1000/morphframespersecond
starttime=GetTickCount()
lastframetime=GetTickCount()-1
run=1
'Process messages until somebody closes us
WAITUNTIL run=0

'Delete all the frames
D3DDELETE light
D3DDELETE camera
FOR frame=0 TO numberofframes-1
  D3DDELETE shape[frame]
NEXT frame
D3DDELETE yaxispivot
D3DDELETE scene
DELETEFILE(GETSTARTPATH+"temporary.x")
'Hide cursor.Avoids possible cursor distortion
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 @IDTIMER
      IF GETKEYSTATE(32) & GETKEYSTATE(32)
        'Spacebar is pressed.Change to next morph object
        'Find position and orientation of current frame object
        D3DCOMMAND shape[frame],@GETPOSITION,scene,pos
        D3DCOMMAND shape[frame],@GETORIENTATION,scene,orient
        'Move current frame object out of the way
        D3DCOMMAND shape[frame],@SETPOSITION,scene,0,0,10000
        frame=frame+direction
        IF frame=numberofframes
         frame=numberofframes-2:direction=-direction
        ENDIF
        IF frame<0
         frame=1:direction=-direction
        ENDIF
        'Move object for next frame into view
        D3DCOMMAND shape[frame],@SETPOSITION,scene,0,0,0
        'Set it's position and orientation to object it is replacing
        D3DCOMMAND shape[frame],@SETPOSITION,scene,pos[0],pos[1],pos[2]
        D3DCOMMAND shape[frame],@SETORIENTATION,scene,orient[0],orient[1],orient[2],orient[3],orient[4],orient[5]
      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/800
      'Move the object using the arrow keys
        'Up arrow
      IF(GETKEYSTATE(0x26))
         D3DCOMMAND shape[frame],@ADDROTATION,1,0,0,-mult
      ENDIF
        'Down arrow
      IF(GETKEYSTATE(0x28))
         D3DCOMMAND shape[frame],@ADDROTATION,1,0,0,mult
      ENDIF
        'Left arrow
      IF(GETKEYSTATE(0x25))
         D3DCOMMAND yaxispivot,@ADDROTATION,0,1,0,mult
      ENDIF
        'Right arrow
      IF(GETKEYSTATE(0x27))
         D3DCOMMAND yaxispivot,@ADDROTATION,0,1,0,-mult
      ENDIF
      'Render the scene to the DirectX surface
      D3DRENDER scene,camera
      'Add any 2D elements after the scene is rendered.
      MOVE win,10,10
      PRINT win,"Rotate the object with the arrow keys.Press the space bar to enable morphing.Press Q to exit"
      'Show the DirectX surface   
      DXFLIP win,0,0
      ENDIF
  ENDSELECT
RETURN

SUB morph_object(numberofsections)
DEF objecthandle1:INT
IF numberofsections>2
  DEF objecthandle,colour:INT
  DEF facedata[100],section,vertex[10000],facenumber,xcentre,zcentre,xradius,zradius:INT
  DEF angle:FLOAT
  DEF layer,vertexnumber,normal:INT
  objecthandle=D3DSHAPE(scene,@SHAPECUSTOM)
  normal=D3DCOMMAND (objecthandle,@ADDNORMAL,0,-1,0)
  'Create vertices
  FOR layer=0 TO numberoflayers-1
   xcentre=-160+(d[layer*5+1]+d[layer*5+2])/2
   zcentre=-160+(d[layer*5+4]+d[layer*5+3])/2
   xradius=(d[layer*5+2]-d[layer*5+1])/2
   zradius=(d[layer*5+4]-d[layer*5+3])/2 
   FOR section=0 TO numberofsections-1
     angle=6.283*section/numberofsections
     vertexnumber=layer*numberofsections+section
     vertex[vertexnumber]=D3DCOMMAND (objecthandle,@ADDVERTEX,xcentre+xradius*SIN(angle),d[layer*5],zcentre+zradius*COS(angle))
    NEXT section
  NEXT layer
  'Create side faces
  facedata[0]=4:facedata[9]=0
  facedata[2]=normal:facedata[4]=normal:facedata[6]=normal:facedata[8]=normal
  FOR layer=1 TO numberoflayers-1
   FOR section=0 TO numberofsections-1
     facedata[7]=vertex[(layer-1)*numberofsections+section]
     facedata[5]=vertex[layer*numberofsections+section]
     IF section<>numberofsections-1
       facedata[3]=vertex[layer*numberofsections+section+1]
       facedata[1]=vertex[(layer-1)*numberofsections+section+1]
     ELSE
       facedata[3]=vertex[layer*numberofsections]
       facedata[1]=vertex[(layer-1)*numberofsections]
     ENDIF
     D3DCOMMAND objecthandle,@ADDFACES,facedata
      'Colour face
      D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,red[layer-1]/255,green[layer-1]/255,blue[layer-1]/255,1-trans[layer-1]/255
      facenumber=facenumber+1
   NEXT section
   D3DCOMMAND objecthandle,@CUSTOMINIT
  NEXT layer
  'Create top face
  facedata[0]=numberofsections:facedata[2*numberofsections+1]=0
  FOR section=0 TO numberofsections-1
    facedata[2*section+1]=vertex[(numberoflayers-1)*numberofsections+section]
    facedata[2*section+2]=normal
  NEXT section
  D3DCOMMAND objecthandle,@ADDFACES,facedata
  'Colour face
  D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,red[numberoflayers-1]/255,green[numberoflayers-1]/255,blue[numberoflayers-1]/255,1-trans[numberoflayers-1]/255
  facenumber=facenumber+1
  D3DCOMMAND objecthandle,@CUSTOMINIT
  'Create bottom face
  facedata[0]=numberofsections:facedata[2*numberofsections+1]=0
  FOR section=numberofsections-1 TO 0 STEP -1
    facedata[2*(numberofsections-1-section)+1]=vertex[section]
    facedata[2*(numberofsections-1-section)+2]=normal
  NEXT section
  D3DCOMMAND objecthandle,@ADDFACES,facedata
  'Colour face
  colour=lcn[0]
  D3DCOMMAND objecthandle,@SETFACECOLOR,facenumber,red[0]/255,green[0]/255,blue[0]/255,1-trans[0]/255
  facenumber=facenumber+1
  D3DCOMMAND objecthandle,@CUSTOMINIT
  'Save object without normals,delete it then reload it
  'Quick and dirty way to get DirectX to calculate normals
  D3DCOMMAND objecthandle,@SAVESHAPE,GETSTARTPATH+"temporary.x",@FORMATTEXT,@SAVEMATERIALS
  D3DDELETE objecthandle
  objecthandle1=D3DSHAPE(scene,@SHAPECUSTOM)
  D3DCOMMAND objecthandle1,@LOADSHAPE,GETSTARTPATH+"temporary.x",0
ENDIF
RETURN objecthandle1

'Data subroutines for start and end objects
SUB readfirstframedata
'Tube
numberoflayers=10
d=-160,141,179,157,163,-145,142,178,148,172,-130,142,178,145,175,-50,142,178,143,179
d[20]=-46,146,174,147,175,-43,152,168,153,169,-42,149,171,150,172,-21,150,168,152,170
d[40]=-22,154,166,155,167,-23,154,166,155,167
lcn=6,6,6,6,6,5,5,5,5,5
r=200,255,0,0,255,255,0,150
g=200,0,255,0,255,141,255,100
b=200,0,0,255,0,255,255,0
t=0,0,0,0,0,0,0,0
RETURN

SUB readlastframedata
'Cone
numberoflayers=10
d=-147,127,195,130,200,-160,90,230,91,231,-135,125,195,125,195,-108,132,188,132,188
d[20]=-81,139,181,139,181,-63,142,178,142,178,-47,145,175,145,175,-32,148,172,148,172
d[40]=-19,150,170,150,170,-7,152,168,152,168
lcn=6,6,0,0,0,6,6,6,6,6
r=255,255,0,0,255,255,255,150
g=255,0,255,0,255,141,208,100
b=255,0,0,255,0,255,113,0
t=0,0,0,0,0,0,0,0
RETURN