Solar Flare

[NOVARSEG]

based on code from SierraKen

I corrected pi,  was 3.14159265353 it is now 3.14159265358

SCREEN _NEWIMAGE(1000, 800, 32)
DIM pi AS DOUBLE
DIM c AS DOUBLE
DIM st AS DOUBLE
pi = 3.14159265358 * 2

DO

    i$ = INKEY$
    IF i$ = CHR$(27) THEN END


    startx = 70 + RND * 10
    starty = 70 + RND * 10

    st = (RND * pi)
    x = (SIN(st) * startx)
    y = (COS(st) * startx)

    FOR z% = 1 TO 300
        _LIMIT 1600
        c = _RGB32(255, 50, z%)
        PSET (500 + (x * (1 + z% / 100)), 400 + (y * (1 + z% / 100))), c

    NEXT z%

LOOP
END

[SierraKen]

Great job!

[NOVARSEG]

Thanks

I would like to make the center look more like the sun however this could be a solar eclipse too.

[bplus]

I would like to make the center look more like the sun

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. FOR r = 0 TO 500 STEP .25
3.     CIRCLE (400, 300), r, Ink~&(&HFFFFFF00, &HFF220088, r / 500)
4. NEXT
5.  
6. SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
7.     outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
8. END SUB
9.  
10. FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
11.     DIM R1, G1, B1, A1, R2, G2, B2, A2
12.     cAnalysis c1, R1, G1, B1, A1
13.     cAnalysis c2, R2, G2, B2, A2
14.     Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
15. END FUNCTION
16.  
17.  

[NOVARSEG]

WOW

realistic!

[NOVARSEG]

'Updated Solar Flare with additional code from SierraKen

I corrected pi,  was 3.14159265353 it is now 3.14159265358

'SCREEN _NEWIMAGE(800, 600, 32)

SCREEN _NEWIMAGE(1000, 800, 32)
DIM pi AS DOUBLE
DIM c AS DOUBLE
DIM st AS DOUBLE
pi = 3.14159265358 * 2


FOR r = 0 TO 70 STEP .25
    CIRCLE (500, 400), r, Ink~&(&HFFFFFF00, &HFF220088, r / 500)
NEXT


DO

    i$ = INKEY$
    IF i$ = CHR$(27) THEN END


    startx = 65 + RND * 10
    starty = 65 + RND * 10

    st = (RND * pi)
    x = (SIN(st) * startx)
    y = (COS(st) * starty)

    FOR z% = 1 TO 400
        _LIMIT 1600
        c = _RGB32(255, 0, z% / 1.5)
        PSET (500 + (x * (1 + z% / 100)), 400 + (y * (1 + z% / 100))), c

    NEXT z%

LOOP
END
SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
    outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
END SUB

FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
    DIM R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
END FUNCTION

[NOVARSEG]

NEB CRABULA

SCREEN _NEWIMAGE(1000, 800, 32)
DIM pi AS DOUBLE
DIM c AS DOUBLE
DIM st AS DOUBLE
pi = 3.14159265358 * 2


FOR r = 0 TO 70 STEP .25
    CIRCLE (500, 400), r, Ink~&(&HFFFFFF00, &HFF220088, r / 500)
NEXT


DO

    i$ = INKEY$
    IF i$ = CHR$(27) THEN END


    startx = 70 + RND * 5
    starty = 70 + RND * 5
    st = RND * pi
    x = (SIN(st) * startx)
    y = (COS(st) * starty)
    n% = 0
    FOR z% = 1 TO 400
        _LIMIT 16000
        c = _RGB32(255, 0, z% / 1.5)

        FOR n% = 1 TO 50

            xx = 500 + (x * (1 + (z% + n%) / 100))
            yy = 400 + (y * (1 + (z% + n%) / 100))

            PSET (xx - 1, yy), c
            PSET (xx, yy - 1), c
            PSET (xx - 1, yy - 1), c
            PSET (xx, yy), c

        NEXT n%
        xx = 500 + (x * (1 + (z%) / 100))
        yy = 400 + (y * (1 + (z%) / 100))
        PRESET (xx - 1, yy)
        PRESET (xx, yy - 1)
        PRESET (xx - 1, yy - 1)
        PRESET (xx, yy)

     
    NEXT z%

LOOP
END
SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
    outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
END SUB

FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
    DIM R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
END FUNCTION

[NOVARSEG]

NEB CRABULA ver2  (slowed down with color change)

SCREEN _NEWIMAGE(1000, 800, 32)
DIM pi AS DOUBLE
DIM c AS DOUBLE
DIM st AS DOUBLE
pi = 3.14159265358 * 2


FOR r = 0 TO 70 STEP .25
    CIRCLE (500, 400), r, Ink~&(&HFFFFFF00, &HFF220088, r / 500)
NEXT


DO

    i$ = INKEY$
    IF i$ = CHR$(27) THEN END


    startx = 70 + RND * 5
    starty = 70 + RND * 5
    st = RND * pi
    x = (SIN(st) * startx)
    y = (COS(st) * starty)
    n% = 0
    FOR z% = 1 TO 400
        _LIMIT 400
        c = _RGB32(255, 255 - z%, z% / 1.5)

        FOR n% = 1 TO 50

            xx = 500 + (x * (1 + (z% + n%) / 100))
            yy = 400 + (y * (1 + (z% + n%) / 100))

            PSET (xx - 1, yy), c
            PSET (xx, yy - 1), c
            PSET (xx - 1, yy - 1), c
            PSET (xx, yy), c

        NEXT n%
        xx = 500 + (x * (1 + (z%) / 100))
        yy = 400 + (y * (1 + (z%) / 100))
        PRESET (xx - 1, yy)
        PRESET (xx, yy - 1)
        PRESET (xx - 1, yy - 1)
        PRESET (xx, yy)




    NEXT z%

LOOP
END
SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
    outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
END SUB

FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
    DIM R1, G1, B1, A1, R2, G2, B2, A2
    cAnalysis c1, R1, G1, B1, A1
    cAnalysis c2, R2, G2, B2, A2
    Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
END FUNCTION

[SpriggsySpriggs]

@NOVARSEG

Please, use the QB64 code block option for pasting QB64 code

 

 

[Dav]

Nice sun/circle snippet, @bplus.  What a coincidence too, I was just looking for code to do something like that.

- Dav

[bplus]

I corrected pi,  was 3.14159265353 it is now 3.14159265358

Hi @NOVARSEG  get your free pi here  _PI a constant that QB64 has built in. Try it out:

Code: QB64: [Select]

1. PRINT _PI

Posting your code in Quote Tags is not quite right, neither is the extra large print, please use the button right next to Quote Tags Button that Spriggsy just pointed to, it's just left of quote and looks either like QB64 icon or # sign.

[bplus]

Nice sun/circle snippet, @bplus.  What a coincidence too, I was just looking for code to do something like that.

- Dav

@ Dav Yeah that is my newest version of MidInk, blending one color into another depending how far from first color to 2nd color as a fraction going from 0 at first color location To 1 at 2nd color location.

[bplus]

Dig the rays:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. DO
3.     FOR r = 0 TO 500 STEP .25
4.         CIRCLE (400, 300), r, Ink~&(&HFFFFFF44, &HFF220088, r / 500)
5.     NEXT
6.     FOR i = 1 TO 100
7.         a = RND * _PI(2)
8.         r1 = 20 + RND * 100
9.         r2 = r1 + 20 + RND * 260
10.         midx = _WIDTH / 2 + (r1 + (r2 - r1) / 2) * COS(a): midy = _HEIGHT / 2 + (r1 + (r2 - r1) / 2) * SIN(a)
11.         ray& = _NEWIMAGE(r2 - r1, 1, 32)
12.         _PUTIMAGE , 0, ray&, (400, 300)-STEP(r2 - r1, 1)
13.         RotoZoom midx, midy, ray&, 1, _R2D(a)
14.         _FREEIMAGE ray&
15.     NEXT
16.     _DISPLAY
17.     _LIMIT 60 'try to reduce fan usage
18. LOOP UNTIL _KEYDOWN(27)
19.  
20. SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
21.     outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
22. END SUB
23.  
24. FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
25.     DIM R1, G1, B1, A1, R2, G2, B2, A2
26.     cAnalysis c1, R1, G1, B1, A1
27.     cAnalysis c2, R2, G2, B2, A2
28.     Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
29. END FUNCTION
30.  
31. SUB RotoZoom (X AS LONG, Y AS LONG, Image AS LONG, Scale AS SINGLE, Rotation AS SINGLE)
32.     DIM px(3) AS SINGLE, py(3) AS SINGLE, W&, H&, sinr!, cosr!, i&, x2&, y2&
33.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
34.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
35.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
36.     sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
37.     FOR i& = 0 TO 3
38.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
39.         px(i&) = x2&: py(i&) = y2&
40.     NEXT
41.     _MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
42.     _MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
43. END SUB
44.  
45.  
46.  

[NOVARSEG]

bplus
nice sun effect

[NOVARSEG]

Solar flare (photons)  based on code from SierraKen

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(1000, 800, 32)
2. 'SCREEN _NEWIMAGE(800, 600, 32)
3. DIM starx(1000), stary(1000)
4. DIM sz(1000) AS DOUBLE
5. DIM speed(1000) AS DOUBLE
6. DIM rr AS DOUBLE
7. DIM x(1000) AS DOUBLE
8. DIM y(1000) AS DOUBLE
9. DIM x, y AS DOUBLE
10. DIM cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG
11. DIM rad AS DOUBLE
12. DIM pi AS DOUBLE
13. pi = 3.14159265358
14.  
15.  
16. DO
17.     _LIMIT 100
18.     a$ = INKEY$
19.     IF a$ = CHR$(27) THEN END
20.     IF a$ = " " THEN f = f + 1
21.     IF f = 1 THEN _FULLSCREEN
22.     IF f = 2 THEN _FULLSCREEN OFF: f = 0
23.  
24.     stars = INT(RND * 100) + 1
25.     IF stars > 80 THEN
26.         s = s + 1
27.  
28.         IF s > 950 THEN s = 1
29.         rad = RND * (pi * 2)
30.         x = SIN(rad)
31.         y = COS(rad)
32.         starx(s) = x
33.         stary(s) = y
34.         x(s) = x ' * RND * 5
35.         y(s) = y ' * RND * 5
36.  
37.         'Set size and speed
38.         rr = RND
39.         speed(s) = ((1 + rr / 400) + .002)
40.         sz(s) = rr + .55
41.  
42.     END IF
43.  
44.  
45.     FOR t = 1 TO 950
46.  
47.         stary(t) = stary(t) * speed(t)
48.         starx(t) = starx(t) * speed(t)
49.         'rr = RND * 100
50.         cx = starx(t) + 500 + x(t) * 50
51.         cy = stary(t) + 400 + y(t) * 50
52.         r = sz(t)
53.         c = _RGB32(255, 255, 255)
54.         fillCircle cx, cy, r, c
55.  
56.  
57.         'skip:
58.     NEXT t
59.     _DISPLAY
60.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGB32(0, 0, 0, 20), BF
61.  
62.     FOR b = 0 TO 45 STEP .25
63.         CIRCLE (500, 400), b, Ink~&(&HFFFFFF00, &HFF220088, b / 500)
64.     NEXT
65.  
66. LOOP
67. END
68. 'from Steve Gold standard
69. SUB fillCircle (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
70.     DIM Radius AS INTEGER, RadiusError AS INTEGER
71.     DIM X AS INTEGER, Y AS INTEGER
72.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
73.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
74.     LINE (CX - X, CY)-(CX + X, CY), C, BF
75.     WHILE X > Y
76.         RadiusError = RadiusError + Y * 2 + 1
77.         IF RadiusError >= 0 THEN
78.             IF X <> Y + 1 THEN
79.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
80.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
81.             END IF
82.             X = X - 1
83.             RadiusError = RadiusError - X * 2
84.         END IF
85.         Y = Y + 1
86.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
87.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
88.     WEND
89. END SUB
90.  
91. SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
92.     outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
93. END SUB
94.  
95. FUNCTION Ink~& (c1 AS _UNSIGNED LONG, c2 AS _UNSIGNED LONG, fr##)
96.     DIM R1, G1, B1, A1, R2, G2, B2, A2
97.     cAnalysis c1, R1, G1, B1, A1
98.     cAnalysis c2, R2, G2, B2, A2
99.     Ink~& = _RGB32(R1 + (R2 - R1) * fr##, G1 + (G2 - G1) * fr##, B1 + (B2 - B1) * fr##, A1 + (A2 - A1) * fr##)
100. END FUNCTION