Catch some rays
#2
(06-12-2023, 08:02 PM)bplus Wrote: 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!   Big Grin
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Reply


Messages In This Thread
Catch some rays - by bplus - 06-12-2023, 08:02 PM
RE: Catch some rays - by PhilOfPerth - 06-12-2023, 11:11 PM
RE: Catch some rays - by GareBear - 06-14-2023, 08:45 PM
RE: Catch some rays - by bplus - 06-14-2023, 08:51 PM



Users browsing this thread: 3 Guest(s)