Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Delaunay (Trianglation) versuch
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 30.06.2012 13:09:58 |
'You have time to fetch a cup of coffee.'
'Token's
'OBJMODE (SUB Optimize)
#Define DeleteFragment &h0001
#Define ExpandFragment &h0002
'-----------------------------------------------------------------------------------------------------------------------------'
Function WhichSide(xp as Integer, yp as Integer, x1 as Integer, y1 as Integer, x2 as Integer, y2 as Integer) As Integer
'Determines which side of a line the point (xp,yp) lies.
'The line goes from (x1,y1) to (x2,y2)
'Returns -1 for a point to the left
' 0 for a point on the line
' +1 for a point to the right
Dim equation As Double
equation = ((yp - y1) * (x2 - x1)) - ((y2 - y1) * (xp - x1))
If equation > 0 Then
Function = -1
ElseIf equation = 0 Then
Function = 0
Else
Function = 1
End If
End Function
'--------------------------------------------------------------------------------------------------'
Function InCircle(byval xp as Integer, byval yp as Integer, byval x1 as Integer, byval y1 as Integer,_
byval x2 as Integer, byval y2 as Integer, byval x3 as Integer, byval y3 as Integer,_
byref xc as Double , byref yc as Double , byref r as Double) as Integer
'Return TRUE if the point (xp,yp) lies inside the circumcircle
'made up by points (x1,y1) (x2,y2) (x3,y3)
'The circumcircle centre is returned in (xc,yc) and the radius r
'NOTE: A point on the edge is inside the circumcircle
Dim eps As Double
Dim m1 As Double
Dim m2 As Double
Dim mx1 As Double
Dim mx2 As Double
Dim my1 As Double
Dim my2 As Double
Dim dx As Double
Dim dy As Double
Dim rsqr As Double
Dim drsqr As Double
eps = 0.000001
Function = 0
If Abs(y1 - y2) < eps And Abs(y2 - y3) < eps Then
'Print "INCIRCUM - F - Points are coincident !!"
Exit Function
End If
If Abs(y2 - y1) < eps Then
m2 = -(x3 - x2) / (y3 - y2)
mx2 = (x2 + x3) / 2
my2 = (y2 + y3) / 2
xc = (x2 + x1) / 2
yc = m2 * (xc - mx2) + my2
ElseIf Abs(y3 - y2) < eps Then
m1 = -(x2 - x1) / (y2 - y1)
mx1 = (x1 + x2) / 2
my1 = (y1 + y2) / 2
xc = (x3 + x2) / 2
yc = m1 * (xc - mx1) + my1
Else
m1 = -(x2 - x1) / (y2 - y1)
m2 = -(x3 - x2) / (y3 - y2)
mx1 = (x1 + x2) / 2
mx2 = (x2 + x3) / 2
my1 = (y1 + y2) / 2
my2 = (y2 + y3) / 2
xc = (m1 * mx1 - m2 * mx2 + my2 - my1) / (m1 - m2)
yc = m1 * (xc - mx1) + my1
End If
dx = x2 - xc
dy = y2 - yc
rsqr = dx * dx + dy * dy
r = Sqr(rsqr)
dx = xp - xc
dy = yp - yc
drsqr = dx * dx + dy * dy
If drsqr <= rsqr Then Function = 1
End Function
'-----------------------------------------------------------------------------------------------------------------------------'
Type Vec2Int
X as Integer
Y as Integer
End Type
Type P3Index
P1 as Integer
P2 as Integer
P3 as Integer
End Type
'------------------------------------------------------------------------------------'
Type C_RasterToVector
Declare Constructor()
Declare Destructor()
Declare SUB LoadBMP(byval filename as String)
tColor as UInteger
ImageWidth as Integer
ImageHeight as Integer
BMPImage as any ptr
OBJCount as Integer
OBJPCount as Integer
OBJPos as Vec2Int ptr
OBJMask as byte ptr
Directions(0 to 7) as Vec2Int
Declare SUB Optimize(byval OBJMODE as Integer)
Declare SUB NextPoint(byval XIn as Integer, byval YIn as Integer)
VertexMap as byte ptr
VertexList as Vec2Int ptr ptr
VertexCount as Integer ptr
Declare SUB GenVertexLists()
'private
Declare Function GetOBJVertexMap(byval OBJX as Integer, byval OBJY as Integer) as byte ptr
Declare Sub Triangulate(byval OBJN as Integer)'(nvert as Integer) as Integer
TriangleList as P3Index ptr ptr
TriangleCount as Integer ptr
DBGMSG as String
End Type
'------------------------------------------------------------------------------------'
Constructor C_RasterToVector()
Directions(0).X = -1 : Directions(0).Y = 0 ''Left
Directions(1).X = 0 : Directions(1).Y = -1 ''Up
Directions(2).X = +1 : Directions(2).Y = 0 ''Right
Directions(3).X = 0 : Directions(3).Y = +1 ''Down
Directions(4).X = +1 : Directions(4).Y = +1 ''RightDown
Directions(5).X = -1 : Directions(5).Y = +1 ''LeftDown
Directions(6).X = -1 : Directions(6).Y = -1 ''LeftUp
Directions(7).X = +1 : Directions(7).Y = -1 ''RightUp
OBJPCount = 0
OBJPos = allocate(sizeof(Vec2Int))
DBGMSG = "Class: RasterToVector initiated."
End Constructor
'------------------------------------------------------------------------------------'
Destructor C_RasterToVector()
If BMPImage Then ImageDestroy(BMPImage)
If VertexMap Then Delete[] VertexMap
If OBJMask Then Delete[] OBJMask
If OBJPos Then Delete[] OBJPos
DBGMSG = "Class: RasterToVector finalized."
End Destructor
'------------------------------------------------------------------------------------'
Sub C_RasterToVector.LoadBMP(byval filename as String)
Dim FF as Integer = Freefile
If Open (filename for BINARY as #FF) Then
DBGMSG = "LoadBMP: File not found."
Close #FF
Else
Get #FF, 19, ImageWidth
Get #FF, 23, ImageHeight
Close #FF
BMPImage = Imagecreate(ImageWidth,ImageHeight)
BLoad filename, BMPImage
'
OBJMask = NEW byte[ImageWidth*ImageHeight]
End If
End Sub
'------------------------------------------------------------------------------------'
Sub C_RasterToVector.NextPoint(byval XIn as Integer, byval YIn as Integer)
Dim Temp as byte ptr = NEW byte[ImageWidth * ImageHeight]
Dim rColor as UInteger
Dim PX as Integer = XIn
Dim PY as Integer = YIn
Dim NX as Integer
Dim NY as Integer
OBJMask[PX+(PY*ImageWidth)] = 1
OBJPCount += 1
Temp[PX+(PY*ImageWidth)] = -1
Do
PX = -1 : PY = -1
For Y as Integer=0 to ImageHeight-1
For X as Integer=0 to ImageWidth-1
If (Temp[X+(Y*ImageWidth)] = -1) Then
Temp[X+(Y*ImageWidth)] = -2
PX = X : PY = Y
For np as Integer=0 to 7
NX=PX+Directions(np).X : NY=PY+Directions(np).Y
If (NX > -1) andalso (NY > -1) andalso (NX < ImageWidth) andalso (NY < ImageWidth) Then
rColor = Point(NX,NY,BMPImage)
If (rColor <> tColor) andalso (OBJMask[NX+(NY*ImageWidth)] = 0) Then
If (Temp[NX+(NY*ImageWidth)]) = 0 Then
OBJMask[NX+(NY*ImageWidth)] = 1
OBJPCount += 1
Temp[NX+(NY*ImageWidth)] = -1
Pset (NX,NY),&hFFFFFF00
End If
End If
End If
Next np
End If
Next X
Next Y
If PX = -1 Then Exit Do
Loop
Delete[] Temp
End Sub
'------------------------------------------------------------------------------------'
Function C_RasterToVector.GetOBJVertexMap(byval OBJX as Integer, byval OBJY as Integer) as byte ptr
Dim OBJVertexMap as byte ptr = NEW byte[ImageWidth*ImageHeight]
Dim Temp as byte ptr = NEW byte[ImageWidth*ImageHeight]
Dim TempVertexCount as Integer
Dim rColor as UInteger
Dim PX as Integer
Dim PY as Integer
Dim NX as Integer
Dim NY as Integer
OBJMask[PX+(PY*ImageWidth)] = 1
Temp[PX+(PY*ImageWidth)] = -1
?"HALLOOO??"
Do
PX = -1 : PY = -1
For Y as Integer=OBJX to ImageHeight-1
For X as Integer=OBJY to ImageWidth-1
If (Temp[X+(Y*ImageWidth)] = -1) Then
Temp[X+(Y*ImageWidth)] = -2
PX = X : PY = Y
For np as Integer=0 to 7
NX=PX+Directions(np).X : NY=PY+Directions(np).Y
If (NX > -1) andalso (NY > -1) andalso (NX < ImageWidth) andalso (NY < ImageWidth) Then
rColor = Point(NX,NY,BMPImage)
If (rColor <> tColor) andalso (VertexMap[NX+(NY*ImageWidth)] = 1) Then
If (Temp[NX+(NY*ImageWidth)]) = 0 Then
'OBJMask[NX+(NY*ImageWidth)] = 1
'TempVertexCount += 1
Temp[NX+(NY*ImageWidth)] = -1
OBJVertexMap[NX+(NY*ImageWidth)] = 1
End If
End If
End If
Next np
End If
Next X
Next Y
If PX = -1 Then Exit Do
Loop
Delete[] Temp
Function = OBJVertexMap
End Function
'------------------------------------------------------------------------------------'
Sub C_RasterToVector.Optimize(byval OBJMODE as Integer)
Dim Temp as any ptr
Dim rColor as UInteger
Dim LoopFlag as Integer
Dim DeleteFlag as Integer
Dim NX as Integer
Dim NY as Integer
Do
OBJPCount = 0 : LoopFlag = 0
For Y as Integer=0 to ImageHeight-1
For X as Integer=0 to ImageWidth-1
rColor = Point(X,Y,BMPImage)
If (rColor <> tColor) andalso (OBJMask[X+(Y*ImageWidth)] = 0) Then
LoopFlag = 1
NextPoint(X,Y)
If (OBJPCount > 4) Then
Temp = ReAllocate(OBJPos, (OBJCount+1)*SizeOf(Vec2Int))
OBJPos = Temp
OBJPos[OBJCount].X = X
OBJPos[OBJCount].Y = Y
OBJCount += 1
Exit For,For
Else'Fragment
If (OBJMODE = ExpandFragment) Then
NY = IIF(Y > (ImageHeight/2), Y-1, Y+1)
NX = IIF(X > (ImageWidth/2), X-1, X+1)
OBJMask[NX+(Y*ImageWidth)] = 1
OBJMask[X+(NY*ImageWidth)] = 1
Pset (NX,Y),&hFF0000FF 'DBG
Pset (X,NY),&hFF0000FF 'DBG
Temp = ReAllocate(OBJPos, (OBJCount+1)*SizeOf(Vec2Int))
OBJPos = Temp
OBJPos[OBJCount].X = X
OBJPos[OBJCount].Y = Y
OBJCount += 1
Exit For,For
ElseIf (OBJMODE = DeleteFragment) Then
NX = X : NY = Y : DeleteFlag = 0
OBJMask[X+(Y*ImageWidth)] = 0
PSet BMPImage,(NX,NY),tColor
Pset (NX,NY),0 ''DBG
Do
DeleteFlag = 0
For np as Integer=0 to 7
NX = NX+Directions(np).X : NY = NY+Directions(np).Y
If (NX > -1) andalso (NX < ImageWidth) andalso _
(NY > -1) andalso (NY < ImageWidth) andalso _
( OBJMask[NX+(NY+ImageWidth)] = 1 ) Then
PSet BMPImage,(NX,NY),tColor
OBJMask[NX+(NY+ImageWidth)] = 0 : DeleteFlag = 1
Pset (NX,NY),0 ''DBG
Else
NX = X : NY = Y
End If
Next np
Loop While DeleteFlag
Exit For,For
End If
End If
End If
Next X
Next Y
Loop While LoopFlag
End Sub
'------------------------------------------------------------------------------------'
Sub C_RasterToVector.Triangulate(byval OBJN as Integer)'(nvert as Integer) as Integer
'Takes as input NVERT vertices in arrays Vertex()
'Returned is a list of NTRI triangular faces in the array
'Triangle(). These triangles are arranged in clockwise order.
TriangleList[OBJN] = NEW P3Index[VertexCount[OBJN]*5]
Dim Edges as Integer ptr ptr
Edges = callocate(2*sizeOf(any ptr))
Edges[0] = NEW Integer[VertexCount[OBJN]*15] 'MaxTriangles*3
Edges[1] = NEW Integer[VertexCount[OBJN]*15] 'MaxTriangles*3
Dim Complete as byte ptr
Complete = NEW byte[VertexCount[OBJN]*5] 'MaxTriangles
Dim NEdge as Integer
Dim nvert as Integer
'Dim Complete(MaxTriangles) as Boolean
'Dim Edges(2, MaxTriangles * 3) as Integer
'Dim Nedge as Integer
'For Super Triangle
Dim xmin as Integer
Dim xmax as Integer
Dim ymin as Integer
Dim ymax as Integer
Dim xmid as Integer
Dim ymid as Integer
Dim dx as Double
Dim dy as Double
Dim dmax as Double
'General Variables
Dim i as Integer
Dim j as Integer
Dim k as Integer
Dim ntri as Integer
Dim xc as Double
Dim yc as Double
Dim r as Double
Dim inc as Integer
'Find the maximum and minimum vertex bounds.
'This is to allow calculation of the bounding triangle
xmin = VertexList[OBJN][0].X
ymin = VertexList[OBJN][0].Y
xmax = xmin
ymax = ymin
For i= 0 To VertexCount[OBJN]-1
If (VertexList[OBJN][i].X < xmin) Then xmin = VertexList[OBJN][i].X
If (VertexList[OBJN][i].X > xmax) Then xmax = VertexList[OBJN][i].X
If (VertexList[OBJN][i].Y < ymin) Then ymin = VertexList[OBJN][i].Y
If (VertexList[OBJN][i].Y > ymax) Then ymax = VertexList[OBJN][i].Y
Next i
dx = xmax - xmin
dy = ymax - ymin
If dx > dy Then
dmax = dx
Else
dmax = dy
End If
xmid = (xmax + xmin) / 2
ymid = (ymax + ymin) / 2
'Set up the supertriangle
'This is a triangle which encompasses all the sample points.
'The supertriangle coordinates are added to the end of the
'vertex list. The supertriangle is the first triangle in
'the triangle list.
VertexList[OBJN][VertexCount[OBJN]+0].X = xmid - 2 * dmax
VertexList[OBJN][VertexCount[OBJN]+0].Y = ymid - dmax
VertexList[OBJN][VertexCount[OBJN]+1].X = xmid
VertexList[OBJN][VertexCount[OBJN]+1].Y = ymid + 2 * dmax
VertexList[OBJN][VertexCount[OBJN]+2].X = xmid + 2 * dmax
VertexList[OBJN][VertexCount[OBJN]+2].Y = ymid - dmax
'Vertex(nvert + 1).x = xmid - 2 * dmax
'Vertex(nvert + 1).y = ymid - dmax
'Vertex(nvert + 2).x = xmid
'Vertex(nvert + 2).y = ymid + 2 * dmax
'Vertex(nvert + 3).x = xmid + 2 * dmax
'Vertex(nvert + 3).y = ymid - dmax
TriangleList[OBJN][0].P1 = VertexCount[OBJN]-1 + 0
TriangleList[OBJN][0].P2 = VertexCount[OBJN]-1 + 1
TriangleList[OBJN][0].P3 = VertexCount[OBJN]-1 + 2
'Triangle(1).vv0 = nvert + 1
'Triangle(1).vv1 = nvert + 2
'Triangle(1).vv2 = nvert + 3
Complete[0] = 0'False
ntri = 1
'Include each point one at a time into the existing mesh
For i= 0 To VertexCount[OBJN]-1
'locate 2,1:?ntri,i
NEdge = 0
'Set up the edge buffer.
'If the point (Vertex(i).x,Vertex(i).y) lies inside the circumcircle then the
'three edges of that triangle are added to the edge buffer.
j = -1
Do
j = j + 1
If (Complete[j] <> 0) Then
inc = InCircle(VertexList[OBJN][i].X, VertexList[OBJN][i].Y, _
VertexList[OBJN][TriangleList[OBJN][j].P1].X, _
VertexList[OBJN][TriangleList[OBJN][j].P1].Y, _
VertexList[OBJN][TriangleList[OBJN][j].P2].X, _
VertexList[OBJN][TriangleList[OBJN][j].P2].Y, _
VertexList[OBJN][TriangleList[OBJN][j].P3].X, _
VertexList[OBJN][TriangleList[OBJN][j].P3].Y, xc, yc, r)
'Vertex(Triangle(j).vv0).y, Vertex(Triangle(j).vv1).x, Vertex(Triangle(j).vv1).y, Vertex(Triangle(j).vv2).x, Vertex(Triangle(j).vv2).y, xc, yc, r)
'Include this if points are sorted by X
If ((xc + r) < VertexList[OBJN][i].X) Then 'Vertex(i).x Then
Complete[j] = 1
Else
If inc Then
Edges[0][NEdge+0] = TriangleList[OBJN][j].P1
Edges[1][NEdge+0] = TriangleList[OBJN][j].P2
Edges[0][NEdge+1] = TriangleList[OBJN][j].P2
Edges[1][NEdge+1] = TriangleList[OBJN][j].P3
Edges[0][NEdge+2] = TriangleList[OBJN][j].P3
Edges[1][NEdge+2] = TriangleList[OBJN][j].P1
'Edges(1, Nedge + 1) = Triangle(j).vv0
'Edges(2, Nedge + 1) = Triangle(j).vv1
'Edges(1, Nedge + 2) = Triangle(j).vv1
'Edges(2, Nedge + 2) = Triangle(j).vv2
'Edges(1, Nedge + 3) = Triangle(j).vv2
'Edges(2, Nedge + 3) = Triangle(j).vv0
NEdge = NEdge + 3
TriangleList[OBJN][j].P1 = TriangleList[OBJN][ntri].P1
TriangleList[OBJN][j].P2 = TriangleList[OBJN][ntri].P2
TriangleList[OBJN][j].P3 = TriangleList[OBJN][ntri].P3
'Triangle(j).vv0 = Triangle(ntri).vv0
'Triangle(j).vv1 = Triangle(ntri).vv1
'Triangle(j).vv2 = Triangle(ntri).vv2
Complete[j] = Complete[ntri]
j -= 1
ntri -= 1
End If
End If
End If
Loop While j < ntri
'Tag multiple edges
'Note: if all triangles are specified anticlockwise then all
'interior edges are opposite pointing in direction.
For j= 0 To NEdge-2
'If Not Edges(1, j) = 0 And Not Edges(2, j) = 0 Then
If (Edges[0][j] <> 0) andalso (Edges[1][j] <> 0) Then
For k as Integer =j+1 To NEdge-1
'If Not Edges(1, k) = 0 And Not Edges(2, k) = 0 Then
If (Edges[0][k] <> 0) andalso (Edges[1][k] <> 0) Then
'If Edges(1, j) = Edges(2, k) Then
If (Edges[0][j] = Edges[1][k]) Then
'If Edges(2, j) = Edges(1, k) Then
If (Edges[1][j] = Edges[0][k]) Then
Edges[0][j] = 0
Edges[1][j] = 0
Edges[0][k] = 0
Edges[1][k] = 0
'Edges(1, j) = 0
'Edges(2, j) = 0
'Edges(1, k) = 0
'Edges(2, k) = 0
End If
End If
End If
Next k
End If
Next j
'Form new triangles for the current point
'Skipping over any tagged edges.
'All edges are arranged in clockwise order.
For j as Integer=0 To NEdge-1
'If Not Edges(1, j) = 0 And Not Edges(2, j) = 0 Then
If (Edges[0][j] <> 0) andalso (Edges[1][j] <> 0) Then
ntri = ntri + 1
TriangleList[OBJN][ntri].P1 = Edges[0][j]
TriangleList[OBJN][ntri].P2 = Edges[1][j]
TriangleList[OBJN][ntri].P3 = i
'Triangle(ntri).vv0 = Edges(1, j)
'Triangle(ntri).vv1 = Edges(2, j)
'Triangle(ntri).vv2 = i
Complete[ntri] = 0
End If
Next j
Next i
'Remove triangles with supertriangle vertices
'These are triangles which have a vertex number greater than NVERT
i = -1
Do
i = i + 1
If (TriangleList[OBJN][i].P1 > (VertexCount[OBJN]-1)) or _
(TriangleList[OBJN][i].P2 > (VertexCount[OBJN]-1)) or _
(TriangleList[OBJN][i].P3 > (VertexCount[OBJN]-1)) Then
'If Triangle(i).vv0 > nvert Or Triangle(i).vv1 > nvert Or Triangle(i).vv2 > nvert Then
TriangleList[OBJN][i].P1 = TriangleList[OBJN][ntri].P1
TriangleList[OBJN][i].P2 = TriangleList[OBJN][ntri].P2
TriangleList[OBJN][i].P3 = TriangleList[OBJN][ntri].P3
'Triangle(i).vv0 = Triangle(ntri).vv0
'Triangle(i).vv1 = Triangle(ntri).vv1
'Triangle(i).vv2 = Triangle(ntri).vv2
i -= 1
ntri -= 1
End If
Loop While i < ntri
?ntri
TriangleCount[OBJN] = ntri
'Triangulate = ntri
End Sub
'---------------------------------'
Sub C_RasterToVector.GenVertexLists()
VertexMap = NEW byte[ImageWidth*ImageHeight]
Dim TempVertexCount as Integer
Dim VertexCountALL as Integer
Dim OBJVertexMap as byte ptr
'---------------------------------------------'
Dim NX as Integer
Dim NY as Integer
Dim TracePos as Vec2Int
Dim TraceStep as Integer = 2
Dim TraceSize as Integer = 6
Dim YDirection as Integer = +1
Dim CDirections(0 to 7) as Vec2Int = { Type( +1, 0),_ 'Right
Type( +1, +1),_ 'RightDown
Type( 0, +1),_ 'Down
Type( -1, +1),_ 'LeftDown
Type( -1, 0),_ 'Left
Type( -1, -1),_ 'LeftUp
Type( 0, -1),_ 'Up
Type( +1, -1) } 'RightUp
'---------------------------------------------'
For Y as Integer=0 to ImageHeight-1 step 2
For X as Integer=0 to ImageWidth-1 step 2
If (Point(X,Y,BMPImage) <> tColor) Then
VertexMap[X+(Y*ImageWidth)]=1
End If
Next X
Next Y
VertexList = allocate(OBJCount*SizeOf(any ptr))
VertexCount = NEW Integer[OBJCount]
TriangleList = allocate(OBJCount*SizeOf(any ptr))
TriangleCount = NEW Integer[OBJCount]
For O as Integer=0 to OBJCount-1
OBJVertexMap = GetOBJVertexMap(OBJPos[O].X,OBJPos[O].Y)
'Count Object Vertices
For cy as Integer=0 to ImageHeight-1
For cx as Integer=0 to ImageWidth-1
If (OBJVertexMap[cx+(cy*ImageWidth)] = 1) Then VertexCount[O] += 1
Next cx
Next cy
VertexList[O] = NEW Vec2Int[VertexCount[O]+5]
TempVertexCount = 0
'read vertices
locate 4,1:?VertexCount[O]
'---------------------------------------------'
Do
NX = TracePos.X : NY = TracePos.Y
For X as Integer=0 to TraceSize
For Y as Integer=0 to TraceSize
NX = TracePos.X + X : NY = TracePos.Y + Y
If (NX > -1) and (NY > -1) and (NX < ImageWidth) and (NY < ImageHeight) Then
If (OBJVertexMap[NX+(NY*ImageWidth)] = 1) Then
OBJVertexMap[NX+(NY*ImageWidth)] = -1
VertexList[O][TempVertexCount].X = NX : VertexList[O][TempVertexCount].Y = NY
TempVertexCount += 1
For D as Integer=0 to 7
NX = TracePos.X+X : NY = TracePos.Y+Y
For L as Integer=0 to 2
NX += CDirections(D).X : NY += CDirections(D).Y
If (NX > -1) and (NY > -1) and (NX < ImageWidth) and (NY < ImageHeight) Then
If (OBJVertexMap[NX+(NY*ImageWidth)] = 1) Then
OBJVertexMap[NX+(NY*ImageWidth)] = -1
VertexList[O][TempVertexCount].X = NX : VertexList[O][TempVertexCount].Y = NY
TempVertexCount += 1
End If
End If
Next L
Next D
End If
End If
Next Y
Next X
TracePos.Y += (YDirection * TraceStep)
If (TracePos.Y > (ImageHeight-1)) Then
TracePos.Y = ImageHeight-1
YDirection = -1 : TracePos.X += TraceStep
ElseIf (TracePos.Y < 0) Then
TracePos.Y = 0
YDirection = +1 : TracePos.X += TraceStep
End If
If (TracePos.X > (ImageWidth-1)) Then TracePos.X = ImageWidth-1
'locate 5,1:?TempVertexCount
Loop until ( (TracePos.X=(ImageWidth-1)) and (TracePos.Y=(ImageHeight-1)) )
'---------------------------------------------'
'Triangulate:
Triangulate(O)
?TriangleCount[O]
For t as Integer=0 to TriangleCount[O]-1
?1,VertexList[O][TriangleList[O][t].P1].X
line ( VertexList[O][TriangleList[O][t].P1].X, VertexList[O][TriangleList[O][t].P1].Y ) -_
( VertexList[O][TriangleList[O][t].P2].X, VertexList[O][TriangleList[O][t].P2].Y ), &hFFFF0000
line ( VertexList[O][TriangleList[O][t].P2].X, VertexList[O][TriangleList[O][t].P2].Y ) -_
( VertexList[O][TriangleList[O][t].P3].X, VertexList[O][TriangleList[O][t].P3].Y ), &hFFFF0000
line ( VertexList[O][TriangleList[O][t].P3].X, VertexList[O][TriangleList[O][t].P3].Y ) -_
( VertexList[O][TriangleList[O][t].P1].X, VertexList[O][TriangleList[O][t].P1].Y ), &hFFFF0000
Next t
sleep
'---------------------------------------------'
Delete[] OBJVertexMap
Delete[] VertexList[O]
Next O
Delete[] VertexMap
Deallocate VertexList
End Sub
Screen 19,32
Dim test as C_RasterToVector
test.tColor = &hFF000000
test.LoadBMP("htest.bmp")
Put (0,0),test.BMPImage,pset
test.Optimize(ExpandFragment)
'?test.OBJCount
test.GenVertexLists()
sleep