Un dessin rapide ... en mode screen

[fweil]

Bon je révèle pas des secrets d'état ... juste une bonne prise de tête que je me suis fait à la suite d'un post sur le forum EN.

Pour ceux que ça intéresse, ça valait le coup : http://purebasic.myforums.net/viewtopic.php?t=11359

Le principe est de tracer des carrés qui changent de couleur en fonction de la position d'un curseur en forme de croix.

Le code ci-dessous apporte une solution très rapide pour le tracé d'horizontales et de verticales.

L'effet est sympa pour faire un .scr

Code : Tout sélectionner

Global DrawingBuffer.l, DrawingBufferPitch.l, NPoints.l, NLines.l, NBoxes.l

Procedure DrawHLine(X1.l, X2.l, Y.l, Color)
  *Address.LONG = DrawingBufferPitch * Y + DrawingBuffer + 4 * X1
  For X = X1 To X2
    *Address\l = Color
    *Address.LONG + 4
    NPoints + 1
  Next
  NLines + 1
EndProcedure

Procedure DrawVLine(X.l, Y1.l, Y2.l, Color)
  *Address.LONG = DrawingBufferPitch * Y1 + DrawingBuffer + 4 * X
  For Y = Y1 To Y2
    *Address\l = Color
    *Address.LONG + DrawingBufferPitch
    NPoints + 1
  Next
  NLines + 1
EndProcedure

Procedure DrawBox(X1.l, Y1.l, X2.l, Y2.l, Color.l)
  DrawVLine(x1, y1, y2, Color)
  DrawHLine(x1, x2, y1, Color)
  DrawHLine(x1, x2, y2, Color)
  DrawVLine(x2, y1, y2, Color)
  NBoxes + 1
EndProcedure

Dim MyColorBox.l(1024, 768)

  CrossX = 0
  CrossY = 0
  CrossXS = 4
  CrossYS = 4
  SquareSize = 8
  ScreenXSize = 1024
  ScreenYSize = 768
  ScreenDepth = 32
  If InitSprite() And InitKeyboard() And InitMouse() And OpenScreen(ScreenXSize, ScreenYSize, ScreenDepth, "")
      Repeat
        FlipBuffers(0)
        ClearScreen(0, 0, 0)
        StartDrawing(ScreenOutput())
          DrawingBuffer = DrawingBuffer()
          DrawingBufferPitch = DrawingBufferPitch()
          For X = 0 To ScreenXSize
            For Y = 0 To ScreenYSize
              x1 = X
              y1 = Y
              x2 = x1 + SquareSize - 1
              y2 = y1 + SquareSize - 1
              If MyColorBox(X, Y) = 0
                  If CrossX = X Or CrossY = Y
                      MyColorBox(X, Y) = 255 - Random(255)
                  EndIf
                  Color = MyColorBox(X, Y) + $003200
                  DrawBox(x1, y1, x2, y2, Color)
                Else
                  Color = MyColorBox(X, Y) + $006400
                  DrawBox(x1, y1, x2, y2, Color)
                  MyColorBox(X, Y) - 2
                  If MyColorBox(X, Y) < 0
                      MyColorBox(X, Y) = 0
                  EndIf
                  If CrossX = X Or CrossY = Y
                      MyColorBox(X, Y) = 255 - Random(255)
                  EndIf
              EndIf
              Y + SquareSize - 1
            Next
            X + SquareSize - 1
          Next
          DrawHLine(0, ScreenXSize, CrossY + SquareSize / 2, $0096FF)
          DrawVLine(CrossX + SquareSize / 2, 0, ScreenYSize, $0096FF)
          DrawingMode(1)
          FrontColor(255, 255, 255)
          Locate(10, 10)
          DrawText("FPS = " + Str(FPS))
          Locate(10, 30)
          DrawText("Points = " + Str(Points))
          Locate(10, 50)
          DrawText("Lines = " + Str(Lines))
          Locate(10, 70)
          DrawText("Boxes = " + Str(Boxes))
        StopDrawing()
        CrossX + CrossXS
        CrossY + CrossYS
        If CrossX <= 0 Or CrossX => ScreenXSize - SquareSize
            CrossXS = -CrossXS
        EndIf
        If CrossY <= 0 Or CrossY => ScreenYSize - SquareSize
            CrossYS = -CrossYS
        EndIf
        If ElapsedMilliseconds() - tz => 1000
            FPS = NFrames
            NFrames = 0
            Points = NPoints
            NPoints = 0
            Lines = NLines
            NLines = 0
            Boxes = NBoxes
            NBoxes = 0
            tz = ElapsedMilliseconds()
        EndIf
        NFrames + 1
        ExamineKeyboard()
        ExamineMouse()
        If KeyboardPushed(#PB_Key_ALL) Or MouseDeltaX() < -5 Or MouseDeltaX() > 5 Or MouseDeltaY() < -5 Or MouseDeltaY() > 5
            Quit = #TRUE
        EndIf
      Until Quit
  EndIf
End