Why does this program break QB64?

[STxAxTIC]

I was minding my own business, trying to make a little Paint-like clone... Except when I run this code, nothing really happens - but the QB64 window itself seems to slow way down, like I can't drag things around anymore. Any clues?

Code: QB64: [Select]

1. OPTION _EXPLICIT
2.  
3. DO UNTIL _SCREENEXISTS: LOOP
4. _TITLE "PlasmaDoodle"
5.  
6. ' Hardware
7. 'SCREEN _NEWIMAGE(1024, 768, 32)
8.  
9. DIM Desktop AS _UNSIGNED LONG
10. Desktop = _SCREENIMAGE
11. SCREEN _NEWIMAGE(_WIDTH(Desktop), _HEIGHT(Desktop), 32)
12. _FULLSCREEN
13. _PUTIMAGE (0, 0), Desktop
14.  
15. ' Constants
16. DIM SHARED pi AS DOUBLE
17. pi = 4 * ATN(1)
18.  
19. ' Structures and variables
20. TYPE ShadeVector
21.     VelocityRed AS INTEGER
22.     VelocityGreen AS INTEGER
23.     VelocityBlue AS INTEGER
24. END TYPE
25.  
26. DIM SHARED MainPhase(_WIDTH, _HEIGHT) AS ShadeVector
27.  
28. DIM i AS DOUBLE
29. DIM j AS DOUBLE
30.  
31. DIM r AS INTEGER
32. DIM g AS INTEGER
33. DIM b AS INTEGER
34.  
35. DIM p AS DOUBLE
36. DIM q AS DOUBLE
37. DIM w AS INTEGER
38.  
39. RANDOMIZE TIMER
40.  
41. 'FOR i = 1 TO 350
42. '    p = RND * _WIDTH
43. '    q = RND * _HEIGHT
44. '    CIRCLE (p - 50, q - 50), 100, _RGB32(RND * 255, RND * 255, RND * 255, RND * 255)
45. '    LINE (100, 100)-(300, 300), _RGB32(255, 155, 0, 255), BF
46. 'NEXT
47.  
48. _DISPLAY
49.  
50. FOR i = 1 TO _WIDTH
51.     FOR j = 1 TO _HEIGHT
52.         MainPhase(i, j).VelocityRed = 9
53.         MainPhase(i, j).VelocityGreen = 8
54.         MainPhase(i, j).VelocityBlue = 7
55.     NEXT
56. NEXT
57.  
58. DIM t2
59. DIM mx
60. DIM my
61.  
62. ' Main loop
63. DO
64.     DO WHILE _MOUSEINPUT
65.         mx = _MOUSEX
66.         my = _MOUSEY
67.         IF _MOUSEBUTTON(1) THEN
68.             GOSUB DrawIt
69.         END IF
70.     LOOP
71.  
72.     _DISPLAY
73.     _LIMIT 60
74. LOOP
75.  
76. ' Graphics
77. DrawIt:
78. FOR i = mx - 40 TO mx + 40
79.     FOR j = my - 40 TO my + 40
80.         IF ((i > 0) AND (i < _WIDTH) AND (j > 0) AND (j < _HEIGHT)) THEN
81.             t2 = (i - mx) * (i - mx) + (j - my) * (j - my)
82.             'IF (t2 < 1600) THEN
83.             r = _RED32(POINT(i, j))
84.             g = _GREEN32(POINT(i, j))
85.             b = _BLUE32(POINT(i, j))
86.             p = MainPhase(i, j).VelocityRed
87.             q = MainPhase(i, j).VelocityGreen
88.             w = MainPhase(i, j).VelocityBlue
89.             r = r + p
90.             IF (r > 255) OR (r < 1) THEN MainPhase(i, j).VelocityRed = -p
91.             g = g + q
92.             IF (g > 255) OR (g < 1) THEN MainPhase(i, j).VelocityGreen = -q
93.             b = b + w
94.             IF (b > 255) OR (b < 1) THEN MainPhase(i, j).VelocityBlue = -w
95.             PSET (i, j), _RGB32(r, g, b, 255 * (1 - t2 / 1600))
96.             'END IF
97.         END IF
98.     NEXT
99. NEXT
100. RETURN
101.  

[bplus]

Strange radioactive glowing around Windows Toolbar button and red box X I clicked, v weird!

[bplus]

Code: QB64: [Select]

1. _PUTIMAGE (0, 0), Desktop
2.  

Oh ha! it's a prank!

 

[Pete]

My recommendation would be to change the _MOUSEBUTTON(1) part. Don't let the program keep looping, just because the mouse button is depressed. Drags are accomplished by detecting motion, so add that condition.

In stead of...

 IF _MOUSEBUTTON(1) THEN
        GOSUB DrawIt
 END IF

-----------------

 IF _MOUSEBUTTON(1) THEN
     IF oldmy <> my or oldmx <> mx THEN
            GOSUB DrawIt
     END IF
 END IF

old mx = mx: old my = my

--------------------------------------------------------

That's my 2-cents. I don't do graphics, so I didn't try it out. If you do try it, and it works, just drop a thank you off with 2-million dollars in bitcoin to my dropbox account.

Pete

[bplus]

Yeah Pete the 2nd time I tried it I put a delay on if mb to wait until button released before processing and also an immediate end of program with any keypress in processing loop...

but it's a prank ;-))

[STxAxTIC]

It looks like my screen is breaking!

[Dav]

Lol. I ran it. Had me fooled for a sec.  Neat effect.

- Dav

[Pete]

Yeah Pete the 2nd time I tried it I put a delay on if mb to wait until button released before processing and also an immediate end of program with any keypress in processing loop...

but it's a prank ;-))

Yeah, mouse handling needs more than just single button detection. I use this, or similar code...

Code: QB64: [Select]

1.             IF clicked_l% = 0 THEN
2.                 IF mb.l% THEN
3.                     clicked_l% = -1
4.                 ELSE
5.                     IF clicked_l% = -1 THEN clicked_l% = 1
6.                 END IF
7.             ELSE
8.                 IF mb.l% = 0 THEN
9.                     IF clicked_l% = -2 THEN clicked_l% = 0 ELSE clicked_l% = 1
10.                 END IF
11.             END IF

The -2 setting is for a case where a click in a previous routine activates a process but it needs to stay active until another click takes place. The other values ,-1, 0, and 1 allow for the process to complete only after the left mouse button is released. Notepad uses a similar technique. Click "File" and without a release, the file window will pop up. You can then then move the mouse, either with the button still down or up, and it will highlight the corresponding menu selections. Press the mouse button down on a selection... but wait, that selection will not process until the left mouse button is released.

I consider myself not only a SCREEN Zero Hero, but also the King of Drag, but if Bill puts his mind to it, he could become a close second. Hey, that would make Bill the drag queen around here. Well at least now I know why he supports QB64 as a cross-platform language.

Pete

[OldMoses]

Suddenly I had this feeling that I was in Pepperland.

[Petr]

Hi. I really like the solution of the circle using the alpha channel. It's a math nut. The main question, as I understood it, was speed. So I tried to modify and speed up the program. To do this, I needed to clean up my old research on the topic: How the hell does alpha channel work. And I remembered. Here is the result. It's a bit faster, it doesn't use either POINT or PSET, but only MEM and it uses the calculated alpha channel. The way graphic commands do it for us.

Code: QB64: [Select]

1. 'original author: STxAxTIC
2. 'Petr's  speed up modification
3.  
4. DIM Desktop AS _UNSIGNED LONG
5. Desktop = _SCREENIMAGE
6. DO UNTIL _SCREENEXISTS: LOOP
7. _TITLE "PlasmaDoodle"
8.  
9. SCREEN _NEWIMAGE(_WIDTH(Desktop), _HEIGHT(Desktop), 32)
10. _FULLSCREEN
11. _PUTIMAGE (0, 0), Desktop
12.  
13. ' Constants
14. DIM SHARED pi AS DOUBLE
15. pi = 4 * ATN(1)
16.  
17. ' Structures and variables
18. TYPE ShadeVector
19.     VelocityRed AS INTEGER
20.     VelocityGreen AS INTEGER
21.     VelocityBlue AS INTEGER
22. END TYPE
23.  
24. DIM SHARED MainPhase(_WIDTH, _HEIGHT) AS ShadeVector
25.  
26. DIM i AS DOUBLE
27. DIM j AS DOUBLE
28.  
29. DIM r AS _UNSIGNED _BYTE
30. DIM g AS _UNSIGNED _BYTE
31. DIM b AS _UNSIGNED _BYTE
32.  
33. DIM rOld AS _UNSIGNED _BYTE
34. DIM gOld AS _UNSIGNED _BYTE
35. DIM bOld AS _UNSIGNED _BYTE
36.  
37.  
38. DIM p AS DOUBLE
39. DIM q AS DOUBLE
40. DIM w AS INTEGER
41.  
42. DIM NC AS _UNSIGNED LONG
43. DIM m AS _MEM
44. m = _MEMIMAGE(0)
45.  
46. RANDOMIZE TIMER
47.  
48. 'FOR i = 1 TO 350
49. '    p = RND * _WIDTH
50. '    q = RND * _HEIGHT
51. '    CIRCLE (p - 50, q - 50), 100, _RGB32(RND * 255, RND * 255, RND * 255, RND * 255)
52. '    LINE (100, 100)-(300, 300), _RGB32(255, 155, 0, 255), BF
53. 'NEXT
54.  
55. '_DISPLAY
56.  
57. FOR i = 1 TO _WIDTH
58.     FOR j = 1 TO _HEIGHT
59.         MainPhase(i, j).VelocityRed = 1
60.         MainPhase(i, j).VelocityGreen = 2
61.         MainPhase(i, j).VelocityBlue = 3
62.     NEXT
63. NEXT
64.  
65. DIM t2
66. DIM mx
67. DIM my
68.  
69. ' Main loop
70. DO UNTIL _KEYHIT = 27
71.     WHILE _MOUSEINPUT: WEND
72.     mx = _MOUSEX
73.     my = _MOUSEY
74.     IF _MOUSEBUTTON(1) THEN GOSUB DrawIt
75.  
76.  
77.     '    _DISPLAY
78.     _LIMIT 60
79. LOOP
80. _MEMFREE m
81.  
82.  
83.  
84. ' Graphics
85. DrawIt:
86. FOR i = mx - 40 TO mx + 40
87.     FOR j = my - 40 TO my + 40
88.         IF ((i > 0) AND (i < _WIDTH) AND (j > 0) AND (j < _HEIGHT)) THEN
89.             t2 = (i - mx) * (i - mx) + (j - my) * (j - my)
90.  
91.             'IF (t2 < 1600) THEN
92.             '                                                                             POINT is too slow
93.             _MEMGET m, m.OFFSET + IN(i, j) + 2, r
94.             _MEMGET m, m.OFFSET + IN(i, j) + 1, g
95.             _MEMGET m, m.OFFSET + IN(i, j), b
96.             rOld = r
97.             gOld = g
98.             bOld = b
99.  
100.             p = MainPhase(i, j).VelocityRed
101.             q = MainPhase(i, j).VelocityGreen
102.             w = MainPhase(i, j).VelocityBlue
103.             r = r + p
104.             IF (r > 255) OR (r < 1) THEN MainPhase(i, j).VelocityRed = -p
105.             g = g + q
106.             IF (g > 255) OR (g < 1) THEN MainPhase(i, j).VelocityGreen = -q
107.             b = b + w
108.             IF (b > 255) OR (b < 1) THEN MainPhase(i, j).VelocityBlue = -w
109.             NC~& = _RGBA32(r, g, b, 255 * (1 - t2 / 1600))
110.  
111.             'PSET (i, j), _RGB32(r, g, b, 255 * (1 - t2 / 1600))                          PSET is too slow
112.  
113.  
114.             REDIM alfa AS _UNSIGNED _BYTE, af AS DOUBLE, newerest AS _UNSIGNED LONG
115.             alfa = 255 * (1 - t2 / 1600)
116.             af = alfa / 255
117.  
118.             'for circle effect  must be R, G, B values recaltulated with alfa first:
119.             MEMALPHA _RGBA32(rOld, gOld, bOld, 255), NC~&, newerest~&
120.             _MEMPUT m, m.OFFSET + IN(i, j), newerest~&
121.         END IF
122.     NEXT
123. NEXT
124. RETURN
125.  
126. FUNCTION IN& (x, y)
127.     IN& = 4 * (_WIDTH * y + x)
128. END FUNCTION
129.  
130. SUB MEMALPHA (oldColor~&, newColor~&, ResultColor~&)
131.     NewR = _RED32(newColor~&)
132.     NewG = _GREEN32(newColor~&)
133.     NewB = _BLUE32(newColor~&)
134.     NewA = _ALPHA32(newColor~&)
135.  
136.     NovaAlfa = NewA / 255 '                 new alpha channel value
137.  
138.     oldR = _RED32(oldColor~&)
139.     oldG = _GREEN32(oldColor~&)
140.     oldB = _BLUE32(oldColor~&)
141.  
142.     NstaraR = oldR * ((255 - NewA) / 255) ' Recalculate old (background) color with alpha channel (255 is always background value minus alpha from new color) -> in MEM use, if is image draw to untransparent background
143.     NstaraG = oldG * ((255 - NewA) / 255)
144.     NstaraB = oldB * ((255 - NewA) / 255)
145.  
146.     NnovaR = NewR * NovaAlfa 'Recalculate new (foreground) color
147.     NnovaG = NewG * NovaAlfa
148.     NnovaB = NewB * NovaAlfa
149.  
150.     VysR = NnovaR + NstaraR 'output values, tested using MEM and POINT
151.     VysG = NnovaG + NstaraG
152.     VysB = NnovaB + NstaraB
153.  
154.     ResultColor~& = _RGB32(VysR, VysG, VysB)
155. END SUB
156.  

[STxAxTIC]

Thanks Petr for having a look at this!

Did you see the new code in the "PlasmaDoodle" thread? It's basically the same - your edits are not in vain!