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]
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
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
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
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.
Of course that is only part of the problem. The code is corrupting memory somewhere as well...still looking.
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.
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:
'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