Happy New Year 2018 bplus B = B + ... Offline This member has written at least 1,268 posts and created at least 154 threads on this forum since joining inApr 2017. 12-31-2017, 04:06 AM This post was last modified: 12-31-2017, 04:15 AM by bplus.Edited 0 times This might be my final cut for New Year's Fireworks challenge at QB64.net. It is last post from my dinosaur laptop since I got a new one for Christmas. Code:```_TITLE "Happy Trails 2018" ' 2017-12-29 another redesign of fireworks ' 2017-12-28 redesign fireworks ' now with lake refelction 2017-12-27 forget the bouncing sparks ' combine Welcome Plasma Font with landscape '_title "Fireworks 3 translation to QB64 2017-12-26 bplus" 'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09 'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris 'fireworks 3.bas try with map variables make bursts around a central point RANDOMIZE TIMER CONST xmax = 1200 CONST ymax = 720 CONST waterline = 600 ' 600 = ratio 5 to 1 sky to water '                       raise and lower waterline as desired  highest about 400? CONST lTail = 15 CONST bluey = 5 * 256 ^ 2 + 256 * 5 + 5 CONST debrisMax = 28000 SCREEN _NEWIMAGE(xmax, ymax, 32) _SCREENMOVE 120, 20 TYPE fireWorkType    x AS INTEGER    y AS INTEGER    seed AS INTEGER    age AS INTEGER    life AS INTEGER END TYPE TYPE debrisType    x AS SINGLE    y AS SINGLE    c AS LONG END TYPE COMMON SHARED fw() AS fireWorkType COMMON SHARED debris() AS debrisType COMMON SHARED cN, pR!, pG!, pB! SCREEN _NEWIMAGE(xmax, ymax, 32) 'prepare message font mess\$ = " Happy New Year 2018" PRINT mess\$ w = 8 * LEN(mess\$): h = 16 DIM p(w, h) black&& = POINT(0, 10) FOR y = 0 TO h    FOR x = 0 TO w        IF POINT(x, y) <> black&& THEN            p(x, y) = 1        END IF    NEXT NEXT xo = 0: yo = 15: m = 7.2 resetPlasma 'prepare landscape CLS land& = _NEWIMAGE(xmax, ymax, 32) _DEST land& drawLandscape _DEST 0 'prepare fire works nFW = 3 DIM fw(1 TO 10) AS fireWorkType FOR i = 1 TO nFW    initFireWork (i) NEXT 'debris feild DIM debris(debrisMax) AS debrisType 'OK start the show WHILE 1    'cls screen with land image    _PUTIMAGE , land&, 0    'draw fireworks    FOR f = 1 TO nFW        IF fw(f).age <= fw(f).life THEN drawfw (f) ELSE initFireWork f    NEXT    'debris    FOR i = 0 TO debrisStack        PSET (debris(i).x, debris(i).y), debris(i).c        debris(i).x = debris(i).x + RND * 3 - 1.5        debris(i).y = debris(i).y + RND * 3.5 - 1.5        IF debris(i).x < 0 OR debris(i).y < 0 OR debris(i).x > xmax OR debris(i).y > waterline + RND * 20 THEN NewDebris (i)    NEXT    'text message in plasma    FOR y = 0 TO h - 1        FOR x = 0 TO w - 1            IF p(x, y) THEN                changePlasma            ELSE                COLOR 0            END IF            LINE (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF        NEXT    NEXT    lc = lc + 1    IF lc MOD 200 = 0 THEN resetPlasma    'reflect sky    skyWaterRatio = waterline / (ymax - waterline) - .05    FOR y = waterline TO ymax        FOR x = 0 TO xmax            c&& = POINT(x, waterline - ((y - waterline - 1) * skyWaterRatio) + RND * 5)            PSET (x, y + 1), c&& + bluey        NEXT    NEXT    _DISPLAY    _LIMIT 50 'no limit needed on my dinosaur but about 50 on my new laptop    'accumulate debris    IF lc MOD 2000 THEN        IF debrisStack < debrisMax THEN            FOR i = 1 TO 2                NewDebris i + debrisStack            NEXT            debrisStack = debrisStack + 2        END IF    END IF WEND SUB NewDebris (i)    debris(i).x = RND * xmax    debris(i).y = RND * ymax    c = RND * 155    debris(i).c = _RGB32(c, c, c) END SUB SUB changePlasma ()    cN = cN + .01    COLOR _RGB(127 + 127 * SIN(pR! * .3 * cN), 127 + 127 * SIN(pG! * .3 * cN), 127 + 127 * SIN(pB! * .3 * cN)) END SUB SUB resetPlasma ()    pR! = RND ^ 2: pG! = RND ^ 2: pB! = RND ^ 2 END SUB SUB drawLandscape    'the sky    FOR i = 0 TO ymax        midInk 0, 0, 0, 78, 28, 68, i / ymax        LINE (0, i)-(xmax, i)    NEXT    'the land    startH = waterline - 80    rr = 10: gg = 20: bb = 15    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) * (1 / (1 * mountain))            range = Xright + rand&&(5, 35) * 2.5 / mountain            lastx = Xright - 1            FOR X = Xright TO range                y = y + upDown                COLOR _RGB32(rr, gg, bb)                LINE (lastx, y)-(X, ymax), , BF 'just lines weren't filling right                lastx = X            NEXT            Xright = range        WEND        rr = rand&&(rr + 5, rr): gg = rand&&(gg + 5, gg): bb = rand&&(bb + 4, bb)        IF rr < 0 THEN rr = 0        IF gg < 0 THEN gg = 0        IF bb < 0 THEN bb = 0        startH = startH + rand&&(1, 10)    NEXT    'LINE (0, waterline)-(xmax, ymax), _RGB32(0, 0, 0), BF 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 rand&& (lo&&, hi&&    rand&& = INT(RND * (hi&& - lo&& + 1)) + lo&& END FUNCTION SUB drawfw (i)    'here's how to "save" a bunch of random numbers without data and arrays but tons of redundant calculations    RANDOMIZE USING fw(i).seed 'this repeats all random numbers generated by seed in same sequence    'recreate our firework from scratch!    red = rand&&(200, 255)    green = rand&&(200, 255)    blue = rand&&(200, 255)    x = rand&&(1, 4)    IF x = 1 THEN        red = 0    ELSEIF x = 2 THEN        green = 0    ELSEIF x = 3 THEN        blue = 0    ELSE        x = rand&&(1, 4)        IF x = 1 THEN            red = 0: green = 0        ELSEIF x = 2 THEN            green = 0: blue = 0        ELSEIF x = 3 THEN            blue = 0: red = 0        END IF    END IF    ne = rand&&(80, 300)    DIM embers(ne, 1)    FOR e = 0 TO ne        r = RND * 3        embers(e, 0) = r * COS(e * _PI(2) / 101)        embers(e, 1) = r * SIN(e * _PI(2) / 101)    NEXT    start = fw(i).age - lTail ' don't let tails get longer than lTail const    IF start < 1 THEN start = 1    FOR e = 0 TO ne        cx = fw(i).x: cy = fw(i).y: dx = embers(e, 0): dy = embers(e, 1)        FOR t = 1 TO fw(i).age            cx = cx + dx            cy = cy + dy            IF t >= start THEN                'too much like a flower?                midInk 60, 60, 60, red, green, blue, (t - start) / lTail                'midInk 60, 60, 60, 128, 160, 150, (t - start) / lTail                fcirc cx, cy, (t - start) / lTail            END IF            dx = dx * .99 'air resitance            dy = dy + .01 'gravity        NEXT        COLOR _RGB32(255, 255, 255)        'COLOR _RGB32(red, green, blue)        cx = cx + dx: cy = cy + dy        fcirc cx, cy, (t - start) / lTail    NEXT    fw(i).age = fw(i).age + 1 END SUB SUB initFireWork (i)    fw(i).x = rand&&(.1 * xmax, .9 * xmax)    fw(i).y = rand&&(.1 * ymax, .5 * ymax)    fw(i).seed = rand&&(0, 32000)    fw(i).age = 0    fw(i).life = rand&&(20, 120) END SUB 'Steve McNeil's  copied from his forum   note: Radius is too common a name SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)    DIM subRadius AS LONG, RadiusError AS LONG    DIM X AS LONG, Y AS LONG    subRadius = ABS(R)    RadiusError = -subRadius    X = subRadius    Y = 0    IF subRadius = 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``` Happy New Year to All! Attached Files Thumbnail(s) B += x eoredson Programmer Elite Offline This member has written at least 239 posts and created at least 60 threads on this forum since joining inNov 2017. 12-31-2017, 11:23 AM This post was last modified: 01-01-2018, 09:33 AM by Waltersmind.Edited 0 times Nothing changes on New Years Day: [youtube]vdLuk2Agamk[/youtube] Erik. dndbbs project: Links to my MUD: (strictly 16-bit); AKA XP: Dndbbs executables http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip Dndbbs source http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip Dndbbs upgrade http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip DNDDOOR - DUNGEON - https://bit.ly/EriksDungeon Interpreter - Hex Editor - Utilities -  QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: -  Adrian Huang Registered Offline This member has written at least 129 posts and created at least 9 threads on this forum since joining inJun 2015. 12-31-2017, 02:22 PM Happy new year everyone! I like to program in BASIC With code that is simple and slick I learnt it in school And it is still cool So it is my number one pick bplus B = B + ... Offline This member has written at least 1,268 posts and created at least 154 threads on this forum since joining inApr 2017. 01-01-2018, 02:39 AM U2      ; - ) ) B += x Waltersmind A computer programming hobbyist and enthusiast Offline This member has written at least 816 posts and created at least 109 threads on this forum since joining inJun 2014. 01-01-2018, 09:34 AM Happy New Year to ever one as well! @Bplus, Very nice fireworks demo! Thank you for sharing. Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts. « Next Oldest | Next Newest » 