Vase Maker

[RG]

This is a demo program I wrote using the 3D pack for Ibasic Pro. It was published on the old Pyxia site but was lost to history when that site closed. Without too much difficulty, I translated it to Ebasic and the new 3D commands (biggest problem was lack of documentation even with the Aurora 3D help). I still have one problem which is the error message I get from windows when closing it after creating a half dozen vases or more. Doesn't happen with only a few so I 'm guessing i have some memory leak, memory overlap, or I'm not closing something down properly.  Other than that, it shows how fast Ebasic can be in creating a large mesh in real time.

Rich

[Edited 6/7/2008: code removed as revised code in subsequent response below]

[barry]

Thanks.

It seems to work fine till I terminate it.  At that point it crashes.  I tried it several times and it crashed each time regardless of what changes I made in the bezier and even if I made no changes.

Barry

[RG]

Yes, that's the same problem I was talking about. Something isn't quite right but haven't been able to figure out what.

Rich

[RG]

Tried one thing that stops the crashing when ending program:

repalced: screen.CreateWindowed(4,262,300,280,@nocaption,"3D Preview",winmain,TRUE)

with: screen.CreateWindowed(4,262,300,280,@nocaption,"3D Preview",null,true)

but the 3D screen is now a separate item no longer a child to the main window.

Rich

[Ionic Wind Support Team]

You're missing the CloseScreen call.

...
screen.CloseScreen()
CLOSEWINDOW winmain

Otherwise closing the main window would remove the API window from the DirectX surface, since a child window is closed by its parent. DirectX usually doesn't react too well when its display device is yanked away.

Normally you wouldn't need to do that, however since you are using a parent window it is necessary.

Paul.

[Ionic Wind Support Team]

Of course that is only part of the problem.   The code is corrupting memory somewhere as well...still looking.

[RG]

Paul,

Thanks 

I added the extra code which helps some of the time. I have also found if I keep the dots in the random shape subroutine greater than zero (by adding +1 to the x-values), I can make multiple shapes without a crash on closing. If I make a shape by dragging a dot to the left so the bezier curve crosses the centerline, it crashes on closing. So may have something to do with negative values or mesh having identical values at some point. Using the Ibasic Pro 3D pak, I haven't had to adjust for this so it may not really mean anything.

Rich.

[RG]

Figured out what caused the crash on closing. There was one place where I was adding the shape as a child to the scene a second time, even though I was reallocating the already existing mesh. I added a condition so that the shape is added as a child only the first time the shape is created. Another place that caused the crash was where I was removing the texture. There's a command to add a texture but not one to remove it (best I can tell). The way I had it coded also ended up adding the shape as a child a second time. Corrected that and now it seems to close fine all the time. The crash was very sporadic so difficult to track down.

The other change from what I originally posted is I now have used matrices to allow twisting and curving the vase. Took forever to figure this out but a hint from Paul (in a response to another post) got me going on the right track. Used the identify matrice to start, then translated it to the vertice location, then applied two different rotations. I then grabbed the x,y,z positions from the transformed matrice:

  def vmat:matrix4
   MatrixIdentity(vmat)
   MatrixTranslation(vmat,rx,ry,rz)
   MatrixRotation(vmat,0,0,3.14159/180*flt(curve)*((meshry[height].y-meshry[0].y)/heightmax))
   MatrixRotation(vmat,0,3.14159/180*flt(twist)*((meshry[height].y-meshry[0].y)/heightmax),0)
   #<VERTEX1TEXTURE>pVB[index+i].position.x=vmat.m[0,3]
   #<VERTEX1TEXTURE>pVB[index+i].position.y=vmat.m[1,3]
   #<VERTEX1TEXTURE>pVB[index+i].position.z=vmat.m[2,3]

By the way, to get this to compile, you will have to modifty the ebx3d.incc file to remove the dx prefix from the 3 matrix commands:

dxMatrixIdentity --> MatrixIdentity
dxMatrixTranslation --> MatrixTranslation
dxMatrixRotation --> MatrixRotation

[Edit: No longer need to make these changes to the .incc file if you have downloaded the most recent version.]

Here's the updated program:

Code Select Expand



'Vase Maker
'by Rich Schafermeyer
'updated 6/7/2008: added ability to twist and curve the mesh in real-time

const DIK_UP = 0xC8:'UpArrow on arrow keypad
const DIK_DOWN = 0xD0:'DownArrow on arrow keypad
const DIK_LEFT = 0xCB:'LeftArrow on arrow keypad
const DIK_RIGHT = 0xCD:'RightArrow on arrow keypad
const DIK_PRIOR = 0xC9:'PgUp on arrow keypad
const DIK_NEXT = 0xD1:'PgDn on arrow keypad

type rgbacolor
def r:float
def g:float
def b:float
def a:float
endtype

type ry
def r:float
def y:float
def h:float
endtype

def winmain,win:window 
def x0,y0,bezdotnum,bezsegments,ringsegments,twist,curve,bxy[10]:int 
def dotstate,dotnumber,rdotnumber,winT,winL,winW,winH:int 
def ringradius,profileheight,profileheightindex:float 
   
def bottomcenter,topcenter:float
def run,bitmap:int 
def filename$,filenametex$,filter$:string 
def hastexture:int
def shapemade:int

def dirx,diry,dirz,lightintensity:float
def screen:C3DScreen
def camera1:C3DCamera
def scene:C3DObject
def shape:C3DMesh
def light,light1:C3DLight
def material:d3dmaterial
def diffusecontrol,emissivecontrol,lightambientcontrol,lightdiffusecontrol:int
def diffusecolor,emissivecolor,lightambientcolor,lightdiffusecolor:rgbacolor
def numVertices,numIndices:int
def numberendfaces,bottomface,topface,vindex,findex:int
def indexv,indexf:int
def movecameray:float
def pVB,pIB:pointer
def meshry[34]:ry
def vmat:matrix4

run = 1

'set everything up to start
gosub initvariables
gosub setupwindows
gosub addcontrols
gosub addcamera
gosub addlight
gosub addscene
gosub changelightcolor
gosub makerandomshape
gosub addmaterial
gosub renderscene 
do
'use these commands to rotate object
IF keydown(DIK_UP) then changedir(dirx,diry,dirz,1,0,0)
IF keydown(DIK_DOWN) then changedir(dirx,diry,dirz,-1,0,0)
if keydown(DIK_RIGHT) then changedir(dirx,diry,dirz,0,-1,0)
if keydown(DIK_LEFT) then changedir(dirx,diry,dirz,0,1,0)
IF keydown(DIK_PRIOR) then changedir(dirx,diry,dirz,0,0,1)
IF keydown(DIK_NEXT) then changedir(dirx,diry,dirz,0,0,-1)
shape.Rotate(dirx,diry,dirz)
gosub renderscene
until (keydown(1)|run=0)
scene.Free()
screen.CloseScreen()
closewindow winmain
end

sub main 
select @class 
case @idclosewindow 
run = 0 
case @idcontrol 
'if number of bezier dots changed 
if (@controlid >= 3) & (@controlid <= 5)   
    bezdotnum=@controlid:setfocus winmain
gosub drawoutline 
endif 
'if top or bottom check box changed 
if (@controlid >= 6) & (@controlid <= 7)   
setfocus winmain
topface=getstate(winmain,6)
bottomface=getstate(winmain,7)
gosub drawoutline 
endif   
case @idhscroll   
select @code 
case @sbthumbpos:case @sbthumbtrack 
setscrollpos winmain,@controlid,@qual 
case @sblineleft   
setscrollpos winmain,@controlid,(getscrollpos(winmain,@controlid)-1)
case @sblineright   
setscrollpos winmain,@controlid,(getscrollpos(winmain,@controlid)+1) 
case @sbpageleft   
setscrollpos winmain,@controlid,(getscrollpos(winmain,@controlid)-5) 
case @sbpageright   
setscrollpos winmain,@controlid,(getscrollpos(winmain,@controlid)+5) 
endselect
bezsegments = getscrollpos(winmain,1) 
setcontroltext winmain,2,str$(bezsegments) 
ringsegments = getscrollpos(winmain,8) 
setcontroltext winmain,9,str$(ringsegments) 
twist= getscrollpos(winmain,10)-360
setcontroltext winmain,11,str$(twist)
curve= getscrollpos(winmain,12)-180
setcontroltext winmain,13,str$(curve)
gosub drawoutline 
case @idchar 
if (@code = asc("Q")) | (@code = asc("q")) then run = 0 
gosub replaceobject
case @idlbuttondn 
gosub checkfordot 
case @idrbuttondn 
bxy[rdotnumber - 1]=@mousex:bxy[rdotnumber]=@mousey   
gosub drawoutline 
case @idlbuttonup 
dotnumber = 0 
case @idmousemove 
if dotnumber > 0 
bxy[dotnumber - 1]=@mousex:bxy[dotnumber]=@mousey 
gosub drawoutline 
endif   
case @idmenupick 
select @menunum 
case 1 
gosub makerandomshape 
case 2 
gosub showabout 
case 3 
run = 0 
case 4 
gosub saveobject
case 21:'add texture 
hastexture=0
gosub addtexture 
case 22:'remove texture 
hastexture=0
filenametex$=""
shape.Free()
shapemade=2
gosub addobject
gosub addmaterial
gosub renderscene
case 23:'reset twist, curve and camera
twist=0
setscrollpos winmain,10,twist+360 
setcontroltext winmain,11,str$(twist)
curve=0
setscrollpos winmain,12,curve+180 
setcontroltext winmain,13,str$(curve)
changedir(0,0,0,0,0,0)
gosub drawoutline 
endselect 
endselect 
return 
endsub

sub drawoutline 
def scw,sch:int 
getscreensize scw,sch 
rect winmain,0,0,scw,sch,rgb(255,255,255),rgb(255,255,255) 
frontpen winmain,rgb(200,200,200) 
'draw grey guide lines 
move winmain,x0,bxy[9] 
lineto winmain,x0,bxy[1] 
frontpen winmain,rgb(0,0,0)
if bottomface=1 
lineto winmain,bxy[0],bxy[1] 
lineto winmain,2*x0-bxy[0],bxy[1] 
endif 
'draw right side 
bezier(bezdotnum,bezsegments,bxy,1) 
'invert array to draw left side 
bxy[0]=(2*x0-bxy[0]) 
bxy[2]=(2*x0-bxy[2]) 
bxy[4]=(2*x0-bxy[4]) 
bxy[6]=(2*x0-bxy[6]) 
bxy[8]=(2*x0-bxy[8]) 
bezier(bezdotnum,bezsegments,bxy,0) 
'restore array 
bxy[0]=(2*x0-bxy[0]) 
bxy[2]=(2*x0-bxy[2]) 
bxy[4]=(2*x0-bxy[4]) 
bxy[6]=(2*x0-bxy[6]) 
bxy[8]=(2*x0-bxy[8])
deltaH=bxy[9]-bxy[1]
if topface=1 
move winmain,bxy[8],bxy[9]
lineto winmain,bxy[8],bxy[9] 
lineto winmain,2*x0-bxy[8],bxy[9] 
endif
gosub addobject
return 
endsub

sub makerandomshape 
bxy[0]=x0+rnd(200),y0+150,x0+rnd(200),y0+50+rnd(100),x0+rnd(200),y0-50+rnd(100),x0+rnd(200),y0-150+rnd(100),x0+rnd(200),y0-150 
gosub drawoutline 
return 
endsub

sub bezier(bezdotnum:int,bezsegments:int,bxy[10]:int,drawdots:int)
'bezier curve: bezdotnum = number of dots that make curve (2-5), bezsegments = number of straight lines that make up curve, 
'bxy: array of x-y pairs that define control dot location   
def incr,i,i1,i2,i3,i4,x,y,reductionfactor:float 
def j,k:int   
incr=1/flt(bezsegments)
i=0
k=0
reductionfactor=0.2
move winmain,bxy[0],bxy[1] 
ringradius=bxy[0]-x0 
profileheight=0
profileheightindex=bxy[9]+0.5*(bxy[0]-bxy[9]) 
'gosub makeringvertices 
setlinestyle winmain,@lssolid,3 
for j = 0 to bezsegments 
i1 = 1 - i : i2 = (1 - i) * i1 : i3 = (1 - i) * i2 : i4 = (1 - i) * i3 
select bezdotnum 
case 2 
x=bxy[0]*i1+bxy[8]*i 
y=bxy[1]*i1+bxy[9]*i 
case 3 
x=bxy[0]*i2+bxy[4]*2*i*i1+bxy[8]*i*i 
y=bxy[1]*i2+bxy[5]*2*i*i1+bxy[9]*i*i 
case 4  
x=bxy[0]*i3+bxy[2]*3*i*i2+bxy[6]*3*i*i*i1+bxy[8]*i^3 
y=bxy[1]*i3+bxy[3]*3*i*i2+bxy[7]*3*i*i*i1+bxy[9]*i^3 
case 5 
x=bxy[0]*i4+bxy[2]*4*i*i3+bxy[4]*6*i*i*i2 
x=x+bxy[6]*4*i^3*i1+bxy[8]*i^4 
y=bxy[1]*i4+bxy[3]*4*i*i3+bxy[5]*6*i*i*i2 
y=y+bxy[7]*4*i^3*i1+bxy[9]*i^4 
endselect
'draw line segment 
if k=0 
frontpen winmain,rgb(0,0,0) 
k=1 
else 
frontpen winmain,rgb(0,200,200) 
k=0 
endif 
lineto winmain,x,y 
'capture radius and height data for object
ringradius=x-x0 
profileheight=profileheightindex-y 
meshry[j].r=reductionfactor*ringradius
meshry[j].y=reductionfactor*(y0-y)
if j=0
meshry[j].h=0
else
meshry[j].h=meshry[j-1].h
endif
i = i + incr 
next j   
'draw squares at start and end, open circles at control points 
if drawdots = 1 
rect winmain,bxy[0]-3,bxy[1]-3,6,6,rgb(255,0,0),rgb(255,0,0) 
move winmain,bxy[0]+9,bxy[1]-9:print winmain,"Bottom" 
rect winmain,bxy[8]-3,bxy[9]-3,6,6,rgb(255,0,0),rgb(255,0,0) 
move winmain,bxy[8]+9,bxy[9]-9:print winmain,"Top" 
select bezdotnum 
case 3 
circle winmain,bxy[4],bxy[5],3,rgb(255,0,0) 
case 4 
circle winmain,bxy[2],bxy[3],3,rgb(0,255,0) 
circle winmain,bxy[6],bxy[7],3,rgb(0,0,255) 
case 5 
circle winmain,bxy[2],bxy[3],3,rgb(0,255,0) 
move winmain,bxy[2]+9,bxy[3]-9:print winmain,"3" 
circle winmain,bxy[4],bxy[5],3,rgb(255,0,0) 
move winmain,bxy[4]+9,bxy[5]-9:print winmain,"2" 
circle winmain,bxy[6],bxy[7],3,rgb(0,0,255) 
move winmain,bxy[6]+9,bxy[7]-9:print winmain,"1" 
endselect
endif
return 
endsub

sub checkfordot 
def i:int 
dotnumber = 0 
for i=0 to 8 step 2 
if (@mousex > (bxy[i]-4)) & (@mousex < (bxy[i]+4)) & (@mousey > (bxy[i+1]-4)) & (@mousey < (bxy[i+1]+4))   
dotnumber = i + 1 
rdotnumber = i + 1 
endif 
next i 
return 
endsub

sub showabout 
messagebox winmain,"Vase Maker by Rich Schafermeyer 2005-2008","About",64 
return 
endsub

sub initvariables
'set center 
x0=525:y0=325
'initialize starting variables
filter$ = "JPEG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|BMP (*.bmp)|*.bmp|All Files (*.*)|*.*||" 
bxy[0]=x0-200,y0,x0-150+rnd(200),y0-200+rnd(400),x0-100+rnd(200),y0-200+rnd(400),x0+50+rnd(200),y0-200+rnd(400),x0+200,y0 
bezdotnum=5 
bezsegments=16 
rdotnumber=1 
ringsegments=4 
shapemade=0 
diffusecontrol=rgb(100,255,100)
diffusecolor=convertcolor(diffusecontrol)
emissivecontrol=rgb(75,75,75)
emissivecolor=convertcolor(emissivecontrol)
lightambientcontrol=rgb(255,255,255)
lightambientcolor=convertcolor(lightambientcontrol)
lightdiffusecontrol=rgb(255,255,255)
lightdiffusecolor=convertcolor(lightdiffusecontrol)
lightintensity=100
numberendfaces=2
bottomface=1
topface=0
vindex=0
findex=0
twist=0
curve=0
return
endsub

sub setupwindows
'make main window 
OpenWindow winmain,0,0,800,600,@minbox|@maxbox|@size|@noautodraw,0,"Vase Maker",&main   
centerwindow winmain
'add menu
BeginMenu winmain
MenuTitle "&File"
MenuItem "&New",0,1
MenuItem "&Save",0,4
MenuItem "&About",0,2
MenuItem "&Quit",0,3
EndMenu
BeginInsertMenu winmain,1
MenuTitle "&Texture"
MenuItem "Load &Texture",0,21
MenuItem "&Remove Texture",0,22
EndMenu
BeginInsertMenu winmain,2
MenuTitle "&Reset"
MenuItem "Reset Curve, Twist & Camera",0,23
EndMenu
'make 3D preview window 
screen.CreateWindowed(4,262,300,280,@nocaption,"3D Preview",winmain,TRUE)
return
endsub

sub addcontrols 
control winmain,@static,"",6,5,500,20,0x50008000,101
setcontroltext winmain,101,"Hit any key to randomize control dots. Or left-click on a dot and drag."
setcontrolcolor winmain,101,rgb(0,0,0),rgb(255,255,255)

control winmain,@static,"",6,25,500,20,0x50008000,102
setcontroltext winmain,102,"Or left-click on a dot, then right-click to move that dot to a new position."
setcontrolcolor winmain,102,rgb(0,0,0),rgb(255,255,255)

control winmain,@RadioButton,"3 Dot Bezier",6,51,120,20,0x50000009,3
control winmain,@RadioButton,"4 Dot Bezier",6,74,120,20,0x50000009,4
control winmain,@RadioButton,"5 Dot Bezier",6,97,120,20,0x50000009,5
control winmain,@CheckBox,"Show Top Face",150,51,132,20,0x50000003,6
control winmain,@CheckBox,"Show Bottom Face",150,74,152,20,0x50000003,7

control winmain,@static,"",6,135,300,20,0x50008000,103
setcontroltext winmain,103,"Set Number of Line Segments in Bezier Curve:"
setcontrolcolor winmain,103,rgb(0,0,0),rgb(255,255,255)
control winmain,@ScrollBar,"",6,160,101,16,0x50000000,1
control winmain,@Edit,"Edit1",130,159,70,20,0x50800800,2

control winmain,@static,"",6,190,300,20,0x50008000,104
setcontroltext winmain,104,"Set Number of Polygons in Cross Section:"
setcontrolcolor winmain,104,rgb(0,0,0),rgb(255,255,255)
control winmain,@ScrollBar,"",6,215,101,16,0x50000000,8
control winmain,@Edit,"Edit2",130,214,70,20,0x50800800,9

control winmain,@static,"",355,50,300,20,0x50008000,106
setcontroltext winmain,106,"Set Twist:"
setcontrolcolor winmain,106,rgb(0,0,0),rgb(255,255,255)
control winmain,@ScrollBar,"",355,75,101,16,0x50000000,10
control winmain,@Edit,"Edit2",465,74,70,20,0x50800800,11

control winmain,@static,"",575,50,300,20,0x50008000,107
setcontroltext winmain,107,"Set Curve:"
setcontrolcolor winmain,107,rgb(0,0,0),rgb(255,255,255)
control winmain,@ScrollBar,"",575,75,101,16,0x50000000,12
control winmain,@Edit,"Edit2",685,74,70,20,0x50800800,13

control winmain,@static,"",0,245,300,20,0x50008000,105
setcontroltext winmain,105," Use arrow keys to rotate object in 3D Preview"
setcontrolcolor winmain,105,rgb(0,0,0),rgb(255,255,255)

'control winmain,@Button,"Reset Camera",310,520,120,20,0x50000000,10

setcontrolcolor winmain,3,0,rgb(255,255,255) 
setcontrolcolor winmain,4,0,rgb(255,255,255) 
setcontrolcolor winmain,5,0,rgb(255,255,255) 
setcontrolcolor winmain,6,0,rgb(255,255,255) 
setcontrolcolor winmain,7,0,rgb(255,255,255) 
setscrollrange winmain,1,1,32 
setscrollpos winmain,1,bezsegments 
setcontroltext winmain,2,str$(bezsegments) 
setscrollrange winmain,8,3,40 
setscrollpos winmain,8,ringsegments 
setcontroltext winmain,9,str$(ringsegments)
setscrollrange winmain,10,0,720 
setscrollpos winmain,10,twist+360 
setcontroltext winmain,11,str$(twist)
setscrollrange winmain,12,0,360
setscrollpos winmain,12,curve+180 
setcontroltext winmain,13,str$(curve)
setstate winmain,5,1 
setstate winmain,6,topface
setstate winmain,7,bottomface
return
endsub

sub addcamera
camera1.Create(screen)
camera1.Position(0,0,-130)
camera1.Orient(0,0,1,0,1,0)
camera1.SetBackPlane(1000)
return
endsub

sub addscene
scene.CreateScene(screen)
scene.AddChild(light)
return
endsub

sub addlight
light.Create(screen,LIGHT_POINT,1)
light.Position(0,20,-150)
light.SetAttenuation(0,1/200.0,0)
light.SetSpecular(.5,.5,.5,1)
light.SetAmbient(.4,.4,.4,1)
light.SetRange(2000)
return
endsub

sub changelightcolor
light.SetAttenuation(0,1/lightintensity,0)
light.SetAmbient(lightambientcolor.r,lightambientcolor.g,lightambientcolor.b,1.0)
light.SetDiffuse(lightdiffusecolor.r,lightdiffusecolor.g,lightdiffusecolor.b,1.0)
return
endsub

sub addmaterial
material.diffuse.r = diffusecolor.r: 'red
material.diffuse.g = diffusecolor.g: 'green
material.diffuse.b = diffusecolor.b: 'blue
material.diffuse.a = diffusecolor.a
material.emissive.r = emissivecolor.r
material.emissive.g = emissivecolor.g
material.emissive.b = emissivecolor.b
material.emissive.a = emissivecolor.a
shape.SetMaterial(material)
shape.UseVertexColor(false)
shape.EnableLighting(true)
return
endsub

sub addtexture 
if hastexture=0 then filenametex$ = filerequest("Load Bitmap",winmain,1,filter$,"bmp") 
if filenametex$<> ""
shape.LoadTexture(0,filenametex$,0)
hastexture = 1
endif
return
endsub
 
sub renderscene
screen.Clear(RGBA(0,0,100,100)): 'sets dx9 screen background color
screen.BeginScene(camera1)
scene.Draw(): 'renders scene and all objects which are children of scene
screen.RenderScene()
return
endsub

sub changedir(x:float,y:float,z:float,xincrement:float,yincrement:float,zincrement:float)
'used to rotate object
def amount:float
amount=0.05: 'changes speed of object rotation
x=x+xincrement*amount
y=y+yincrement*amount
z=z+zincrement*amount
dirx=x
diry=y
dirz=z
return
endsub

sub convertcolor(colorin:int),rgbacolor
'used to convert rgb color from colorequest into rgba color
def colorout:rgbacolor
def r,g,b:int 
r = (colorin & 0x0000ff)   
g = (colorin & 0x00ff00) / 256   
b = (colorin & 0xff0000) / 65536
colorout.r=flt(r)/255f
colorout.g=flt(g)/255f
colorout.b=flt(b)/255f
colorout.a=0.5f
return colorout
endsub

sub calculateobjectheight
def i:int
def x,y,h,length:float
'add up lengths of all faces and rings
length=0
if bottomface=1
length=meshry[0].r
meshry[0].h=length
endif
for i=1 to bezsegments
x=meshry[i].r-meshry[i-1].r
y=meshry[i].y-meshry[i-1].y
h=sqrt(x*x+y*y)
length=length+h
meshry[i].h=length
next i
if topface=1
x=meshry[bezsegments].r
y=meshry[bezsegments+1].y-meshry[bezsegments].y
h=sqrt(x*x+y*y)
length=length+h
meshry[i].h=length
endif
'normalize length to one
for i=0 to bezsegments+1
meshry[i].h =meshry[i].h/length
next i
return
endsub

sub addobject
def i:int
'def pRet:pointer: NEEDED??
'setup numVertices and numIndices to match number of rings
numVertices=(ringsegments+1)*(bezsegments+1)+(bottomface+topface)*ringsegments
numIndices=(bottomface+topface)*ringsegments*3*2+ringsegments*3*2*2*bezsegments
gosub calculateobjectheight
'if mesh already exists, reallocate it so texture remains attached
if shapemade=1
shape.ReallocateMesh(numVertices, numIndices,D3DFVF_XYZ | D3DFVF_NORMAL | D3DFVF_DIFFUSE | D3DFVF_TEX1)
else
shape.CreateMesh(screen,numVertices,numIndices,D3DFVF_XYZ | D3DFVF_NORMAL | D3DFVF_DIFFUSE | D3DFVF_TEX1)
endif
'lock the buffers
pVB=shape.LockVertexBuffer()
pIB=shape.LockIndexBuffer()
indexv=0:indexf=0
'step 1
if bottomface=1
addfacecenterpoint(0,0,meshry[0].y)
indexv=indexv+ringsegments
endif
'step 2
addringvertices(0,indexv,meshry[0].r,meshry[0].y,0,0,0)
indexv=indexv+ringsegments+1
'step 3
if bottomface=1 then makebottomface(indexv-ringsegments-1,indexv-ringsegments*2-1)
for i=1 to bezsegments
'step 4
addringvertices(i,indexv,meshry[i].r,meshry[i].y,flt(i)*1.5,0,0)
indexv=indexv+ringsegments+1
'step 5
makeringfaces(indexv-ringsegments-1,indexv-ringsegments*2-2)
next i
if topface=1
addfacecenterpoint(bezsegments,indexv,meshry[bezsegments].y)
maketopface(indexv,indexv-ringsegments-1)
endif
'unlock the buffers
shape.UnlockIndexBuffer()
shape.UnlockVertexBuffer()
shape.SetVisible(true)
if shapemade=0 then scene.AddChild(shape)
shapemade=1
gosub renderscene
return
endsub

sub replaceobject
gosub makerandomshape
gosub addobject
gosub addmaterial
gosub renderscene
return
endsub

sub addfacecenterpoint(height:int,index:int,ry:float)
def i:int
def heightmax:float
heightmax=meshry[bezsegments].y-meshry[0].y
MatrixIdentity(vmat)
MatrixTranslation(vmat,0,ry,0)
MatrixRotation(vmat,0,0,3.14159/180*flt(curve)*((meshry[height].y-meshry[0].y)/heightmax))
MatrixRotation(vmat,0,3.14159/180*flt(twist)*((meshry[height].y-meshry[0].y)/heightmax),0)
'need to add multiple copies at same position but with different texCoords for texture mapping
for i=0 to ringsegments-1
#<VERTEX1TEXTURE>pVB[index+i].position.x=vmat.m[0,3]
#<VERTEX1TEXTURE>pVB[index+i].position.y=vmat.m[1,3]
#<VERTEX1TEXTURE>pVB[index+i].position.z=vmat.m[2,3]
#<VERTEX1TEXTURE>pVB[index+i].diffuseColor = RGBA(255,255,255,255)
#<VERTEX1TEXTURE>pVB[index+i].normal = Vec3Normalize(#<VERTEX1TEXTURE>pVB[index].position)
#<VERTEX1TEXTURE>pVB[index+i].texCoords.x = 1.0-1.0/(2.0*flt(ringsegments))-flt(i)/flt(ringsegments)
if index=0 then
#<VERTEX1TEXTURE>pVB[index+i].texCoords.y = 1.0
else
#<VERTEX1TEXTURE>pVB[index+i].texCoords.y = 0.0
endif
next i
return
endsub

sub addringvertices(height:int,index:int,radius:float,ry:float,dx:float,dy:float,dz:float)
def i:int 
def ang,rx,rz,heightmax:float
ang=360f/ringsegments
heightmax=meshry[bezsegments].y-meshry[0].y
for i=0 to ringsegments 
rx=radius*cos(i*ang*3.14159/180f) 
rz=radius*sin(i*ang*3.14159/180f)
MatrixIdentity(vmat)
MatrixTranslation(vmat,rx,ry,rz)
MatrixRotation(vmat,0,0,3.14159/180*flt(curve)*((meshry[height].y-meshry[0].y)/heightmax))
MatrixRotation(vmat,0,3.14159/180*flt(twist)*((meshry[height].y-meshry[0].y)/heightmax),0)
#<VERTEX1TEXTURE>pVB[index+i].position.x=vmat.m[0,3]
#<VERTEX1TEXTURE>pVB[index+i].position.y=vmat.m[1,3]
#<VERTEX1TEXTURE>pVB[index+i].position.z=vmat.m[2,3]
#<VERTEX1TEXTURE>pVB[index+i].diffuseColor = RGBA(255,255,255,255)
#<VERTEX1TEXTURE>pVB[index+i].normal = Vec3Normalize(#<VERTEX1TEXTURE>pVB[index+i].position)
#<VERTEX1TEXTURE>pVB[index+i].texCoords.x = 1.0-flt(i)/flt(ringsegments)
#<VERTEX1TEXTURE>pVB[index+i].texCoords.y = 1.0-((meshry[height].y-meshry[0].y)/heightmax)
next i
return
endsub

sub makebottomface(index:int,indexold:int)
def i:int
for i=0 to ringsegments-1
#<word>pIB[indexf] = indexold+i
#<word>pIB[indexf+1] = index+i
#<word>pIB[indexf+2] = index+i+1
#<word>pIB[indexf+3] = indexold+i
#<word>pIB[indexf+4] = index+i+1
#<word>pIB[indexf+5] = index+i
indexf=indexf+6
next i
return 
endsub

sub makeringfaces(index:int,indexold:int)
def i:int
for i=0 to ringsegments-1
#<word>pIB[indexf] = index+i
#<word>pIB[indexf+1] = index+i+1
#<word>pIB[indexf+2] = indexold+i
#<word>pIB[indexf+3] = index+i+1
#<word>pIB[indexf+4] = indexold+i+1
#<word>pIB[indexf+5] = indexold+i
indexf=indexf+6
#<word>pIB[indexf] = index+i
#<word>pIB[indexf+1] = indexold+i
#<word>pIB[indexf+2] = index+i+1
#<word>pIB[indexf+3] = index+i+1
#<word>pIB[indexf+4] = indexold+i
#<word>pIB[indexf+5] = indexold+i+1
indexf=indexf+6
next i
return 
endsub

sub maketopface(index:int,indexold:int)
def i:int
for i=0 to ringsegments-1
#<word>pIB[indexf] = index+i
#<word>pIB[indexf+1] = indexold+i
#<word>pIB[indexf+2] = indexold+i+1
#<word>pIB[indexf+3] = index+i
#<word>pIB[indexf+4] = indexold+i+1
#<word>pIB[indexf+5] = indexold+i
indexf=indexf+6
next i
return 
endsub

sub saveobject
def i:int
def x,y,z:float
def myfile:file
def filter$,filename$:string
filter$ = "Obj Files (*.obj)|*.obj|All Files (*.*)|*.*||"   
filename$ = filerequest("Save Object in OBJ Format",winmain,0,filter$,"obj")
if len(filename$)=0 then return 
if (openfile(myfile,filename$,"W")=0)
setprecision 5
'write out x, y, z position for each vertice
for i=0 to numVertices-1
x=#<VERTEX1TEXTURE>pVB[i].position.x
y=#<VERTEX1TEXTURE>pVB[i].position.y
z=#<VERTEX1TEXTURE>pVB[i].position.z
write myfile,"v "+str$(x)+" "+str$(y)+" "+str$(z)
next i 
'write out texture coordinates for each vertice
for i=0 to numVertices-1
x=#<VERTEX1TEXTURE>pVB[i].texCoords.x
y=#<VERTEX1TEXTURE>pVB[i].texCoords.y
write myfile,"vt "+str$(x)+" "+str$(y)
next i
setprecision 0
'write out each face referring to position vertice and texture coordinates
for i=0 to numIndices-1 step 3
x=1+#<word>pIB[i]
y=1+#<word>pIB[i+1]
z=1+#<word>pIB[i+2]
write myfile,"f "+" "+str$(x)+"/"+ltrim$(str$(x))+" "+str$(y)+"/"+ltrim$(str$(y))+" "+str$(z)+"/"+ltrim$(str$(z))
next i 
closefile myfile 
endif 
setprecision 3
return 
endsub