Basic Univers

Structure FBDMask
   b.b[0]
EndStructure

Structure FractoBoxDrive
   div.l
   *m.FBDMask
EndStructure


Procedure FractoBox(*Frac.FractoBoxDrive, xdep, ydep, taille, Coul, CoulFin)
   If taille > 1
      Pas = taille / *frac\div
      For y = *frac\div - 1 To 0 Step - 1 : For x = *frac\div - 1 To 0 Step - 1
         xp = xdep + x * Pas
         yp = ydep + y * Pas
         Select *frac\m\b[x + y * *frac\div]
            Case 0
               FractoBox(*frac, xp, yp, Pas, Coul, CoulFin)
            Case 1
               Box(xp, yp, Pas, Pas, Coul)
         EndSelect
      Next : Next
     ElseIf taille = 1 And CoulFin > 0
      Box(xdep, ydep, 1, 1, CoulFin)
   EndIf
EndProcedure



Procedure makemouse()
   CreateSprite(0, 32, 32)
   StartDrawing(SpriteOutput(0))
      LineXY(0, 0, 31, 0, #Yellow)
      LineXY(0, 0, 0, 31, #Yellow)
      LineXY(31, 0, 0, 31, #Yellow)
      FillArea(2, 2, #Yellow, #Red)
   StopDrawing()
EndProcedure



Global Frac.FractoBoxDrive

Procedure inifrac(div)
   Dim masque.b(div - 1, div - 1)
   Frac\div = div
   Frac\m = @masque(0, 0)
EndProcedure



InitSprite() : InitKeyboard() : InitMouse()
OpenScreen(1024, 768, 16, "FractEdit")

inifrac(2)
makemouse()
grograin = 768

Repeat
   
   FlipBuffers()
   If IsScreenActive() = 0
      Repeat
         Delay(16)
         FlipBuffers()
      Until IsScreenActive()
      makemouse()
   EndIf
   ExamineKeyboard()
   ExamineMouse()
   MPress = 0
   If MouseButton(1)
      If oldMS = 0
         MPress = 1
         oldMS = 1
      EndIf
     Else
      oldMS = 0
   EndIf
   
   If KeyboardPushed(#PB_Key_2)
      inifrac(2)
     ElseIf KeyboardPushed(#PB_Key_3)
      inifrac(3)
     ElseIf KeyboardPushed(#PB_Key_4)
      inifrac(4)
     ElseIf KeyboardPushed(#PB_Key_5)
      inifrac(5)
     ElseIf KeyboardPushed(#PB_Key_6)
      inifrac(6)
     ElseIf KeyboardPushed(#PB_Key_7)
      inifrac(7)
     ElseIf KeyboardPushed(#PB_Key_8)
      inifrac(8)
     ElseIf KeyboardPushed(#PB_Key_9)
      inifrac(9)
     ElseIf KeyboardPushed(#PB_Key_PageUp)
      grograin = 1024
     ElseIf KeyboardPushed(#PB_Key_PageDown)
      grograin = 768
   EndIf
   
   suiv = 1
   Repeat
      taille = suiv
      suiv = taille * Frac\div
   Until suiv > grograin
   If KeyboardReleased(183) And CreateImage(0, taille, taille)
      scrop = ImageOutput()
      xdep = 0
      ydep = 0
      mode = 1
      sauver = 1
     Else
      scrop = ScreenOutput()
      xdep =(1024 - taille) /2
      ydep =(768 - taille) /2
      mode = KeyboardPushed(#PB_Key_Space)
      sauver = 0
   EndIf
   
   If scrop And StartDrawing(scrop)
      Box(0, 0, 1024, 1024, RGB(0, 0, 80))
      If mode
         FractoBox(@Frac, xdep, ydep, taille, #Yellow, #Red) ; RGB(128, 128, 40))
         StopDrawing()
        Else
         Box(212, 84, 600, 600, 0)
         Pas = 600 / Frac\div
         For y = Frac\div - 1 To 0 Step - 1 : For x = Frac\div - 1 To 0 Step - 1
            Select masque(y, x)
               Case - 1
                  coul = 0
               Case 0
                  coul = #Green
               Case 1
                  coul = #White
            EndSelect
            Box(214 + x * Pas, 86 + y * Pas, Pas - 4, Pas - 4, coul)
         Next : Next
         StopDrawing()
         DisplayTransparentSprite(0, MouseX(), MouseY())
         If MPress
            x = MouseX() - 212
            y = MouseY() - 84
            If x >= 0 And y >= 0
               x / Pas
               y / Pas
               If x < Frac\div And y < Frac\div
                  If masque(y, x) = 1
                     masque(y, x) = - 1
                    Else
                     masque(y, x) + 1
                  EndIf
               EndIf
            EndIf
         EndIf
      EndIf
   EndIf
   
   If sauver
      SetClipboardData(#PB_Clipboard_Image, ImageID())
   EndIf
   
Until KeyboardPushed(#PB_Key_Escape)