Posts: 324
Threads: 20
Joined: Jul 2022
Reputation:
16
(07-30-2022, 05:02 AM)bplus Wrote: It does finish but takes longer than expected and never expected little tiny bitty message in red in top left corner. What Pete said! ;-))
This explains what happened visually by making something invisible, visible, I think?
Code: (Select All) Option _Explicit
Screen _NewImage(1280, 700, 32)
$Color:32
Dim As Long f
f = _LoadFont("courbd.ttf", 128, "monospace")
_Font f
Color Red, White
_PrintString (284, 200), "Steve is" '284 - 644
_PrintString (284, 328), "Awesome!"
Sleep
_Font 8
Explode 284, 200, 644, 456, 16, 16
Print "FINISHED!!"
Sub Explode (x1, y1, x2, y2, pw, ph)
Dim As Long finished, tempscreen
Dim w, h, ax, ay, cx, cy, x, y
tempscreen = _NewImage(_Width, _Height, 32)
_PutImage , 0, tempscreen
w = x2 - x1 + 1: h = y2 - y1 + 1
ax = 2 * w \ pw + 1: ay = 2 * h \ ph + 1
cx = x1 + w \ 2: cy = y1 + h \ 2
Type box
x As Single
y As Single
handle As Long
rotation As Single
changex As Single
changey As Single
End Type
Dim Array(0 To ax, 0 To ay) As box
For x = 0 To ax
For y = 0 To ay
Array(x, y).handle = _NewImage(pw, ph, 32)
Array(x, y).x = x1 + pw * x
Array(x, y).y = y1 + ph * y
_PutImage , 0, Array(x, y).handle, (x1 + pw * x, y1 + ph * y)-Step(pw, ph)
Array(x, y).changex = -(cx - Array(x, y).x) / 10
Array(x, y).changey = -(cy - Array(x, y).y) / 10
Next
Next
Do
Cls , 0
finished = 1
For x = 0 To ax
For y = 0 To ay
Array(x, y).x = Array(x, y).x + Array(x, y).changex
Array(x, y).y = Array(x, y).y + Array(x, y).changey
If (Array(x, y).x >= 0 And Array(x, y).y >= 0) Then
If Array(x, y).x <= _Width And Array(x, y).y <= _Height Then
finished = 0
End If
End If
_PutImage (Array(x, y).x, Array(x, y).y)-Step(pw, ph), Array(x, y).handle, 0, (0, 0)-(pw, ph)
Next
Next
_Display
_Limit 60
Loop Until finished
_AutoDisplay
End Sub
Hi Bplus
yes I find fine the snippet posted by Steve and finer the waited result error of coder... invisible background doesn't let see what really it happens.
Good debug about analysis of flow of code and its output!
The running away of boxes from the center of the screen is not regular and equal, but the far away pieces are speeder than the center pieces
...
fine to see also if you let run away only in horizontal or vertical dimension (this situation catches really an infinite loop).
Posts: 3,802
Threads: 173
Joined: Apr 2022
Reputation:
196
Thanks TempodiBasic fine also to see you back in action here!
b = b + ...
Posts: 1,002
Threads: 50
Joined: May 2022
Reputation:
25
Even if there was no serious bug in the program, it was interesting to correct the non-bugs a bit.
Code: (Select All) Screen _NewImage(1280, 720, 32)
$Color:32
f = _LoadFont("courbd.ttf", 128, "monospace")
_Font f
Color Red, Transparent
_PrintString (284, 200), "Steve was" '284 - 644
_PrintString (414, 328), "here!"
Sleep
_Font 8
Explode 284, 200, 644, 456, 16, 16
'Print "FINISHED!!"
Color Yellow
myFont = _LoadFont("C:\Windows\Fonts\Dauphinn.ttf", 75, "")
_Font myFont
_PrintString (315, 328), "F I N I S H E D !!"
'Farbe und Schrift zuruecksetzen
Color _RGB32(255), _RGB32(0, 0, 0)
_Font 16
_FreeFont f
End 'Hauptprogramm
Sub Explode (x1, y1, x2, y2, pw, ph)
tempScreen = _NewImage(_Width, _Height, 32)
_PutImage , 0, tempScreen
w = x2 - x1 + 1: h = y2 - y1 + 1
ax = 2 * w \ pw + 1: ay = 2 * h \ ph + 1
cx = x1 + w \ 2: cy = y1 + h \ 2
Type box
x As Single
y As Single
handle As Long
rotation As Single
changex As Single
changey As Single
End Type
Dim Array(0 To ax, 0 To ay) As box
For x = 0 To ax
For y = 0 To ay
Array(x, y).handle = _NewImage(pw, ph, 32)
Array(x, y).x = x1 + pw * x
Array(x, y).y = y1 + ph * y
_PutImage , 0, Array(x, y).handle, (x1 + pw * x, y1 + ph * y)-Step(pw, ph)
Array(x, y).changex = -(cx - Array(x, y).x) / 10
Array(x, y).changey = -(cy - Array(x, y).y) / 10
Next
Next
Do
Cls , 0
finished = -1
For x = 0 To ax
For y = 0 To ay
Array(x, y).x = Array(x, y).x + Array(x, y).changex
Array(x, y).y = Array(x, y).y + Array(x, y).changey
If Array(x, y).x >= 0 And Array(x, y).y >= 0 And _
Array(x, y).x <= _Width And Array(x, y).y <= _Height Then finished = 0
_PutImage (Array(x, y).x, Array(x, y).y)-Step(pw, ph), Array(x, y).handle, 0, (0, 0)-(pw, ph)
Next
Next
_Display
'_Limit 60 'Abschalten und es laeuft korrekt
Loop Until finished
_AutoDisplay
End Sub
Posts: 89
Threads: 19
Joined: Apr 2022
Reputation:
14
@KernelPanic As I mentioned, the code *as written* has no bugs in it -- but it does, indeed, have the potential to become an endless loop. Let me illustrate how:
***
***
***
Now, imagine I print the above in _FONT 8. Font 8 is perfectly square -- 8 pixels wide, 8 pixels high.
Now, also imagine that it's centered on the screen and I decide to explode it in 8x8 boxes.
Explosion speed is calculated as the distance from the center...
How far would that 2nd * on the 2nd row be from the center??
0.0 pixels!! It is *exactly* centered, so its movement speed would become 0.
If it never moves, it'll never clear the screen, resulting in an endless loop.
As written, the code truly isn't bugged -- but it has the potential to become so with the proper data set.
If one wanted to "fix" it, the best way would be to add a line for a movement check:
IF Array(x, y).changex + Array(x, y).changey < 1 THEN .... not enough movement, do some fixing!
Then you can choose whatever method you like to fix the issue. Evaporate the block. Explode it off in a random "richotte" direction. Whatever fix floats your boat to make certain movement is always not so low that it causes insufferable program delay. 
Posts: 1,002
Threads: 50
Joined: May 2022
Reputation:
25
08-02-2022, 07:51 PM
(This post was last modified: 08-02-2022, 07:51 PM by Kernelpanic.)
Quote:Now, also imagine that it's centered on the screen and I decide to explode it in 8x8 boxes.
Explosion speed is calculated as the distance from the center...
How far would that 2nd * on the 2nd row be from the center??
0.0 pixels!! It is *exactly* centered, so its movement speed would become 0.
If it never moves, it'll never clear the screen, resulting in an endless loop.
Yes, I know there was no (real) bug in the code - that was meant ironically.
I have to see the other one first - better try it out.
This doesn't work for me, or I misunderstood something.
Code: (Select All) Color Red, Transparent
_PrintString (284, 200), "***" '284 - 644
_PrintString (284, 328), "***"
_PrintString (284, 456), "***"
Sleep
_Font 8
![[Image: Loop-ohne-Ende.jpg]](https://i.ibb.co/mtF48TK/Loop-ohne-Ende.jpg)
Posts: 324
Threads: 20
Joined: Jul 2022
Reputation:
16
Hi
about the too slow speed of central blocks that waste time miming an endless loop (really only more long than one expected)
I think that blocks must use an incremental speed and not a fixed speed.
Using a fixed speed we need a greater one, and the explosion vanish too early.
Code: (Select All) Sub Explode (x1, y1, x2, y2, pw, ph)
tempScreen = _NewImage(_Width, _Height, 32)
_PutImage , 0, tempScreen
w = x2 - x1 + 1: h = y2 - y1 + 1
ax = 2 * w \ pw + 1: ay = 2 * h \ ph + 1
cx = x1 + w \ 2: cy = y1 + h \ 2
Type box
x As Single
y As Single
handle As Long
rotation As Single
changex As Single
changey As Single
End Type
Dim Array(0 To ax, 0 To ay) As box
For x = 0 To ax
For y = 0 To ay
Array(x, y).handle = _NewImage(pw, ph, 32)
Array(x, y).x = x1 + pw * x
Array(x, y).y = y1 + ph * y
_PutImage , 0, Array(x, y).handle, (x1 + pw * x, y1 + ph * y)-Step(pw, ph)
Next
Next
Do
Cls , 0
finished = -1
For x = 0 To ax
For y = 0 To ay
Array(x, y).changex = -(cx - Array(x, y).x) / 10
Array(x, y).changey = -(cy - Array(x, y).y) / 10
[size=1][font=Monaco, Consolas, Courier, monospace] Array(x, y).ch[/font][/size]
Array(x, y).x = Array(x, y).x + Array(x, y).changex
Array(x, y).y = Array(x, y).y + Array(x, y).changey
If Array(x, y).x >= 0 And Array(x, y).y >= 0 And _
Array(x, y).x <= _Width And Array(x, y).y <= _Height Then finished = 0
'If Array(x, y).x >= 0 And Array(x, y).y >= 0 And Array(x, y).x <= _Width / 4 And Array(x, y).y <= _Height / 2 Then finished = 0 ' Pete solution
_PutImage (Array(x, y).x, Array(x, y).y)-Step(pw, ph), Array(x, y).handle, 0, (0, 0)-(pw, ph)
Next
Next
_Display
_Limit 60
Loop Until finished
_AutoDisplay
End Sub
|
