Catch some rays

[bplus]

Couldn't find the exotic landscape background mod but found this for a sun:

Code: (Select All)

Screen _NewImage(800, 600, 32)

Do

    For r = 0 To 500 Step .25

        Circle (400, 300), r, Ink~&(&HFFFFFF44, &HFF220088, r / 500)

    Next

    For i = 1 To 100

        a = Rnd * _Pi(2)

        r1 = 20 + Rnd * 100

        r2 = r1 + 20 + Rnd * 260

        midx = _Width / 2 + (r1 + (r2 - r1) / 2) * Cos(a): midy = _Height / 2 + (r1 + (r2 - r1) / 2) * Sin(a)

        ray& = _NewImage(r2 - r1, 1, 32)

        _PutImage , 0, ray&, (400, 300)-Step(r2 - r1, 1)

        RotoZoom midx, midy, ray&, 1, _R2D(a)

        _FreeImage ray&

    Next

    _Display

    _Limit 10

Loop Until _KeyDown(27)



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



Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)

    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&

    W& = _Width(Image&): H& = _Height(Image&)

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

        px(i&) = x2&: py(i&) = y2&

    Next

    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

[PhilOfPerth]

Couldn't find the exotic landscape background mod but found this for a sun:

Code: (Select All)

Screen _NewImage(800, 600, 32)

Do

    For r = 0 To 500 Step .25

        Circle (400, 300), r, Ink~&(&HFFFFFF44, &HFF220088, r / 500)

    Next

    For i = 1 To 100

        a = Rnd * _Pi(2)

        r1 = 20 + Rnd * 100

        r2 = r1 + 20 + Rnd * 260

        midx = _Width / 2 + (r1 + (r2 - r1) / 2) * Cos(a): midy = _Height / 2 + (r1 + (r2 - r1) / 2) * Sin(a)

        ray& = _NewImage(r2 - r1, 1, 32)

        _PutImage , 0, ray&, (400, 300)-Step(r2 - r1, 1)

        RotoZoom midx, midy, ray&, 1, _R2D(a)

        _FreeImage ray&

    Next

    _Display

    _Limit 10

Loop Until _KeyDown(27)



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



Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)

    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&

    W& = _Width(Image&): H& = _Height(Image&)

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

        px(i&) = x2&: py(i&) = y2&

    Next

    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

Gosh, what a coincidence! Mine was almost identical, but only used color 1 and color 14, and had no sparkly-bits!  

[GareBear]

bplus, I'm new on the form. Thanks for the rays it looks good.

[bplus]

bplus, I'm new on the form. Thanks for the rays it looks good.

Thanks and welcome!