Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
polyFT in QBJS
#2
I added fTri routine and put the 100 polys in a loop:
Jarvis polyFT demo

QBJS tags not working

This won't work in QB64 but is code for above:
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
b = b + ...
Reply


Messages In This Thread
polyFT in QBJS - by James D Jarvis - 09-09-2023, 11:16 PM
RE: polyFT in QBJS - by bplus - 09-09-2023, 11:31 PM
RE: polyFT in QBJS - by James D Jarvis - 09-09-2023, 11:51 PM
RE: polyFT in QBJS - by grymmjack - 09-10-2023, 12:33 AM
RE: polyFT in QBJS - by bplus - 09-10-2023, 03:11 AM
RE: polyFT in QBJS - by grymmjack - 09-10-2023, 05:11 PM
RE: polyFT in QBJS - by dbox - 09-10-2023, 04:21 AM
RE: polyFT in QBJS - by James D Jarvis - 09-10-2023, 01:55 PM
RE: polyFT in QBJS - by bplus - 09-10-2023, 02:17 PM
RE: polyFT in QBJS - by dbox - 09-10-2023, 02:21 PM
RE: polyFT in QBJS - by James D Jarvis - 09-10-2023, 06:27 PM
RE: polyFT in QBJS - by bplus - 09-10-2023, 05:18 PM



Users browsing this thread: 3 Guest(s)