Here is a portion of code I'm working on:
Please try and post comments!
;========================================================================= Const TShape_MaxPoints% = 100 Global CurrentShape.TShape, ResultingShape.TShape Global TShape_Errors = True Global LatheTextureCorrection% = False Type TPoint Field x#, y# End Type Type TShape Field pt.TPoint[TShape_MaxPoints] Field ptnb% Field closed% End Type Function NewShape.TShape() Return New TShape End Function Function NewShapeCircle.TShape(x#, y#, r#, seg% = 8, start% = 0) Local shape.TShape Local angle#, a#, n% shape = New TShape angle = Float(360) / seg BeginShape(shape) a = start - 90 For n = 0 To seg - 1 ShapeAdd(x + (Cos(a) * r), y + (-Sin(a) * r)) a = a + angle Next EndShape(True) Return shape End Function Function NewShapeBox.TShape(x#, y#, w#, h#) Local shape.TShape shape = New TShape BeginShape(shape) ShapeAdd(x, y) ShapeAdd(x + w, y) ShapeAdd(x + w, y - h) ShapeAdd(x, y - h) EndShape(True) Return shape End Function Function NewShapeHCircle.TShape(x#, y#, r#, seg% = 8, start% = 0, closed% = False) Local shape.TShape Local angle#, a#, n% shape = New TShape angle = Float(180) / seg BeginShape(shape) a = start - 90 For n = 0 To seg ShapeAdd(x + (Cos(a) * r), y + (-Sin(a) * r)) a = a + angle Next EndShape(closed) Return shape End Function Function ClearShape%(shape.TShape) Local n% If shape = Null Then RuntimeError("TShape Object does not Exist!") For n = 1 To shape\ptnb Delete shape\pt[n] Next shape\ptnb = 0 End Function Function CopyShape%(src.TShape, dst.TShape) Local n% If src = Null Or dst = Null Then RuntimeError("TShape Object does not Exist!") For n = 1 To src\ptnb dst\pt[n] = New TPoint dst\pt[n]\x = src\pt[n]\x dst\pt[n]\y = src\pt[n]\y Next dst\ptnb = src\ptnb dst\closed = src\closed End Function Function BeginShape%(shape.TShape) If shape = Null Then RuntimeError("TShape Object does not Exist!") If CurrentShape <> Null Then RuntimeError("EndShape() Function Missing!") ClearShape(shape) CurrentShape = New TShape ResultingShape = shape End Function Function EndShape%(closed% = False) If CurrentShape = Null Then RuntimeError("BeginShape() Function Missing!") If ResultingShape = Null Then RuntimeError("TShape Object does Not Exist!") CurrentShape\closed = closed CopyShape(CurrentShape, ResultingShape) Delete CurrentShape End Function Function ShapeAdd%(x#, y#) Local ptnb% If CurrentShape = Null Then RuntimeError("BeginShape() Function Missing!") If CurrentShape\ptnb >= TShape_MaxPoints Then RuntimeError("Too much Points in the Shape!") CurrentShape\ptnb = CurrentShape\ptnb + 1 ptnb = CurrentShape\ptnb CurrentShape\pt[ptnb] = New TPoint x = Float(Int(x * 65536)) / 65536 y = Float(Int(y * 65536)) / 65536 CurrentShape\pt[ptnb]\x = x CurrentShape\pt[ptnb]\y = y End Function Function SegmentLengthEquals%(surf%, v0%, v1%, v2%, v3%) Local x0#, y0#, z0#, x1#, y1#, z1#, x2#, y2#, z2#, x3#, y3#, z3# Local xa#, ya#, za#, xb#, yb#, zb#, da#, db# x0 = VertexX(surf, v0) y0 = VertexY(surf, v0) z0 = VertexZ(surf, v0) x1 = VertexX(surf, v1) y1 = VertexY(surf, v1) z1 = VertexZ(surf, v1) x2 = VertexX(surf, v2) y2 = VertexY(surf, v2) z2 = VertexZ(surf, v2) x3 = VertexX(surf, v3) y3 = VertexY(surf, v3) z3 = VertexZ(surf, v3) xa = x1 - x0 ya = y1 - y0 za = z1 - z0 xb = x3 - x2 yb = y3 - y2 zb = z3 - z2 da = Sqr((xa * xa) + (ya * ya) + (za * za)) db = Sqr((xb * xb) + (yb * yb) + (zb * zb)) If db = da Then Return True Return False End Function Function AddQuadCenter%(surf%, v0%, v1%, v2%, v3%) Local cx#, cy#, cz#, cu#, cv# Local x0#, y0#, z0#, x1#, y1#, z1#, x2#, y2#, z2#, x3#, y3#, z3# Local uu0#, uv0#, uu1#, uv1#, uu2#, uv2#, uu3#, uv3# x0 = VertexX(surf, v0) y0 = VertexY(surf, v0) z0 = VertexZ(surf, v0) x1 = VertexX(surf, v1) y1 = VertexY(surf, v1) z1 = VertexZ(surf, v1) x2 = VertexX(surf, v2) y2 = VertexY(surf, v2) z2 = VertexZ(surf, v2) x3 = VertexX(surf, v3) y3 = VertexY(surf, v3) z3 = VertexZ(surf, v3) uu0 = VertexU(surf, v0) uv0 = VertexV(surf, v0) uu1 = VertexU(surf, v1) uv1 = VertexV(surf, v1) uu2 = VertexU(surf, v2) uv2 = VertexV(surf, v2) uu3 = VertexU(surf, v3) uv3 = VertexV(surf, v3) cx = (x0 + x1 + x2 + x3) / 4 cy = (y0 + y1 + y2 + y3) / 4 cz = (z0 + z1 + z2 + z3) / 4 cu = (uu0 + uu1 + uu2 + uu3) / 4 cv = (uv0 + uv1 + uv2 + uv3) / 4 Return AddVertex(surf, cx, cy, cz, cu, cv) End Function Function CreateIVBank%(surf%) Local vbank%, t%, n%, v%, iso%, ivbank%, offset% vbank = CreateBank(CountVertices(surf)) For t = 0 To CountTriangles(surf) - 1 For n = 0 To 2 v = TriangleVertex(surf, t, n) PokeByte(vbank, v, 1) Next Next For n = 0 To BankSize(vbank) - 1 If PeekByte(vbank, n) = 0 Then If PeekByte(vbank, n) = 0 Then iso = iso + 1 EndIf Next If iso = 0 Then FreeBank(vbank) : Return 0 ivbank = CreateBank(iso * 4) offset = 0 For n = 0 To BankSize(vbank) - 1 If PeekByte(vbank, n) = 0 Then PokeInt(ivbank, offset, n) offset = offset + 4 EndIf Next FreeBank(vbank) Return ivbank End Function Function IsolatedVertex%(surf%, id%) Local t%, n%, result% result = False If id < 0 Or id > CountVertices(surf) - 1 Then Return False For t = 0 To CountTriangles(surf) - 1 For n = 0 To 2 If TriangleVertex(surf, t, n) = id Then Return False Next Next Return True End Function Function CopySurface%(src%, dst%) Local n%, v% For n = 0 To CountVertices(src) - 1 v = AddVertex(dst, VertexX(src, n), VertexY(src, n), VertexZ(src, n), VertexU(src, n), VertexV(src, n), VertexW(src, n)) VertexNormal(dst, v, VertexNX(src, n), VertexNY(src, n), VertexNZ(src, n)) VertexColor(dst, v , VertexRed(src, n), VertexGreen(src, n), VertexBlue(src, n), VertexAlpha(src, n)) Next For n = 0 To CountTriangles(src) - 1 AddTriangle(dst, TriangleVertex(src, n, 0), TriangleVertex(src, n, 1), TriangleVertex(src, n, 2)) Next End Function Function IsolatedVertices%(surf%) Local vbank%, t%, n%, v%, iso% vbank = CreateBank(CountVertices(surf)) For t = 0 To CountTriangles(surf) - 1 For n = 0 To 2 v = TriangleVertex(surf, t, n) PokeByte(vbank, v, 1) Next Next iso = 0 For n = 0 To BankSize(vbank) - 1 If PeekByte(vbank, n) = 0 Then iso = iso + 1 Next FreeBank vbank Return iso End Function Function RemoveVertices%(surf%, id%, idbank% = 0) Local mesh%, scopy%, n%, v%, idbo% Local vlist%, removed%, v0%, v1%, v2% mesh = CreateMesh() scopy = CreateSurface(mesh) CopySurface(surf, scopy) ClearSurface(surf) vlist = CreateBank(CountVertices(scopy) * 4) removed = 0 idbo = 0 For n = 0 To CountVertices(scopy) - 1 If idbank <> 0 Then If idbo < BankSize(idbank) Then id = PeekInt(idbank, idbo) Else id = -1 EndIf EndIf If n <> id Then PokeInt(vlist, n * 4, n - removed) v = AddVertex(surf, VertexX(scopy, n), VertexY(scopy, n), VertexZ(scopy, n), VertexU(scopy, n), VertexV(scopy, n), VertexW(scopy, n)) VertexNormal(surf, v, VertexNX(scopy, n), VertexNY(scopy, n), VertexNZ(scopy, n)) VertexColor(surf, v , VertexRed(scopy, n), VertexGreen(scopy, n), VertexBlue(scopy, n), VertexAlpha(scopy, n)) Else PokeInt(vlist, n * 4, -1) idbo = idbo + 4 removed = removed + 1 EndIf Next For n = 0 To CountTriangles(scopy) - 1 v0 = PeekInt(vlist, TriangleVertex(scopy, n, 0) * 4) v1 = PeekInt(vlist, TriangleVertex(scopy, n, 1) * 4) v2 = PeekInt(vlist, TriangleVertex(scopy, n, 2) * 4) If Not(v0 = -1 Or v1 = -1 Or v2 = -1) Then AddTriangle(surf, v0, v1, v2) EndIf Next FreeBank(vlist) FreeEntity(mesh) Return removed End Function ; RemoveIsolatedVertices%(surf%) Function RemoveIsolatedVertices%(surf%) Local removed%, ivbank% If IsolatedVertices(surf) = 0 Then Return 0 ivbank = CreateIVBank(surf) removed = RemoveVertices(surf, 0, ivbank) FreeBank ivbank Return removed End Function ; CreateLathe(shape.TShape, deg% = 360, seg% = 8, axis% = 1, uscale# = 1, vscale# = 1, ustart# = 0, vstart# = 0, start = 0, decal# = 0, dist# = 0) ; shape : TShape defined Object ; deg : Total angle to perform ; seg : Number of segments ; axis : 0 -> Horizontal / 1 -> Vertical ; uscale: Horizontal texture scaling factor ; vscale: Vertical texture scaling factor ; ustart: Horizontal texture offset ; Better use half or less of the segment numbers (for 16 segments: 1, 2, 4, or 8) ; In other case, if you encounter texture distortions, you can set LatheTextureCorrection = True ; vstart: Vertical texture offset ; start : Starting angle ; decal : Height increment ; dist : Step for contour displacement (spiral) Function CreateLathe%(shape.TShape, deg% = 360, seg% = 8, axis% = 1, uscale# = 1, vscale# = 1, ustart# = 0, vstart# = 0, start = 0, decal# = 0, dist# = 0) Local mesh%, surf%, angle# Local s%, n%, ptnb%, v0%, v1%, v2%, v3% Local x#, y#, z#, a#, flg%, v%, su#, sv#, iu#, nx#, ny#, nz# Local iv#[TShape_MaxPoints], vdist#, px1#, py1#, px2#, py2# Local sdecal#, sdist# Local vm%, ivert% If shape = Null Then RuntimeError("TShape Object does Not Exist!") If seg < 3 Then RuntimeError("Lathe Object needs at least 3 segments!") ptnb = shape\ptnb If ptnb < 2 Then RuntimeError("TShape Object needs at least 2 points!") If deg < 5 Then deg = 5 If decal = 0 And dist = 0 Then If deg > 360 Then deg = 360 EndIf angle = Float(deg)/seg mesh = CreateMesh() surf = CreateSurface(mesh) vdist = 0 For n = 1 To ptnb - 1 px1 = shape\pt[n]\x py1 = shape\pt[n]\y px2 = shape\pt[n + 1]\x py2 = shape\pt[n + 1]\y iv[n] = Sqr(((px2 - px1) * (px2 - px1)) + ((py2 - py1) * (py2 - py1))) vdist = vdist + iv[n] Next If shape\closed = True Then px1 = shape\pt[ptnb]\x py1 = shape\pt[ptnb]\y px2 = shape\pt[1]\x py2 = shape\pt[1]\y iv[ptnb] = Sqr(((px2 - px1) * (px2 - px1)) + ((py2 - py1) * (py2 - py1))) vdist = vdist + iv[ptnb] EndIf For n = 1 To ptnb iv[n] = iv[n] / (vdist / vscale) Next iu = Float(uscale) / seg ;-> First Pass: Vertex sv = vstart For n = 1 To ptnb a = - 90 + start su = ustart sdecal = 0 sdist = 0 For s = 0 To seg If axis = 0 Then x = shape\pt[n]\x + sdecal y = Cos(a) * (shape\pt[n]\y + sdist) z = Sin(a) * (shape\pt[n]\y + sdist) Else x = Cos(a) * (shape\pt[n]\x + sdist) y = shape\pt[n]\y + sdecal z = Sin(a) * (shape\pt[n]\x + sdist) EndIf AddVertex(surf, x, y, z, su, sv, 0) su = su + iu a = a + angle sdecal = sdecal + decal sdist = sdist + dist Next sv = sv + iv[n] Next ;-> Closed Shape If shape\closed = True Then a = - 90 + start su = ustart sdecal = 0 sdist = 0 For s = 0 To seg If axis = 0 Then x = shape\pt[1]\x + sdecal y = Cos(a) * (shape\pt[1]\y + sdist) z = Sin(a) * (shape\pt[1]\y + sdist) Else x = Cos(a) * (shape\pt[1]\x + sdist) y = shape\pt[1]\y + sdecal z = Sin(a) * (shape\pt[1]\x + sdist) EndIf AddVertex(surf, x, y, z, su, sv, 0) su = su + iu a = a + angle sdecal = sdecal + decal sdist = sdist + dist Next EndIf ;-> Second Pass: Triangles For n = 1 To ptnb - 1 v0 = (n - 1) * (seg + 1) v3 = n * (seg + 1) For s = 0 To seg - 1 flg = 0 If axis = 0 Then If shape\pt[n]\y = 0 Then flg = flg + 1 If shape\pt[n + 1]\y = 0 Then flg = + 2 Else If shape\pt[n]\x = 0 Then flg = flg + 1 If shape\pt[n + 1]\x = 0 Then flg = flg + 2 EndIf v1 = v0 + 1 v2 = v3 + 1 If flg = 0 Then If LatheTextureCorrection = False AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else If SegmentLengthEquals(surf, v0, v1, v3, v2) Then AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else vm = AddQuadCenter(surf, v0, v1, v2, v3) AddTriangle(surf, v0, v1, vm) AddTriangle(surf, v1, v2, vm) AddTriangle(surf, v2, v3, vm) AddTriangle(surf, v3, v0, vm) EndIf EndIf Else If decal <> 0 Or dist <> 0 Then If LatheTextureCorrection = False AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else If SegmentLengthEquals(surf, v0, v1, v3, v2) Then AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else vm = AddQuadCenter(surf, v0, v1, v2, v3) AddTriangle(surf, v0, v1, vm) AddTriangle(surf, v1, v2, vm) AddTriangle(surf, v2, v3, vm) AddTriangle(surf, v3, v0, vm) EndIf EndIf ElseIf flg = 1 Then AddTriangle(surf, v0, v2, v3) ElseIf flg = 2 Then AddTriangle(surf, v0, v1, v2) EndIf EndIf v0 = v0 + 1 v3 = v3 + 1 Next Next ;-> Closed Shape If shape\closed = True Then v0 = (n - 1) * (seg + 1) v3 = n * (seg + 1) For s = 0 To seg - 1 flg = 0 If axis = 0 Then If shape\pt[n]\y = 0 Then flg = flg + 1 If shape\pt[1]\y = 0 Then flg = + 2 Else If shape\pt[n]\x = 0 Then flg = flg + 1 If shape\pt[1]\x = 0 Then flg = flg + 2 EndIf v1 = v0 + 1 v2 = v3 + 1 If flg = 0 Then If LatheTextureCorrection = False AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else If SegmentLengthEquals(surf, v0, v1, v3, v2) Then AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else vm = AddQuadCenter(surf, v0, v1, v2, v3) AddTriangle(surf, v0, v1, vm) AddTriangle(surf, v1, v2, vm) AddTriangle(surf, v2, v3, vm) AddTriangle(surf, v3, v0, vm) EndIf EndIf Else If decal <> 0 Or dist <> 0 Then If LatheTextureCorrection = False AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else If SegmentLengthEquals(surf, v0, v1, v3, v2) Then AddTriangle(surf, v0, v1, v2) AddTriangle(surf, v0, v2, v3) Else vm = AddQuadCenter(surf, v0, v1, v2, v3) AddTriangle(surf, v0, v1, vm) AddTriangle(surf, v1, v2, vm) AddTriangle(surf, v2, v3, vm) AddTriangle(surf, v3, v0, vm) EndIf EndIf ElseIf flg = 1 Then AddTriangle(surf, v0, v2, v3) ElseIf flg = 2 Then AddTriangle(surf, v0, v1, v2) EndIf EndIf v0 = v0 + 1 v3 = v3 + 1 Next EndIf ;-> Finalisation UpdateNormals(mesh) ;-> Lathe object is 360 deg: Collapse by Normals If deg = 360 And decal = 0 And dist = 0 Then For n = 1 To ptnb + shape\closed v0 = (n - 1) * (seg + 1) v1 = v0 + seg nx = (VertexNX(surf, v0) + VertexNX(surf, v1)) / 2 ny = (VertexNY(surf, v0) + VertexNY(surf, v1)) / 2 nz = (VertexNZ(surf, v0) + VertexNZ(surf, v1)) / 2 VertexNormal(surf, v0, nx, ny, nz) VertexNormal(surf, v1, nx, ny, nz) Next EndIf RemoveIsolatedVertices(surf) EntityFX mesh, 16 Return mesh End Function ;========================================================================= Graphics3D 640, 480, 32, 2 Global piv =CreatePivot() PositionEntity piv, 0, 0, 0 Global cam = CreateCamera() PositionEntity cam, 0, 20, -50 PointEntity cam, piv AmbientLight 0, 0, 0 Global light1 = CreateLight() PositionEntity light1, 20, 20, -20 LightColor light1, 255, 255, 0 Global light2 = CreateLight() PositionEntity light2, -20, 20, -20 LightColor light2, 255, 0, 255 Global shape.TShape = NewShapeCircle(20, 0, 10, 16, 0) ; -> Uncomment the following lines to show you an other lathe object ;BeginShape(shape) ;ShapeAdd(5,10) ;ShapeAdd(15,10) ;ShapeAdd(15,7.5) ;ShapeAdd(12.5,7.5) ;ShapeAdd(12.5,-7.5) ;ShapeAdd(15,-7.5) ;ShapeAdd(15,-10) ;ShapeAdd(5,-10) ;EndShape(True) Global lathe = CreateLathe(shape, 360, 16, 1, 8, 8) ; -> Uncomment those two lines and load your fav texture ;texture = LoadTexture("texture.jpg") ;EntityTexture lathe, texture While Not KeyDown(1) TurnEntity lathe, 1, 0, 1 RenderWorld Flip Wend
Please try and post comments!