Proggies

[bplus]

Here is something CharlieJV started on another forum that I of course had to mod! ; - ) )

Code: (Select All)

_Title "Color Rotation" ' bplus 2024-01-06
sw = 1200: sh = 600
Screen _NewImage(sw, sh, 32)
_ScreenMove (_DesktopWidth - sw) / 2, (_DesktopHeight - sh) / 2
Randomize Timer
cx = sw / 2: cy = sh / 2 ' screen center
r = 150 ' radius of the iso triangles from center
r2 = r * 2
s = Sqr(2) * r / 4
While _KeyDown(27) = 0
    For cy = r To sh Step r2
        For cx = r To sw Step r2
            n = n + 10
            a = _Pi(2 / n) 'deterimine the central angle of all the triangles
            Randomize Using n
            ReDim pal~&(1 To n)
            For i = 1 To n
                pal~&(i) = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
            Next
            For c = 1 To n ' draw the triangles into an image we will be spinning
                x1 = cx + r * Cos((c - 1) * a + rot): y1 = cy + r * Sin((c - 1) * a + rot)
                If c > 1 Then
                    ftri lastx, lasty, x1, y1, cx, cy, pal~&(c)
                Else
                    savex = x1: saveY = y1
                End If
                lastx = x1: lasty = y1
            Next
            ftri savex, saveY, lastx, lasty, cx, cy, pal~&(1)
            Line (cx - r, cy - r)-Step(r2, s), &HFF000000, BF
            Line (cx - r, cy - r)-Step(s, r2), &HFF000000, BF
            Line (cx + r, cy + r)-Step(-r2, -s), &HFF000000, BF
            Line (cx + r, cy + r)-Step(-s, -r2), &HFF000000, BF
        Next
    Next
    _Display
    _Limit 60
    rot = rot + .01
    n = 0
Wend

Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

When r = 150
   

When r = 75
   

As usual the still shots don't do justice to the animation.