Author Topic: Modern Sun Dial  (Read 270 times)

B+

• Hero Member
• Posts: 523
Modern Sun Dial
« on: 01. September 2017, 23:04:06 »
I may have learned how to draw the landscape at BP.org, maybe a mod Aurel's code? It's been awhile!

Code: [Select]
`'Sunburst 3.bas for QB64 fork (B+=MGA) 2017-09-01'spiral rays anyone?  throw in the kitchen clock too...RANDOMIZE TIMERCONST xmax = 800CONST ymax = 600COMMON SHARED cN, pR, pGSCREEN _NEWIMAGE(xmax, ymax, 32)_TITLE "Modern Sun Dial by bplus, press spacebar for new view"'set working variablesmidx = xmax / 2cN = 1horizon = ymax / 2maxd = ((xmax - midx) ^ 2 + (ymax - horizon) ^ 2) ^ .5switch = -1WHILE 1    land& = _NEWIMAGE(xmax, ymax, 32)    _DEST land&    drawLandscape    _DEST 0    switch = NOT switch    WHILE 1        CLS        IF _KEYHIT = 32 THEN EXIT WHILE        resetPlasma        _PUTIMAGE , land&, 0        IF switch THEN            FOR a = 0 TO _PI(2) STEP _PI(1 / 36)                IF a = 0 THEN                    lastx = midx + maxd * COS(a)                    lasty = horizon + maxd * SIN(a)                ELSE                    x1 = midx + maxd * COS(a)                    y1 = horizon + maxd * SIN(a)                    changePlasma                    filltri midx, horizon, lastx, lasty, x1, y1                    lastx = x1: lasty = y1                END IF            NEXT        END IF        radius = 0: angle = sangle        WHILE radius < 400            x = COS(angle) * radius            y = SIN(angle) * radius            r2 = (x ^ 2 + y ^ 2) ^ .5            size = 4 * r2 ^ .25            angle = angle - .4            radius = radius + 2            COLOR _RGBA(200 + RND * 55, 255, 0, 30)            sx = midx + 5 * COS(angle + _PI(1 / 2))            sy = horizon + 5 * SIN(angle + _PI(1 / 2))            sx1 = midx + 5 * COS(angle - _PI(1 / 2))            sy1 = horizon + 5 * SIN(angle - _PI(1 / 2))            filltri sx, sy, sx1, sy1, midx + x, horizon + y        WEND        sangle = sangle + _PI(1 / 18)        IF switch THEN            FOR r = 25 TO 0 STEP -1                COLOR _RGBA(255, 255, 205, (25 - r) ^ 2 / 2.45)                fillcirc midx, horizon, r            NEXT        END IF        now\$ = TIME\$        min = VAL(MID\$(now\$, 4, 2)) / 60        h = VAL(MID\$(now\$, 1, 2)) + min        IF h > 12 THEN h = h - 12        hourA = h * _PI(1 / 6) - _PI(1 / 2)        minA = min * _PI(2) - _PI(1 / 2)        COLOR _RGBA(255, 255, 255, 48)        sx = midx + 5 * COS(hourA + _PI(1 / 2))        sy = horizon + 5 * SIN(hourA + _PI(1 / 2))        sx1 = midx + 5 * COS(hourA - _PI(1 / 2))        sy1 = horizon + 5 * SIN(hourA - _PI(1 / 2))        filltri sx, sy, sx1, sy1, midx + 150 * COS(hourA), horizon + 150 * SIN(hourA)        sx = midx + 5 * COS(minA + _PI(1 / 2))        sy = horizon + 5 * SIN(minA + _PI(1 / 2))        sx1 = midx + 5 * COS(minA - _PI(1 / 2))        sy1 = horizon + 5 * SIN(minA - _PI(1 / 2))        filltri sx, sy, sx1, sy1, midx + 250 * COS(minA), horizon + 250 * SIN(minA)        _DISPLAY        _LIMIT 1    WENDWENDSUB changePlasma ()    cN = cN + 1    COLOR _RGBA(200 + 56 * SIN(pR * cN), 200 + 56 * SIN(pG * cN), 128, RND * 32)END SUBSUB resetPlasma ()    pR = RND ^ 2: pG = RND ^ 2END SUBSUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)    COLOR _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)END SUBFUNCTION rand% (lo%, hi%)    rand% = (RND * (hi% - lo% + 1)) \ 1 + lo%END FUNCTION'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB fillcirc (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    WENDEND SUB'Andy Amaya's triangle fill modified for QB64SUB filltri (xx1, yy1, xx2, yy2, xx3, yy3)    'make copies before swapping    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3    'triangle coordinates must be ordered: where x1 < x2 < x3    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)    'draw the first half of the triangle    length = x2 - x1    IF length <> 0 THEN        slope2 = (y2 - y1) / length        FOR x = 0 TO length            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))            lastx% = INT(x + x1)        NEXT    END IF    'draw the second half of the triangle    y = length * slope1 + y1: length = x3 - x2    IF length <> 0 THEN        slope3 = (y3 - y2) / length        FOR x = 0 TO length            IF INT(x + x2) <> lastx% THEN                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))            END IF        NEXT    END IFEND SUBSUB drawLandscape    'the sky    FOR i = 0 TO ymax        midInk 50, 25, 128, 100, 200, 255, 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)    NEXTEND SUB`
« Last Edit: 01. September 2017, 23:08:17 by B+ »