11-08-2022, 03:54 AM
This demo code hangs up about 25% of the time, I can't close it, have to do kill it with the task manager to stop it. Dunno why. It only happens when the _ALPHA & _RGBA32 is used in the drawBall SUB. When I revert to the original SUB it never hangs. Any ideas? Using 32-bit version of QB64PE on Windows 7.
- Dav
- Dav
Code: (Select All)
'ShakyBalls.bas by Dav, NOV/2022
'This program seems to hang for me 25% of the time (Can't close it).
'Dunno why. It started hanging after I added the _ALPHA/_RGBA32
'capabilty to the drawBall SUB. It doesn't hang when it's removed.
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
Balls = 300
DIM Ballx(Balls), Bally(Balls), Ballclr(Balls), Ballsize(Balls)
FOR d = 1 TO Balls
Ballx(d) = RND * _WIDTH
Bally(d) = RND * _HEIGHT
Ballclr(d) = _RGBA(RND * 255, RND * 255, RND * 255, 2 + RND * 10)
Ballsize(d) = 25 + (RND * 25)
NEXT
DO
CLS , _RGB(200, 200, 255)
FOR d = 1 TO Balls STEP 2
IF INT(RND * 2) = 0 THEN Ballx(d) = Ballx(d) + 2 ELSE Ballx(d) = Ballx(d) - 2
IF INT(RND * 2) = 0 THEN Bally(d) = Bally(d) + 2 ELSE Bally(d) = Bally(d) - 2
IF Ballx(d) > _WIDTH + Ballsize(d) THEN Ballx(d) = -Ballsize(d)
IF Ballx(d) < -Ballsize(d) THEN Ballx(d) = _WIDTH + Ballsize(d)
IF Bally(d) > _HEIGHT + Ballsize(d) THEN Bally(d) = -Ballsize(d)
IF Bally(d) < -Ballsize(d) THEN Bally(d) = _HEIGHT + Ballsize(d)
drawBall Ballx(d), Bally(d), Ballsize(d), Ballclr(d)
NEXT
_DISPLAY
_LIMIT 60
LOOP
SUB drawBall (x, y, r, c AS _UNSIGNED LONG)
DIM rred AS LONG, grn AS LONG, blu AS LONG, rr AS LONG, f
rred = _RED32(c): grn = _GREEN32(c): blu = _BLUE32(c): a = _ALPHA(c)
FOR rr = r TO 0 STEP -1
f = 1 - rr / r
fcirc x, y, rr, _RGBA32(rred * f, grn * f, blu * f, a)
NEXT
END SUB
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
DIM Radius AS LONG, RadiusError AS LONG
DIM X AS LONG, Y AS LONG
Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB