Proggies

[bplus]

Ohio's Heat Lightning

inspired sometime ago

Code: (Select All)

'recurring lightning w Fade.bas for QB64 fork 2017-08-23
'translated from: recurring lightning.bas for SmallBASIC 0.12.9 2017-08-22
'translated from: recurring lightning.txt for JB (B+=MGA) 2017-08-21
'2017-10-10 fade by TylerDarko and Branching Lightning by RhoSigma

Randomize Timer
Const xmax = 800
Const ymax = 600
Const FORKINESS = 15 '1 to 20
Const FREQUENCY = 3 '1 to 15

Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_Title "Recurring Branching Lightning with Fade"

land& = _NewImage(xmax, ymax, 32)
_Dest land&
drawLandscape
_Dest 0
rpause = 55
While 1
    _PutImage , land&, 0
    If Int(Rnd(1) * 100) > 50 Then
        DrawLightning Int(Rnd(1) * (xmax / 2)), 0, 50, 0.785398163, 1
    Else
        DrawLightning (xmax / 2) + Int(Rnd(1) * ((xmax / 2) - 1)), 0, 50, 2.35619449, 1
    End If
    Color _RGB(128, Rnd * 55 + 200, Rnd * 55 + 200)
    _Delay rpause / 1000 '<< adjust time as needed for your system
    s! = Timer
    rpause = rand&&(80, 2500)
    Do
        Line (0, 0)-(_Width, _Height), _RGBA32(0, 0, 0, 25), BF
        _Display
        _Limit 60
    Loop While Timer - s! < rpause / 1000 '<< adjust time as needed for your system
Wend

'============================================================

Sub DrawLightning (X&, Y&, Segments&, Dir#, Fork&)
    Sign# = 0.392699081
    xSeg# = xmax / (15.0 * Fork&)
    ySeg# = ymax / (15.0 * Fork&)
    Do
        Angle& = Int(Rnd(1) * 100)
        DeltaAngle# = Sign# * Angle& / 100.0
        Dir# = Dir# + DeltaAngle#
        Sign# = Sign# * -1.0

        nX& = X& + (Cos(Dir#) * xSeg#)
        nY& = Y& + (Sin(Dir#) * ySeg#)
        cc&& = _RGBA(128, Rnd * 55 + 200, Rnd * 55 + 200, 15 * FORKINESS / Fork&)
        DrawLine X&, Y&, nX&, nY&, cc&&
        X& = nX&
        Y& = nY&

        If ((Fork& < 5) And (Int(Rnd(1) * 60) < (FORKINESS / Fork&))) Then
            DrawLightning (X&), (Y&), 5 + Int(Rnd(1) * 10), Dir# - (2.0 * DeltaAngle#), Fork& + 2
        End If
        Segments& = Segments& - 1
    Loop While Segments& > 0 And Y& < ymax - 100
End Sub

Sub DrawLine (x1%, y1%, x2%, y2%, cc&&)
    If x1% < 0 Then
        If x2% < 0 Then Exit Sub
        x1% = 0
    ElseIf x1% >= xmax Then
        If x2% >= xmax Then Exit Sub
        x1% = xmax - 1
    End If
    If y1% < 0 Then
        If y2% < 0 Then Exit Sub
        y1% = 0
    ElseIf y1% >= ymax Then
        If y2% >= ymax Then Exit Sub
        y1% = ymax - 1
    End If

    If x2% < 0 Then
        x2% = 0
    ElseIf x2% >= xmax Then
        x2% = xmax - 1
    End If
    If y2% < 0 Then
        y2% = 0
    ElseIf y2% >= ymax Then
        y2% = ymax - 1
    End If
    Line (x1%, y1%)-(x2%, y2%), cc&&
End Sub

Sub drawLandscape
    'the sky
    For i = 0 To ymax
        midInk 0, 0, 0, 128, 128, 128, i / ymax
        Line (0, i)-(xmax, i)
    Next
    'the land
    startH = ymax - 200
    rr = 70: gg = 70: bb = 90
    For mountain = 1 To 6
        Xright = 0
        y = startH
        While Xright < xmax
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (Rnd * .8 - .35) * (mountain * .5)
            range = Xright + rand&&(15, 25) * 2.5 / mountain
            lastx = Xright - 1
            For X = Xright To range
                y = y + upDown
                Color _RGB(rr, gg, bb)
                Line (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
                lastx = X
            Next
            Xright = range
        Wend
        rr = rand&&(rr - 15, rr): gg = rand&&(gg - 15, gg): bb = rand&&(bb - 25, bb)
        If rr < 0 Then rr = 0
        If gg < 0 Then gg = 0
        If bb < 0 Then bb = 0
        startH = startH + rand&&(5, 20)
    Next
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

true heat lightning needs more clouds and rarely ever sends bolts to the ground, more like flickering fluorescent bulb.