A couple cheap-o effects in small code (spotlight, movable message box)

[Dav]

Here's a couple of cheap effects with small code.  I like playing around with simple small bits of code and see what can be done quickly.  Here's what came up this morning while enjoying my coffee. This fakes a spotlight effect and draws a movable message box with some transparency.  Works ok for text background, but not good for graphics.

- Dav

Code: QB64: [Select]

1.  
2. SCREEN _NEWIMAGE(640, 640, 32)
3.  
4. FOR p = 1 TO 1000
5.     PRINT RND * 100;
6. NEXT
7.  
8. 'fake a spotlight...
9. FOR x = 0 TO _WIDTH + (_WIDTH / 3) STEP .3
10.     CIRCLE (_WIDTH / 2, _HEIGHT / 2), x, _RGBA(0, 0, 0, x / 2)
11. NEXT
12.  
13. back& = _COPYIMAGE(_DISPLAY)
14.  
15. DO
16.     m = _MOUSEINPUT: mx = _MOUSEX: my = _MOUSEY
17.     _PUTIMAGE (0, 0), back&
18.     LINE (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(0, 0, 0, 128), BF
19.     LINE (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(255, 255, 255, 200), B
20.     _PRINTSTRING (mx - 80, my - 80), "Use mouse - Move me"
21.     _DISPLAY
22.     _LIMIT 500
23. LOOP UNTIL INKEY$ <> ""
24.  
25. _FREEIMAGE back&
26.  

[bplus]

Spotlight reminds me of Colored Search Lights bouncing off each other:

Code: QB64: [Select]

1. _Title "Bouncing Search Lights" 'started 2019-04-28 B+, continued by Petr to REAL TEXT SCREEN :-D
2. 'continued by B+ with normal letter size :-))
3. ' 2019-04-29 another variation
4. ' 2019-04-29 now same as graphics mode!!! Thanks Petr!!!
5.  
6.  
7. 'this really text mode??? ;-))
8.  
9. Const xmax = 640
10. Const ymax = 400
11.  
12. Dim txt(1 To 25) As String, v(1 To 25)
13. For i = 1 To 25
14.     b$ = ""
15.     For j = 1 To 100
16.         b$ = b$ + Chr$(Int(Rnd * 96) + 32)
17.     Next
18.     txt(i) = b$: v(i) = Int(Rnd * 3) + 1
19. Next
20. balls = 15
21. Dim x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
22. For i = 1 To balls
23.     r(i) = rand(10, 65)
24.     x(i) = rand(r(i), xmax - r(i))
25.     y(i) = rand(r(i), ymax - r(i))
26.     c(i) = rand(1, 15)
27.     dx(i) = rand(1, 5) * rdir
28.     dy(i) = rand(1, 5) * rdir
29.     rr(i) = rand(150, 255)
30.     gg(i) = rand(150, 255)
31.     bb(i) = rand(150, 255)
32. Next
33. Bplus = _NewImage(xmax, ymax, 32)
34. _ScreenMove _Middle
35. While _KeyDown(27) = 0
36.     _Dest Bplus
37.     Cls
38.     For i = 1 To balls
39.         'ready for collision
40.         a(i) = _Atan2(dy(i), dx(i))
41.         power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
42.         imoved = 0
43.         For j = i + 1 To balls
44.             If Sqr((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) Then
45.                 imoved = 1
46.                 a(i) = _Atan2(y(i) - y(j), x(i) - x(j))
47.                 a(j) = _Atan2(y(j) - y(i), x(j) - x(i))
48.                 'update new dx, dy for i and j balls
49.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
50.                 power = (power1 + power2) / 2
51.                 dx(i) = power * Cos(a(i))
52.                 dy(i) = power * Sin(a(i))
53.                 dx(j) = power * Cos(a(j))
54.                 dy(j) = power * Sin(a(j))
55.                 x(i) = x(i) + dx(i)
56.                 y(i) = y(i) + dy(i)
57.                 x(j) = x(j) + dx(j)
58.                 y(j) = y(j) + dy(j)
59.                 Exit For
60.             End If
61.         Next
62.         If imoved = 0 Then
63.             x(i) = x(i) + dx(i)
64.             y(i) = y(i) + dy(i)
65.         End If
66.         If x(i) < r(i) Then dx(i) = -dx(i): x(i) = r(i)
67.         If x(i) > xmax - r(i) Then dx(i) = -dx(i): x(i) = xmax - r(i)
68.         If y(i) < r(i) Then dy(i) = -dy(i): y(i) = r(i)
69.         If y(i) > ymax - r(i) Then dy(i) = -dy(i): y(i) = ymax - r(i)
70.         For rad = r(i) To 0 Step -1
71.             fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 20)
72.         Next
73.     Next
74.  
75.     Color , _RGBA(0, 0, 0, 0)
76.     For i = 1 To 25
77.         txt(i) = Mid$(txt(i), v(i)) + Mid$(txt(i), 1, v(i) - 1)
78.         For l = 1 To 80
79.             If i Mod 2 Then midInk 60, 0, 0, 0, 0, 60, l / 80 Else midInk 0, 0, 60, 60, 0, 0, l / 80
80.             Locate i, l: Print Mid$(txt(i), l, 1);
81.         Next
82.     Next
83.  
84.     _Dest 0 'redirecting to text screen
85.  
86.     Himage = _CopyImage(Bplus, 33)
87.     _PutImage (0, 0)-(xmax, ymax), Himage, 0
88.     _Display
89.     _Limit 10
90.     _FreeImage Himage
91. Wend
92.  
93. Function rand (lo, hi)
94.     rand = (Rnd * (hi - lo + 1)) \ 1 + lo
95. End Function
96.  
97. Function rdir ()
98.     If Rnd < .5 Then rdir = -1 Else rdir = 1
99. End Function
100.  
101. Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
102.     Dim Radius As Integer, RadiusError As Integer
103.     Dim X As Integer, Y As Integer
104.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
105.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
106.     Line (CX - X, CY)-(CX + X, CY), C, BF
107.     While X > Y
108.         RadiusError = RadiusError + Y * 2 + 1
109.         If RadiusError >= 0 Then
110.             If X <> Y + 1 Then
111.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
112.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
113.             End If
114.             X = X - 1
115.             RadiusError = RadiusError - X * 2
116.         End If
117.         Y = Y + 1
118.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
119.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
120.     Wend
121. End Sub
122.  
123. Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
124.     Color _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
125. End Sub
126.  
127.  
128.  
129.  

[Pete]

On my SCREEN ZERO HERO laptop, there is considerable lag between the mouse and spotlight effect. My hunch is on that on faster machines like the one Mark has, the lag I experienced  may not be as noticeable. Since I don't do gaming, I have a CPU that moves at the speed of shite. It's so slow,even math calculation show some lag, but hey, that's fine for me, as I'm slow at math, anyway. What I noticed from a few test modifications it was the LINE statements being responsible for the lag. I'm not sure if a MEM routine could be substituted to speed things up.

Neat effect. It reminded of MS Magnifier.

Edited: This post is in reference to lag noticed in Dav's code and not the code bplus posted.

Pete

[bplus]

Pete try decreasing the number of balls=search lights there is a lot of calculations deciding ball collisions.

[Pete]

Oops, sorry Mark, I was referring to the lag in Dav's code. You and I were posting at the same time. I'll have a peek at your routine, now...

Okay, just tried it. I think I remember seeing that some time ago. Anyway, no noticeable lag in your rendition. Now I'm curious why the speed difference exists between your effect and Dav's.

Pete

[Dav]

Cool effect @bplus.  I don't remember seeing that one before, but I remember the fcirc function.  Your fcirc is so much faster than the method I used.  I just compared it using the replacement below and mine is so much slower. 

Edit: I wonder why that is?  There is so much more going on in the fcirc function...

- Dav

Code: QB64: [Select]

1.  
2.             'fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 20)
3.  
4.             FOR rrr = 1 TO rad STEP .4
5.                 CIRCLE (x(i), y(i)), rrr, _RGBA32(rr(i), gg(i), bb(i), 20)
6.             NEXT
7.  

[bplus]

Oops, sorry Mark, I was referring to the lag in Dav's code. You and I were posting at the same time. I'll have a peek at your routine, now...

Okay, just tried it. I think I remember seeing that some time ago. Anyway, no noticeable lag in your rendition. Now I'm curious why the speed difference exists between your effect and Dav's.

Pete

That is curious! If I recall Dav is using a slower machine or older version of Windows or ... some difference with my system. My machine is going on 5 years old I think the bootup has gone from nearly instant to about 5 minutes now!

[bplus]

Cool effect @bplus.  I don't remember seeing that one before, but I remember the fcirc function.  Your fcirc is so much faster than the method I used.  I just compared it using the replacement below and mine is so much slower. 

Edit: I wonder why that is?  There is so much more going on in the fcirc function...

- Dav

Code: QB64: [Select]

1.  
2.             'fcirc x(i), y(i), rad, _RGBA32(rr(i), gg(i), bb(i), 20)
3.  
4.             FOR rrr = 1 TO rad STEP .4
5.                 CIRCLE (x(i), y(i)), rrr, _RGBA32(rr(i), gg(i), bb(i), 20)
6.             NEXT
7.  

That's the Gold Standard Circle Fill for QB64 (it's in the Utility's section of Samples in Library along with Ellipse work as well), Steve first introduced it to us some time ago. It has been compared to filling with Circle Loop and Paint and comes out ahead in speed hands down!

Plus if you use alpha coloring there is 0 overlap unlike using a circle in a loop (use get a light line cross sort of like my current avatar).

[bplus]

Is this faster for Dav's code?

Code: QB64: [Select]

1.  
2. Screen _NewImage(640, 640, 32)
3. _Display
4. For p = 1 To 1000
5.     Print Rnd * 100;
6. Next
7.  
8. 'fake a spotlight...
9. For x = .75 * _Width To 0 Step -.4
10.     Circle (_Width / 2, _Height / 2), x, _RGB32(0, 0, 0, x)
11. Next
12. _Display
13. back& = _CopyImage(_Display)
14.  
15. Do
16.     m = _MouseInput: mx = _MouseX: my = _MouseY
17.     _PutImage (0, 0), back&
18.     Line (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(0, 0, 0, 128), BF
19.     Line (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(255, 255, 255, 200), B
20.     _PrintString (mx - 80, my - 80), "Use mouse - Move me"
21.     _Display
22.     _Limit 500
23. Loop Until InKey$ <> ""
24.  
25. _FreeImage back&
26.  
27.  
28.  

[bplus]

Here is a Circle Fill using Circle in a loop for an Alpha color:

Code: QB64: [Select]

1. Screen _NewImage(640, 640, 32)
2.  
3. For x = .35 * _Width To 0 Step -.25
4.     Circle (_Width / 2, _Height / 2), x, _RGB32(255, 255, 255, 80)
5. Next
6.  

End up with all sorts of shades, nice pattern though.

[Pete]

Mark, the modifications to Dav's code made no appreciable speed difference on my laptop. I figured out the difference is in the mouse routine. 

This code fixes the lag issue...

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 640, 32)
2.  
3. FOR p = 1 TO 1000
4.     PRINT RND * 100;
5. NEXT
6.  
7. 'fake a spotlight...
8. FOR x = 0 TO _WIDTH + (_WIDTH / 3) STEP .3
9.     CIRCLE (_WIDTH / 2, _HEIGHT / 2), x, _RGBA(0, 0, 0, x / 2)
10. NEXT
11.  
12. back& = _COPYIMAGE(_DISPLAY)
13.  
14. DO
15.     m = _MOUSEINPUT: mx = _MOUSEX: my = _MOUSEY
16.     IF mx <> oldmx OR my <> oldmy THEN
17.         oldmx = mx: oldmy = my
18.         _PUTIMAGE (0, 0), back&
19.         LINE (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(0, 0, 0, 128), BF
20.         LINE (mx - 100, my - 100)-(mx + 100, my + 100), _RGBA(255, 255, 255, 200), B
21.         _PRINTSTRING (mx - 80, my - 80), "Use mouse - Move me"
22.         _DISPLAY
23.     END IF
24.     _LIMIT 500
25. LOOP UNTIL INKEY$ <> ""
26.  
27. _FREEIMAGE back&
28.  

It only calls _DISPLAY if the mouse is moved.

BTW: Working on that CIRCLE / ELLIPSE routine was a kick. Glad to see it's still considered the "Gold Standard."

Pete

[johnno56]

I do not know which book you guys are reading, but in my book, I do not consider these effects as 'cheep-o'. They are brilliant! Well done!