+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Catch some rays (/showthread.php?tid=1750)
Catch some rays - bplus - 06-12-2023
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
RE: Catch some rays - PhilOfPerth - 06-12-2023
(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!
RE: Catch some rays - GareBear - 06-14-2023
bplus, I'm new on the form. Thanks for the rays it looks good.
RE: Catch some rays - bplus - 06-14-2023
(06-14-2023, 08:45 PM)GareBear Wrote: bplus, I'm new on the form. Thanks for the rays it looks good.
Thanks and welcome!