Mates, Jolly Roger is great.
Give this a try!
'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