Joujou Fractal

Programmation avancée de jeux en PureBasic
filperj
Messages : 395
Inscription : jeu. 22/janv./2004 1:13

Joujou Fractal

Message par filperj »

Je me suis amusé à faire un petit éditeur de fractales ( très sommaire ).

Touches 2 à 9: ( celles en haut du clavier )
change le découpage du damier

Barre espace: visualisation

Touche impression d'écran:
copie votre oeuvre dans le presse-papier


signification des couleurs:
noir: le carré n'est pas dessiné
blanc: dessiné en jaune
vert: répétition du motif à l'échelle inférireure

Code : Tout sélectionner


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)
Faites-vous un joli papier peint, ça vous amusera 5 minutes :lol:
Le chaos l'emporte toujours sur l'ordre
parcequ'il est mieux organisé.
(Ly Tin Wheedle)
bombseb
Messages : 445
Inscription : jeu. 25/août/2005 22:59
Localisation : 974
Contact :

Message par bombseb »

Salut, si ca peut t'interresser j'avais fais un truc un peu pareil :
http://purebasic.hmt-forum.com/viewtopic.php?t=3532

Je testerais ton truc ce soir
filperj
Messages : 395
Inscription : jeu. 22/janv./2004 1:13

Message par filperj »

Houlà, mes fractales sont beaucoup plus simple !
La proc de rendu fait moins de 15 lignes :lol:

Au fait, je n'ai jamais trouvé d'explication simple de la formule de Mandelbrot :?:
Le chaos l'emporte toujours sur l'ordre
parcequ'il est mieux organisé.
(Ly Tin Wheedle)
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Bof c'est juste un truc qui trouve une dimension cachée dans toutes choses :)

Sinon pour le concept du genre
do
xx= x * x - y*y + A
y = 2 * x * y + B
x = xx
loop
On voit bien que ce petit x s'accoquine avec ce petit y dans une valse entre-croisée qui évidemment va donner un bidule se fabriquant lui-même, ce qui est l'essence même de "la fractalité" !

Comme d'habitude le meilleur conseil est de lire le bouquin de l'auteur directement!
Benoît Mandelbrot
"Les objets fractals: Survol du langage fractal"
forme hasard et dimension
Flammarion
En vente dans toutes les bonnes boulangeries et disponibles dans toutes les bibliothèques!

Une page sympa qui se termine par une conférence en" Live" du petit Benoît :lol:
http://users.hol.gr/~helen/index.files/ ... ctales.htm#

Sinon le programme le plus fun sur l'exploration des mondes fractals en temps réel ( ne pas dépasser la vitesse de zoom 5 sans avoir sa ceinture attachée)
C'est gratuit et cela s'appelle Xaos
http://xaos.sourceforge.net/english.php et il n'y a pas que l'ensemble de Mandelbrot :)
Est beau ce qui plaît sans concept :)
Speedy Galerie
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Quelqu'un a entendu parler des constructales?
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

Ben voilà un thread qui en parle de docte façon, et débateurs zélés :D
"Etes-vous pour l'application de la théorie constructale dans le design industriel ?"
http://forums.futura-sciences.com/thread3826.html

Et ailleurs
En gros c'est un peu la meme chose que la théorie des fractales sauf que c'est tout le contraire. Et puis ca renvoie les "inventeurs" des fractales reviser leur notes. Le principe des constuctales est de construire une forme en partant d'un modèle de base optimisé selon un critère. Un fois ce modèle de basé défini, on en assemble plusieurs éléments entre eux, toujours dans l'optique d'obtenir la forme la plus optimale possible selon le critère donné. En remontant comme ça d'étages en étages on obtient des jolies formes telles que des flocons de neige ou que des pommeaux de douches présentant un minimum de perte de pression!

Cette théorie trouve donc de nombreuses applications dans l'industrie, notamment en ce qui concerne la mécanique des fluides. Mieux encore, la nature elle même se construirait selon une logique constructale. La plante qui pousse se construit de telle manière qu'elle perde le moins d'energie possible selon les contraintes auquelles elle est soumise; et c'est parfaitement logique. En somme, les merveilles architecturales dont la nature est capable à ses heures reposent sur la seule recherche d'économie d'énergie.
Est beau ce qui plaît sans concept :)
Speedy Galerie
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Intéressant, non? :D
Répondre