Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
draw lines and polygons with triangles .
#1
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
Reply
#2
Nice.

On my Thinkpad T430 it took 3.955078 seconds to draw 64000.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#3
I'm getting an average 1.9766667 seconds on the 1st speed test in that program.

I realized I didn't have one just for lines so I did this:

Code: (Select All)
'drawtriangle_lines_test_v0.3
' by James D.  Jarvis  , Sept 15,2023
'just a test of the line drawing speed
'
'HEADER
'$dynamic
Dim Shared xmax, ymax
Dim Shared line_endcap
Dim count As _Unsigned _Integer64
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 Lines Test v0.3 "
count = 0
Cls
Print "200 random lines with varied endcaps"
For n = 1 To 200
    _Limit 30
    line_endcap = Int(Rnd * 16)
    lineFT Rnd * _Width, Rnd * _Height, Rnd * _Height, Rnd * _Width, Int(1 + Rnd * 8), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next n
_Delay 1
Print "press any key for the speed test"
Sleep
_KeyClear
_Title "Draw Lines Test v0.3    (Press ANY key to STOP)"
Cls
t1 = Timer

Do
    line_endcap = Int(Rnd * 16)
    lineFT Rnd * _Width, Rnd * _Height, Rnd * _Height, Rnd * _Width, Int(1 + Rnd * 8), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    count = count + 1
Loop Until InKey$ <> ""
t2 = Timer
Print count; " random lines in "; t2 - t1; " seconds."
_KeyClear
Print "press any key to see how fast it is when it isn't random."
Sleep
Cls
_KeyClear

use_endcap "arrow1"
rr = 100: gg = 100: bb = 100
count = 0
x1 = 50: x2 = 750
yy = 5
t3 = Timer
Do
    lineFT x1, yy, x2, yy, 3, _RGB32(rr, gg, bb)
    count = count + 1
    yy = yy + 15
    rr = rr + 1
    If rr = 250 Then
        rr = 0
        gg = gg + 5
    End If
    If gg > 250 Then
        bb = bb + 2
    End If
    If yy >= _Height Then yy = 5
Loop Until InKey$ <> ""
t4 = Timer
Print count; " calcualted lines in "; t4 - t3; " seconds."

'==========================================================================
'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 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
Reply




Users browsing this thread: 1 Guest(s)