Pentacle Flux Capaciter Mod 2: Dancing Man

[bplus]

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