Pentacle Flux Capaciter Mod 2: Dancing Man

Code: (Select All)
'Pentacle Flux Capacitor 2.bas for QB64 fork 2017-08-23

'translated from: Pentacle Flux Capacitor 2.txt for JB (B+=MGA) 2017-08-23

' updated 2019-09-05 with cleaner more random blackouts, er..., ah, drama!



Randomize Timer

Const xmax = 800

Const ymax = 600

Screen _NewImage(xmax, ymax, 32)

_Title "Pentacle Flux Capacitor #2: Dancing Man"



Common Shared xc, yc, dist, tp(), tp2()

xc = xmax / 2

yc = ymax / 2 + 20

Dim tp(4, 1), tp2(4, 1)

blackout& = _NewImage(xmax, ymax, 32)

_Dest blackout&

Line (0, 0)-(xmax, ymax), &H99000000, BF

PFC& = _NewImage(xmax, ymax, 32)

_Dest PFC&

drawPFC

_Dest 0

While 1

    _PutImage , PFC&, 0

    _Display

    _PutImage , blackout&, 0

    _Display

    _Delay Rnd * 80 / 1000

    Lightning xc, yc - 90, xc, yc + 10, 135

    For i = 0 To 4

        xe = tp2(i, 0)

        ye = tp2(i, 1)

        d = rand(.1 * dist, .7 * dist)

        Select Case i

            Case 0

                Lightning xc, yc - 90, xe, ye, d

                Lightning xc, yc - 90, xe, ye, d

            Case 1, 4

                Lightning xc, yc - 70, xe, ye, d

            Case 2, 3

                Lightning xc, yc + 10, xe, ye, d

        End Select

    Next

    _Display

    _Delay Rnd * 40 / 1000 + 20 / 1000

Wend





Sub drawPFC

    '3 main points for array tp()

    pRadius = 40: cRadius = 1.5 * pRadius

    a3 = _Pi(2 / 5): r = ymax / 2 - cRadius

    ao = _Pi(-1 / 2): a = ao

    For rr = r To 0 Step -10

        midInk 255, 255, 255, 0, 0, 128, rr / r

        CircleFill xc, yc, rr

    Next

    For i = 0 To 4

        tp(i, 0) = xc + r * Cos(a)

        tp(i, 1) = yc + r * Sin(a)

        For rr = cRadius To pRadius Step -1

            Color _RGB((rr - pRadius) / (cRadius - pRadius) * 255 * (cRadius - rr + pRadius) / cRadius, 0, 0)

            xx = tp(i, 0): yy = tp(i, 1)

            CircleFill xx, yy, rr

        Next

        a = a + a3

    Next

    xx = tp(0, 0): yy = tp(0, 1)

    dist = distance##(xx, yy, xc, yc)

    For pnt = 0 To 4

        For dis = 0 To .5 * dist Step 10

            dGray = 255 * dis / dist

            xx = tp(pnt, 0): yy = tp(pnt, 1)

            midpoint xx, yy, xc, yc, dis / dist, midx, midy

            For r = pRadius * (dist - dis) / dist To 0 Step -1

                midInk dGray, dGray, dGray, 255, 255, 255, (pRadius - r) / pRadius

                CircleFill midx, midy, r

            Next

        Next

        tp2(pnt, 0) = midx

        tp2(pnt, 1) = midy

    Next

End Sub





Sub Lightning (x1, y1, x2, y2, d)

    If d < 5 Then

        Color _RGB(225, 225, 245)

        Line (x1, y1)-(x2, y2)

    Else

        mx = (x2 + x1) / 2

        my = (y2 + y1) / 2

        mx = mx + -.5 * Rnd * d * .4 * rand&&(-2, 2)

        my = my + -.5 * Rnd * d * .4 * rand&&(-2, 2)

        Lightning x1, y1, mx, my, d / 2

        Lightning x2, y2, mx, my, d / 2

    End If

End Sub



'Steve McNeil's

Sub CircleFill (CX As Long, CY As Long, R As Long)

    Dim Radius As Long, RadiusError As Long

    Dim X As Long, Y As Long



    Radius = Abs(R)

    RadiusError = -Radius

    X = Radius

    Y = 0



    If Radius = 0 Then PSet (CX, CY): Exit Sub



    ' Draw the middle span here so we don't draw it twice in the main loop,

    ' which would be a problem with blending turned on.

    Line (CX - X, CY)-(CX + X, CY), , BF



    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF

    Wend

End Sub



Sub midpoint (x1, y1, x2, y2, fraction, midx, midy)

    midx = (x2 - x1) * fraction + x1

    midy = (y2 - y1) * fraction + y1

End Sub



Sub midInk (r1, g1, b1, r2, g2, b2, fr)

    Color _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)

End Sub



Function distance## (x1##, y1##, x2##, y2##)

    distance## = ((x1## - x2##) ^ 2 + (y1## - y2##) ^ 2) ^ .5

End Function



Function rand&& (lo&&, hi&&)

    rand&& = Int(Rnd * (hi&& - lo&& + 1)) + lo&&

End Function