09-12-2023, 08:36 PM
A set of routines for drawing lines and shapes using _maptriangle to fill the graphics. I've posted earlier versions of some of this before but it's getting refined and coming together better. Everything isn't perfect but it's better than what has come before.
Code: (Select All)
'drawtriangle_lines_polyFT_v0.3
' by James D. Jarvis , Sept 12,2023
'draw filled polygons using _maptriangle
' draw lines using _maptrinagle
'
'HEADER
'$dynamic
Dim Shared xmax, ymax
Dim Shared line_endcap
xmax = 800: ymax = 500
Screen _NewImage(xmax, ymax, 32)
Dim Shared pk& 'must be included in a program that uses polyFT
Dim Shared lk&
pk& = _NewImage(3, 3, 32) 'must be included in a program that uses polyFT
lk& = _NewImage(3, 3, 32)
'======================================
' demo
'======================================
' This demo draws 64000 random polygons, and then clears the screen and draws a handful of polygons rotating
Randomize Timer
_Title "Draw Triangle Lines Demo v0.3"
use_endcap "round"
t1 = Timer
For reps = 1 To 64000
' polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), Int(1 + Rnd * 3), Int(1 + Rnd * 3), Int(Rnd * 6), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
ts = Int(1 + Rnd * 4)
polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * (5 * ts)), Int(3 + Rnd * 12), Int(Rnd * 60), ts, ts, ts, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next reps
t2 = Timer
Print "That took "; t2 - t1; " seconds to draw 64000 outlined and scaled polygons"
Sleep
Cls
t3 = Timer
For reps = 1 To 64000
' polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), Int(1 + Rnd * 3), Int(1 + Rnd * 3), Int(Rnd * 6), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), 1, 1, 0, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next reps
t4 = Timer
Print "That took "; t4 - t3; " seconds to draw 64000 polygons"
Sleep
rtn = 0
tempi& = _NewImage(400, 250, 32)
Dim tsh(640, 10) As _Unsigned Long
For x = 1 To 64
tsh(x, 1) = Int(Rnd * 400)
tsh(x, 2) = Int(Rnd * 250)
tsh(x, 3) = Int(3 + Rnd * 8)
tsh(x, 4) = Int(1 + Rnd * 3)
tsh(x, 5) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
tsh(x, 6) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next x
Do
_Limit 60
_Dest 0
Cls
Print "Press <ESC> to continue"
polyFT 100, 100, 40, 3, rtn, 1, 1, 2, _RGB32(100, 200, 50), _RGB32(50, 100, 50)
polyFT 200, 100, 40, 4, 45 + rtn, 1, 1, 2, _RGB32(100, 200, 250), _RGB32(50, 100, 250)
polyFT 300, 100, 40, 5, rtn, 1, 1, 2, _RGB32(200, 100, 250), _RGB32(100, 50, 250)
polyFT 400, 100, 40, 6, rtn, 1, 1, 2, _RGB32(100, 250, 150), _RGB32(50, 120, 150)
polyFT 500, 100, 40, 7, rtn, 1, 1, 2, _RGB32(150, 200, 200), _RGB32(70, 100, 200)
polyFT 600, 100, 40, 8, 22.5 + rtn, 1, 1, 2, _RGB32(200, 200, 0), _RGB32(100, 100, 0)
_PrintString (100 - (_PrintWidth("Triangle")) / 2, 160), "Triangle"
_PrintString (200 - (_PrintWidth("Square")) / 2, 160), "Square"
_PrintString (300 - (_PrintWidth("Pentagon")) / 2, 160), "Pentagon"
_PrintString (400 - (_PrintWidth("Hexagon")) / 2, 160), "Hexagon"
_PrintString (500 - (_PrintWidth("Heptagon")) / 2, 160), "Heptagon"
_PrintString (600 - (_PrintWidth("Octagon")) / 2, 160), "Octagon"
rtn = rtn + 1: If rtn > 360 Then rtn = 0
_Dest tempi&
Cls
For r = 1 To 64
polyFT tsh(r, 1), tsh(r, 2), tsh(r, 3) * 2, tsh(r, 3), rtn, 1, 1, tsh(r, 4), tsh(r, 5), tsh(r, 6)
Select Case Int(Rnd * 100)
Case 1: tsh(r, 1) = tsh(r, 1) + 2
Case 2: tsh(r, 1) = tsh(r, 1) - 2
Case 3: tsh(r, 2) = tsh(r, 2) + 2
Case 4: tsh(r, 2) = tsh(r, 2) - 2
End Select
Next r
_Dest 0
_PutImage (200, 200)-(599, 449), tempi&, 0, (0, 0)-(399, 249)
_Display
Loop Until InKey$ = Chr$(27)
Cls
ang = 0
Dim aa(0 To 5, 2)
aa(0, 1) = 110: aa(0, 2) = 400
aa(1, 1) = 50: aa(1, 2) = 390
aa(2, 1) = 100: aa(2, 2) = 300
aa(3, 1) = 100: aa(3, 2) = 260
aa(4, 1) = 70: aa(4, 2) = 220
aa(5, 1) = 30: aa(5, 2) = 240
Do
_Limit 20
Cls
Print "Press <q> to continue"
use_endcap "round"
lineFT 50, 30, 600, 30, 6, _RGB32(200, 50, 0)
lineFT 200, 200, 300, 300, 2, _RGB32(200, 50, 0)
use_endcap "bullet"
lineFT 50, 60, 600, 60, 4, _RGB32(200, 50, 0)
lineFT 250, 200, 350, 300, 2, _RGB32(200, 50, 0)
use_endcap "square"
lineFT 50, 90, 600, 90, 4, _RGB32(200, 50, 0)
lineFT 300, 200, 400, 300, 2, _RGB32(200, 50, 0)
use_endcap "arrow1"
lineFT 50, 120, 600, 120, 4, _RGB32(200, 50, 0)
lineFT 350, 200, 450, 300, 4, _RGB32(200, 50, 0)
use_endcap "arrow2"
lineFT 50, 150, 600, 150, 4, _RGB32(200, 50, 0)
lineFT 400, 200, 500, 300, 4, _RGB32(200, 50, 0)
_PrintString (620, 24), "Round"
_PrintString (620, 54), "Bullet"
_PrintString (620, 84), "Square"
_PrintString (620, 114), "Arrow1"
_PrintString (620, 144), "Arrow2"
'wigglign the line aa()
For n = 0 To UBound(aa)
Select Case Int(Rnd * 50)
Case 1: aa(n, 1) = aa(n, 1) + 2
Case 2: aa(n, 2) = aa(n, 2) + 2
Case 3: aa(n, 2) = aa(n, 2) - 2
Case 4: aa(n, 1) = aa(n, 1) - 2
End Select
Next n
aplotline aa(), "bs", "a1e", 4, _RGB32(0, 200, 200)
use_endcap "a2e"
line_toangle 600, 400, 80, 6, ang, _RGB32(240, 240, 240)
ang = ang + 1
_Display
Loop Until InKey$ = "q"
'==========================================================================
'subroutines
'
' polyFT draw a filled polygon
' lineFT - draw a thick line constructed from 2 mapped triangles
' line_toangle - draw a line from x,y to a specific lenght along an anfle defiend in degrees
' aplotline - draw a line defined in a two dimensinal array of x and y coordinates
' dplotline - draw a line defined by a two diensional array of length and angle coordinates
' closeplot -draw an close a set of lines defined by a two dimensional array of lenght and ngles
'
' DegTo - return angle (in degrees) between two points , used as an internal function in lineFT
' setklr is an sub to build the color image used byt triangles in polyT
'====================================== ==================================
Sub polyFT (cx As Long, cy As Long, rad As Long, sides As Integer, rang As Long, ww, vv, thk, klr As _Unsigned Long, lineyes As _Unsigned Long)
'draw an equilateral polygon using filled triangle for each segment
'centered at cx,cy to radius rad of sides # of face rotated to angle rang scaled to ww and vv of color klr and lineyes if there is an outline, a value 0 would create no outline
setklr klr
dd& = _Dest
Dim px(sides)
Dim py(sides)
pang = 360 / sides
ang = 0
For p = 1 To sides
px(p) = cx + (rad * Cos(0.01745329 * (ang + rang))) * ww
py(p) = cy + (rad * Sin(0.01745329 * (ang + rang))) * vv
ang = ang + pang
Next p
For p = 1 To sides - 1
_MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(p), py(p))-(px(p + 1), py(p + 1)), dd&
Next p
_MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(sides), py(sides))-(px(1), py(1)), dd&
If lineyes > 0 And thk > 0 Then
For p = 1 To sides - 1
lineFT px(p), py(p), px(p + 1), py(p + 1), thk, lineyes
Next p
lineFT px(sides), py(sides), px(1), py(1), thk, lineyes
End If
End Sub
Sub setklr (klr As Long)
'internal routine to setup an image to copy a colored triangle from in the color klr
'called by polyT
od& = _Dest
_Dest pk&
Line (0, 0)-(2, 2), klr, BF
_Dest od&
End Sub
Sub lineFT (x1, y1, x2, y2, thk, klr As _Unsigned Long)
'draw a line of thickness thk on color klr from x1,y1 to x2,y2
'orientation of line is set in the middle of line thickness
od& = _Dest
_Dest lk&
Line (0, 0)-(2, 2), klr, BF 'set the color for the line
_Dest od&
cang = DegTo!(x1, y1, x2, y2) 'get the calcualted angle from x1,y1 to x2,y2
ta = cang + 90 'the anngle from center of line to botton edge
tb = ta + 180 'the angle from center of line to the top edge
tax1 = x1 + (thk \ 2) * Cos(0.01745329 * ta)
tay1 = y1 + (thk \ 2) * Sin(0.01745329 * ta)
tax4 = x1 + (thk \ 2) * Cos(0.01745329 * tb)
tay4 = y1 + (thk \ 2) * Sin(0.01745329 * tb)
tax2 = x2 + (thk \ 2) * Cos(0.01745329 * ta)
tay2 = y2 + (thk \ 2) * Sin(0.01745329 * ta)
tax3 = x2 + (thk \ 2) * Cos(0.01745329 * tb)
tay3 = y2 + (thk \ 2) * Sin(0.01745329 * tb)
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(tax1, tay1)-(tax2, tay2)-(tax4, tay4), od&
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(tax2, tay2)-(tax3, tay3)-(tax4, tay4), od&
Select EveryCase line_endcap
Case 1, 3 'round at start of segment
fcirc x1, y1, (thk \ 2) - .5, klr
Case 2, 3 'round at end of segment
fcirc x2, y2, (thk \ 2) - .5, klr
Case 4, 6 'bullet at start of segment
fcirc x1, y1, thk + 1, klr
Case 5, 6 'bullet at start of segment
fcirc x2, y2, thk + 1, klr
Case 7, 9 'square at start of segment
sx1 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 45))
sx2 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 135))
sx3 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 225))
sx4 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 315))
sy1 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 45))
sy2 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 135))
sy3 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 225))
sy4 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 315))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx1, sy1)-(sx2, sy2)-(sx4, sy4), od&
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx2, sy2)-(sx3, sy3)-(sx4, sy4), od&
Case 8, 9 'square at end of segment
sx1 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 45))
sx2 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 135))
sx3 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 225))
sx4 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 315))
sy1 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 45))
sy2 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 135))
sy3 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 225))
sy4 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 315))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx1, sy1)-(sx2, sy2)-(sx4, sy4), od&
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx2, sy2)-(sx3, sy3)-(sx4, sy4), od&
Case 10, 12 'draw arrow 1 at start of segment
ax1 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 180))
ax2 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 90))
ax3 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 270))
ay1 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 180))
ay2 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 90))
ay3 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 270))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(ax3, ay3), od&
Case 11, 12 'draw arrow1 at end of segment
ax1 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 180))
ax2 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 90))
ax3 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 270))
ay1 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 180))
ay2 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 90))
ay3 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 270))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(ax3, ay3), od&
Case 13, 15 'draw arrow2 at start of segment
ax1 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 180))
ax2 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 40))
ax3 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 320))
ay1 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 180))
ay2 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 40))
ay3 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 320))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(x1, y1), od&
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax3, ay3)-(x1, y1), od&
Case 14, 15 'draw arrow2 at end of segment
ax1 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 180))
ax2 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 40))
ax3 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 320))
ay1 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 180))
ay2 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 40))
ay3 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 320))
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(x2, y2), od&
_MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax3, ay3)-(x2, y2), od&
End Select
End Sub
Sub line_toangle (x1, y1, lnth, thk, ang, klr As _Unsigned Long)
x2 = x1 + lnth * Cos(0.01745329 * ang)
y2 = y1 + lnth * Sin(0.01745329 * ang)
lineFT x1, y1, x2, y2, thk, klr
End Sub
Sub aplotline (aa(), scap$, ecap$, thk, klr As _Unsigned Long)
'plots an 2-d array of pre calculated points
lp = UBound(aa)
ocap = line_endcap 'get the current general line_endcap
For n = 0 To lp - 1
Select Case n
Case 0: use_endcap scap$
Case lp - 1: use_endcap ecap$
Case Else: use_endcap "round"
End Select
lineFT aa(n, 1), aa(n, 2), aa(n + 1, 1), aa(n + 1, 2), thk, klr
line_endcap = ocap 'reset the current general line_endcap
Next n
End Sub
Sub dplotline (aa(), thk, klr As _Unsigned Long)
'plots a line from starting point x1,yy1 built fro an array of lnths and angles
' ]the line starts at x1,y1 as deffined in aa(0,1) and aa(0,2)
lp = UBound(aa)
lastline = line_endcap
x1 = aa(0, 1)
y1 = aa(0, 2)
lasta = 0
For n = 1 To lp
x2 = x1 + aa(n, 1) * Cos(0.01745329 * (aa(n, 2) + lasta))
y2 = y1 + aa(n, 1) * Sin(0.01745329 * (aa(n, 2) + lasta))
lineFT x1, y1, x2, y2, thk, klr
x1 = x2
y1 = y2
lasta = lasta + aa(n, 2)
Next n
End Sub
Sub closeplot (aa(), thk, klr As _Unsigned Long)
'plots a line from starting point x1,yy1 built fro an array of lnths and angles
' ]the line starts at x1,y1 as deffined in aa(0,1) and aa(0,2)
lp = UBound(aa)
line_endcap = 3
x1 = aa(0, 1)
y1 = aa(0, 2)
lasta = 0
For n = 1 To lp
x2 = x1 + aa(n, 1) * Cos(0.01745329 * (aa(n, 2) + lasta))
y2 = y1 + aa(n, 1) * Sin(0.01745329 * (aa(n, 2) + lasta))
lineFT x1, y1, x2, y2, thk, klr
x1 = x2
y1 = y2
lasta = lasta + aa(n, 2)
Next n
lineFT aa(0, 1), aa(0, 2), x2, y2, thk, klr
End Sub
Sub use_endcap (ec$)
'tells the line routine which endcap type to use
Select Case LCase$(ec$)
Case "", "none": line_endcap = 0
Case "round", "rnd", "r": line_endcap = 3
Case "roundend", "rndend", "rnde", "re": line_endcap = 2
Case "roundstart", "rndstart", "rnds", "rs": line_endcap = 1
Case "bullet", "blt", "b": line_endcap = 6
Case "bulletend", "bltend", "blte", "be": line_endcap = 5
Case "bulletstart", "blystart", "blts", "bs": line_endcap = 4
Case "square", "sqr", "s": line_endcap = 9
Case "sqyareend", "squaree", "sqrend", "sqre", "se": line_endcap = 8
Case "squarestart", "squarestart", "squares", "sqrs", "ss": line_endcap = 7
Case "arrow1", "arw1", "a1": line_endcap = 12
Case "arrow1end", "arrow1end", "arw1e", "a1e": line_endcap = 11
Case "arrow1start", "arw1start", "arw1s", "a1s": line_endcap = 10
Case "arrow2", "arw2", "a2": line_endcap = 15
Case "arrow2end", "arrow2end", "arw2e", "a2e": line_endcap = 14
Case "arrow2start", "arw2start", "arw2s", "a2s": line_endcap = 13
Case Else
line_endcap = 0
End Select
End Sub
Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)
'draw a filled circle with the quickest filled circle routine in qb64, not my development
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY), klr: Exit Sub
Line (CX - X, CY)-(CX + X, CY), klr, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), klr, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
Wend
End Sub
Function DegTo! (x1, y1, x2, y2)
'========================
' returns an angle in degrees from point x1,y1 to point x2,y2
aa! = _Atan2((y2 - y1), (x2 - x1)) / 0.01745329
DegTo! = aa!
End Function