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
