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