Drawing with Lines of Variable Thickness

[James D Jarvis]

A method to draw lines of variable thickness making use of rotozoom2

has routines to draw a line of any pixel thickness, outlined polygons, and filled polygons with a few different fill methods.,

I've made heavy use of B+'s code to get this working.

Code: (Select All)

_Title "Drawing with lines of variable thickness"
'by James D. Jarvis adapted using code by B+
' this uses RotoZoom2 to draw a line of any thickness.
'
Randomize Timer
Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)

_ScreenMove _Middle
px = 0: py = 0: t = 0
Do
    Cls
    _Limit 30
    dline 100, 100, 300, 300, _RGB32(100, 200, 200), 20
    dline 100, 300, 300, 300, _RGB32(100, 200, 200), 20
    rotopoly2 300, 300, 150, 90, 0, _RGB32(100, 200, 200), 6.5
    tripoly 300, 300, 50, 90, 0, _RGB32(200, 100, 100)
    rotopoly2 300, 300, 50, 90, 0, _RGB32(100, 200, 200), 1.5
    fillpoly 300, 100, 40, 72, 0, _RGB32(100, 100, 200), _RGB32(80, 0, 0), 1.5, "noise"
    fillpoly 400, 100, 40, 60, 0, _RGB32(180, 180, 0), _RGB32(180, 180, 0), 1.5, "af"
    fillpoly 500, 100, 40, 120, 0, _RGB32(100, 100, 200), _RGB32(250, 250, 0), 4, "VV"
    fillpoly 600, 100, 40, 90, 0, _RGB32(100, 100, 200), _RGB32(0, 180, 180), 6, "hh"
    px = px + 3: py = py + 2: t = t + 1
    If px > _Width Then px = 0
    If py > _Height Then py = 0
    If t > 360 Then t = 1
    fillpoly px, py, 20, 90, t, _RGB32(250, 250, 250), _RGB32(200, 200, 0), 4, "AH"
    _Display
    kk$ = InKey$
Loop Until kk$ = Chr$(27)

Function Rtan2 (x1, y1, x2, y2)
    'get the angle (in radians) from x1,y1 to x2,y2
    deltaX = x2 - x1
    deltaY = y2 - y1
    rtn = _Atan2(deltaY, deltaX)
    If rtn < 0 Then Rtan2 = rtn + (2 * _Pi) Else Rtan2 = rtn
End Function
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub
'====================================================================
' draw a line of color klr and thickness thk
'====================================================================
Sub dline (x1, y1, x2, y2, klr As _Unsigned Long, thk)
    storeDest& = _Dest
    hyp = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) 'detrmine the length of the line
    yy = 1 * thk
    xx = Int(hyp + .9)
    II& = _NewImage(xx, Int(yy + .5), 32)
    _Dest II&
    Line (0, 0)-(xx, yy), klr, BF 'draw the line in the temporary image buffer
    centerx = (x1 + x2) / 2
    centery = (y1 + y2) / 2
    _Dest storeDest&
    rotation = Rtan2(x1, y1, x2, y2) 'find the angle of the line in radians as rotozoom2 uses radians
    RotoZoom2 centerx, centery, II&, 1, 1, rotation 'copy the line to it's position on the screen using rotozoom2
    _FreeImage II&
End Sub

'This sub gives really nice control over displaying an Image.
Sub RotoZoom2 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
    Dim px(3) As Single: Dim py(3) As Single
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
    For i& = 0 To 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
'====================================================================
' rotopoly2 draws a  polygon wit variable line thickness
'====================================================================
Sub rotopoly2 (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long, thk)
    x = 0
    y = 0
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Cos(0.01745329 * deg)
        y2 = rr * Sin(0.01745329 * deg)
        'If x <> 0 Then Line (cx + x, cy + y)-(cx + x2, cy + y2), klr
        If x <> 0 Then dline cx + x, cy + y, cx + x2, cy + y2, klr, thk
        x = x2
        y = y2
        circleBF (cx + x2), (cy + y2), (thk) \ 2, klr 'fills in the open gap at polygon line intersections
    Next
End Sub
'====================================================================
' triploy draw a filled polygon by rendereing multiple triangles of the same color
'====================================================================
Sub tripoly (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long)
    storeDest& = _Dest
    I& = _NewImage(3, 3, 32)
    _Dest I&
    Line (0, 0)-(_Width, _Height), klr, BF
    x = 0
    y = 0
    _Dest storeDest&
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Cos(0.01745329 * deg)
        y2 = rr * Sin(0.01745329 * deg)
        If x <> 0 Then _MapTriangle (0, 0)-(0, 2)-(2, 2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
        x = x2
        y = y2
    Next
    _FreeImage I&
End Sub

'====================================================================
'fillpoly creates filled polygons
'a temporary image is created and trignels for each segment of that tmeporary image are copied to the screen
'currently   7 modes are defined
'CF- color fill,  HH -  horizontal line fill, VV- vertical line fill
'AF - alternating segment color fill, AH & AV are alternationg horizonatl or vetical
'noise- creaes a fill of randomly colore points
'======================================================================
Sub fillpoly (cx, cy, rr, shapedeg, turn, klr1 As _Unsigned Long, klr2 As _Unsigned Long, thk, mode$)
    storeDest& = _Dest
    siz = (rr * Cos(0.01745329 * deg)) * 2
    sx = siz / 2: sy = siz / 2
    I& = _NewImage(siz, siz, 32)
    _Dest I&
    Select Case UCase$(mode$)
        Case "CF", "AF"
            Line (0, 0)-(siz, siz), klr2, BF
        Case "HH", "AH"
            For y = 0 To siz Step thk
                Line (0, y)-(siz, y - 1 + thk / 2), klr2, BF
            Next
        Case "VV", "AV"
            For x = 0 To siz Step thk
                Line (x, 0)-(x - 1 + thk / 2, siz), klr2, BF
            Next
        Case "NOISE"
            For y = 0 To siz
                For x = 0 To siz
                    PSet (x, y), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)
                Next x
            Next y
    End Select
    x = 0
    y = 0
    _Dest storeDest&
    sc = 0
    For deg = turn To turn + 360 Step shapedeg
        sc = sc + 1
        x2 = rr * Cos(0.01745329 * deg)
        y2 = rr * Sin(0.01745329 * deg)
        If x <> 0 Then
            Select Case UCase$(mode$)
                Case "AF", "AH", "AV"
                    If (sc Mod 2) <> 0 Then _MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
                Case Else
                    _MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
            End Select
        End If
        x = x2
        y = y2
    Next
    _FreeImage I&
    If klr1 <> 0 Then rotopoly2 cx, cy, rr, shapedeg, turn, klr1, thk
End Sub