Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: STxAxTIC on December 29, 2020, 04:00:46 pm

Title: Why does this program break QB64?
Post by: STxAxTIC on December 29, 2020, 04:00:46 pm
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]
  2.  
  4. _TITLE "PlasmaDoodle"
  5.  
  6. ' Hardware
  7. 'SCREEN _NEWIMAGE(1024, 768, 32)
  8.  
  10. Desktop = _SCREENIMAGE
  11. SCREEN _NEWIMAGE(_WIDTH(Desktop), _HEIGHT(Desktop), 32)
  13. _PUTIMAGE (0, 0), Desktop
  14.  
  15. ' Constants
  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
  25.  
  26. DIM SHARED MainPhase(_WIDTH, _HEIGHT) AS ShadeVector
  27.  
  30.  
  34.  
  38.  
  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.  
  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
  57.  
  58. DIM t2
  59. DIM mx
  60. DIM my
  61.  
  62. ' Main loop
  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
  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
  101.  
Title: Re: Why does this program break QB64?
Post by: bplus on December 29, 2020, 05:13:24 pm
Strange radioactive glowing around Windows Toolbar button and red box X I clicked, v weird!
Title: Re: Why does this program break QB64?
Post by: bplus on December 29, 2020, 05:35:12 pm
Code: QB64: [Select]
  1. _PUTIMAGE (0, 0), Desktop
  2.  

Oh ha! it's a prank!

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Why does this program break QB64?
Post by: Pete on December 29, 2020, 05:37:45 pm
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
Title: Re: Why does this program break QB64?
Post by: bplus on December 29, 2020, 05:41:35 pm
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 ;-))
Title: Re: Why does this program break QB64?
Post by: STxAxTIC on December 29, 2020, 06:02:03 pm
It looks like my screen is breaking!
Title: Re: Why does this program break QB64?
Post by: Dav on December 29, 2020, 06:38:43 pm
Lol. I ran it. Had me fooled for a sec.  Neat effect.

- Dav
Title: Re: Why does this program break QB64?
Post by: Pete on December 29, 2020, 06:39:03 pm
Quote from: bplus on December 29, 2020, 05:41:35 pm
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
Title: Re: Why does this program break QB64?
Post by: OldMoses on December 29, 2020, 07:51:51 pm
Suddenly I had this feeling that I was in Pepperland.
Title: Re: Why does this program break QB64?
Post by: Petr on December 30, 2020, 11:00:56 am
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.  
  5. Desktop = _SCREENIMAGE
  7. _TITLE "PlasmaDoodle"
  8.  
  9. SCREEN _NEWIMAGE(_WIDTH(Desktop), _HEIGHT(Desktop), 32)
  11. _PUTIMAGE (0, 0), Desktop
  12.  
  13. ' Constants
  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
  23.  
  24. DIM SHARED MainPhase(_WIDTH, _HEIGHT) AS ShadeVector
  25.  
  28.  
  32.  
  36.  
  37.  
  41.  
  44. m = _MEMIMAGE(0)
  45.  
  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
  64.  
  65. DIM t2
  66. DIM mx
  67. DIM my
  68.  
  69. ' Main loop
  72.     mx = _MOUSEX
  73.     my = _MOUSEY
  74.     IF _MOUSEBUTTON(1) THEN GOSUB DrawIt
  75.  
  76.  
  77.     '    _DISPLAY
  78.     _LIMIT 60
  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
  125.  
  126. FUNCTION IN& (x, y)
  127.     IN& = 4 * (_WIDTH * y + x)
  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)
  156.  
Title: Re: Why does this program break QB64?
Post by: STxAxTIC on December 30, 2020, 11:04:25 am
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!
Text Only | Text with Attachments