Screen Savers

[bplus]

Thanks Spriggsy!

I think I will throw this in before it gets buried, I think it is cool and looking to try this effect on something else:

Xor 2 Fans

Code: (Select All)

_Title "Xor 2 fans" 'b+ 2022-09-10 just saw at JB
' hmm... how to do this in QB64?
Screen _NewImage(800, 600, 32)
_FullScreen
f1& = _NewImage(800, 600, 32)
f2& = _NewImage(800, 600, 32)
Color , &HFF990000
Do
    Cls
    ao1 = ao1 + .012: ao2 = ao2 - .012
    _Dest f1&
    Line (0, 0)-(799, 599), _RGB32(0, 0, 0), BF
    drawFan 300, 300, 295, 32, &HFFFFFFFF, ao1

    _Dest f2&
    Line (0, 0)-(799, 599), _RGB32(0, 0, 0), BF
    drawFan 500, 300, 295, 32, &HFFFFFFFF, ao2

    _Dest 0
    For y = 0 To 599
        For x = 0 To 799
            _Source f1&
            If Point(x, y) = _RGB32(0, 0, 0) Then p1 = 0 Else p1 = -1
            _Source f2&
            If Point(x, y) = _RGB32(0, 0, 0) Then p2 = 0 Else p2 = -1
            If p1 Xor p2 Then PSet (x, y), &HFFAAAAAA ' tone it down a bit
        Next
    Next
    _Display
    _Limit 60 'Draw as fast as you can!
Loop While _KeyDown(27) = 0

Sub drawFan (x, y, r, nBlades, colr As _Unsigned Long, ao)
    angle = _Pi(1 / nBlades)
    For i = 0 To 2 * nBlades - 1 Step 2
        x1 = x + r * Cos(i * angle + ao)
        y1 = y + r * Sin(i * angle + ao)
        x2 = x + r * Cos((i + 1) * angle + ao)
        y2 = y + r * Sin((i + 1) * angle + ao)
        ftri x, y, x1, y1, x2, y2, colr
    Next
End Sub

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