Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pentacle Flux Capaciter Mod 2: Dancing Man
#1
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
Reply
#2
LOL freaky! Someone could use that at the end of a game or something when your guy dies. Or like in that one Batman movie where Catwoman dies on the electric grid. lol Awesome job!

It also reminds me of the time we made lightening globes. Smile
Reply
#3
Thanks Ken I think you are my favorite fan! Don't forget to click the thumbs up rate button ;-))

Oh I forgot to dedicate this to vince who is such a fan of JB, I think this WAS ported to QB64 from JB.
Reply
#4
I love the lightning effect. Scotty better reverse the polarity on his spanner before he fools with that puppy.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#5
I got the idea of flux capaciters from Back to the Future, Christopher Lloyd's "Doc" invention.
b = b + ...
Reply




Users browsing this thread: 2 Guest(s)