You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


Recurring Lightning
08-23-2017, 02:59 AM
Post: #1
 (Print Post)
Recurring Lightning
First foray into using images in QB64:
Code Snippet: [Select]
'recurring lightning.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

RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Recurring Lightning"

land& = _NEWIMAGE(xmax, ymax, 32)
_DEST land&
drawLandscape
_DEST 0
WHILE 1

    _PUTIMAGE , land&, 0
    'INPUT "OK "; t$    'debug landscape

    rStop = rand&&(1, 3)
    xo = rand&&(.25 * xmax, .75 * xmax)
    yo = rand&&(0, .35 * ymax)
    FOR i = 1 TO rStop
        xe = rand&&(0, xmax)
        ye = rand&&(0, .5 * ymax)
        dist = distance##(xo, yo, xe, ye)
        d = rand&&(.3 * dist, .9 * dist)
        Lightning xo, yo, xe, ye, d
    NEXT
    rpause = 55 + rStop * 20
    _DELAY rpause / 1000 '<< adjust time as needed for your system
    CLS , _RGB(0, 0, 0)
    rpause = rand&&(80, 3500)
    _DELAY rpause / 1000 '<< adjust time as needed for your system

WEND

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

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

Thanks to Johnno's "stupid" question.

B += _
Find all posts by this user
Like Post
08-23-2017, 05:05 AM
Post: #2
 (Print Post)
RE: Recurring Lightning > Pentacle Flux Capacitor #2
Code Snippet: [Select]
'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

RANDOMIZE TIMER
CONST xmax = 800
CONST ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_TITLE "Pentacle Flux Capacitor #2: Dancing Man (or Woman)"

COMMON SHARED xc, yc, dist, tp(), tp2()
xc = xmax / 2
yc = ymax / 2 + 20
DIM tp(4, 1), tp2(4, 1)

PFC& = _NEWIMAGE(xmax, ymax, 32)
_DEST PFC&
drawPFC
_DEST 0
WHILE 1

    _PUTIMAGE , PFC&, 0
    _DELAY 45 / 1000 '<< adjust time as needed for your system
    CLS , _RGB(0, 0, 0)
    _DELAY 40 / 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
    _DELAY 40 / 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

Need some music? Remember ELO?
https://www.youtube.com/watch?v=i2d45tOg...2d45tOgBl0

B += _
Find all posts by this user
Like Post
08-23-2017, 12:35 PM
Post: #3
 (Print Post)
RE: Recurring Lightning
Cool! Cool
Find all posts by this user
Like Post
08-23-2017, 01:45 PM
Post: #4
 (Print Post)
RE: Recurring Lightning
I hope you tried it with some dancing music background, more fun...

Can you get a screen shot of both of these at once?


Attached File(s) Image(s)
       

B += _
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - ARB Checkers
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Exit
QB64 Member Project - Qubic
QB64 Member Project - Blokus
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Connect Four
QB64 Member Project - Domain
QB64 Member Project - Dreamy Clock
QB64 Member Project - Line Thickness
QB64 Member Project - 9 Board
QB64 Member Project - Othello
QB64 Member Project - Pivot version two
QB64 Member Project - Kings Court
QB64 Member Project - Input
QB64 Member Project - Overboard
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Isolation
QB64 Member Project - Color Rotating Text
QB64 Member Project - Spiro Roses
QB64 Member Project - Dakapo
QB64 Member Project - Foursight
QB64 Member Project - Splatter
QB64 Member Project - Touche
QB64 Member Project - Inside Moves
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Color Triangles
QB64 Member Project - Rubix's Magic
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Swirl
QB64 Member Project - Score 4
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Bowditch curve
QB64 Member Project - Point Blank
QB64 Member Project - Pivet version one
QB64 Member Project - Spinning Color Wheel
QB64 Member Project - Quarto
QB64 Member Project - Basic Dithering
QB64 Member Project - Rotating Background
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Sabotage
QB64 Member Project - RGB Color Wheel
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Algeria Weather
QB64 Member Project - Amazon