Neverending loop

[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