polyFT in QBJS - Printable Version

Code: (Select All)

Randomize Timer

screen _newimage(640, 400, 32)

do

cls

For i = 0 to 100

polyFT Rnd * 640, Rnd * 400,rnd*30+30,int(3+rnd*12),int(rnd*360),_rgb32(int(rnd*256),int(rnd*256),int(rnd*256)),_rgb32(int(rnd*256),int(rnd*256),int(rnd*256))

_Limit 200

Next i

_delay 2

loop until _keydown(27)





Sub polyFT (cx As Long, cy As Long, rad As Long, sides As Integer, rang As Long, 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

    Dim px(sides)

    Dim py(sides)

    dim pang, ang, p

    pang = 360 / sides

    ang = 0

    For p = 1 To sides

        px(p) = cx + (rad * Cos(0.01745329 * (ang + rang)))

        py(p) = cy + (rad * Sin(0.01745329 * (ang + rang)))

        ang = ang + pang

    Next p

    For p = 1 To sides - 1

    line (cx,cy)-(px(p),py(p)),klr

    ftri cx,cy,px(p),py(p),px(p+1),py(p+1),klr

    Next p

    line (cx,cy)-(px(sides),py(sides)),klr

    ftri cx,cy,px(sides),py(sides),px(1),py(1),klr

  if lineyes>0 then

  for p =1 to sides-1

    Line (px(p), py(p))-(px(p + 1), py(p + 1)), lineyes

  next

  Line (px(sides), py(sides))-(px(1), py(1)), lineyes

  end if

End Sub



'Andy Amaya's triangle fill modified for QB64, use if color already set

Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3, c As _Unsigned Long)

    Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single

    Dim slope1 As Single, slope2 As Single, length As Single, x As Single, lastx%, y As Single

    Dim slope3 As Single

    'make copies before swapping

    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3



    'triangle coordinates must be ordered: where x1 < x2 < x3

    If x2 < x1 Then Swap x1, x2: Swap y1, y2

    If x3 < x1 Then Swap x1, x3: Swap y1, y3

    If x3 < x2 Then Swap x2, x3: Swap y2, y3

    If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)



    'draw the first half of the triangle

    length = x2 - x1

    If length <> 0 Then

        slope2 = (y2 - y1) / length

        For x = 0 To length

            Line (Int(x + x1), Int(x * slope1 + y1))-(Int(x + x1), Int(x * slope2 + y1)), c

            lastx% = Int(x + x1)

        Next

    End If



    'draw the second half of the triangle

    y = length * slope1 + y1: length = x3 - x2

    If length <> 0 Then

        slope3 = (y3 - y2) / length

        For x = 0 To length

            If Int(x + x2) <> lastx% Then

                Line (Int(x + x2), Int(x * slope1 + y))-(Int(x + x2), Int(x * slope3 + y2)), c

            End If

        Next

    End If

End Sub

'polyFT in QBjs 'v 0.5 'haven't quite figure out how to make the this look good with thicker lines but it works fine at one pixel wide Import G2D From "lib/graphics/2d.bas" Randomize Timer For i = 0 to 100 polyFT Rnd * 640, Rnd * 400,rnd*30+30,int(3+rnd*12),int(rnd*360),_rgb32(int(rnd*256),int(rnd*256),int(rnd*256)),_rgb32(int(rnd*256),int(rnd*256),int(rnd*256)) _Limit 200 Next i Sub polyFT (cx As Long, cy As Long, rad As Long, sides As Integer, rang As Long, 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 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))) py(p) = cy + (rad * Sin(0.01745329 * (ang + rang))) ang = ang + pang Next p For p = 1 To sides - 1 line (cx,cy)-(px(p),py(p)),klr G2D.FillTriangle cx,cy,px(p),py(p),px(p+1),py(p+1),klr Next p line (cx,cy)-(px(sides),py(sides)),klr G2D.FillTriangle cx,cy,px(sides),py(sides),px(1),py(1),klr if lineyes>0 then for p =1 to sides-1 Line (px(p), py(p))-(px(p + 1), py(p + 1)), lineyes next Line (px(sides), py(sides))-(px(1), py(1)), lineyes end if End Sub