Neverending loop

[TempodiBasic]

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).

[bplus]

Thanks TempodiBasic fine also to see you back in action here!

[Kernelpanic]

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

[admin]

@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.

[Kernelpanic]

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

[TempodiBasic]

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