PoFGui/Pkg_Outils_Fractals.adb

   1
   2
   3 package body Pkg_Outils_Fractals is
   4
   5    ------------------------------------------------------------------------------------------------
   6    -- Nom      : Creer_Degrade                                                                   --
   7    -- But      : Creer un tableau de degrade de couleur en fonction de couleur determinee        --
   8    ------------------------------------------------------------------------------------------------
   9    procedure Creer_Degrade (Points_Definis_Param : in T_Tab_Couleur; Degrade : out T_Tab_Couleur; Nb_Iteration : in Natural) is
  10
  11       ---------------------------------------------------------------------------------------------
  12       -- Nom      : Limite                                                                       --
  13       -- But      : Empeche le depassement des limites fixées                                    --
  14       ---------------------------------------------------------------------------------------------
  15       function Limite ( Nombre : in Integer) return Natural is
  16          Tmp : Integer := Nombre;   -- Nombre temporaire
  17          Limite_Min : constant Integer := 0;  -- Limite inferieure
  18          Limite_Max : constant Integer := 255;-- Limite superieure
  19       begin -- Limite
  20          if Tmp < Limite_Min then
  21                Tmp := Limite_Min;
  22             elsif Tmp > Limite_Max then
  23                Tmp := Limite_Max;
  24          end if;
  25          return Natural(Tmp);
  26       end Limite;
  27
  28
  29       -- Changement des borne du tableau
  30       Points_Definis : T_Tab_Couleur (1 .. Points_Definis_Param'Length) := Points_Definis_Param;
  31
  32       Pas_R   : Float := 0.0; -- Pour le pas de la couleur rouge
  33       Pas_G   : Float := 0.0; -- Pour le pas de la couleur verte
  34       Pas_B   : Float := 0.0; -- Pour le pas de la couleur bleue
  35       Couleur_Reference : Integer := Points_Definis'First;
  36       Couleur_Courante  : Integer := Degrade'First;
  37       Nb_Coul_Partie    : Natural :=  Nb_Iteration / (Points_Definis'Length - 1);
  38
  39    begin -- Creer_Degrader
  40
  41       -- Parcours de tout le degrade
  42      while Couleur_Courante <= Degrade'Last loop
  43
  44          -- Si c'est la derniere partie du degrade
  45          if Couleur_Reference >= Points_Definis'Last then -- Degrade'Last then
  46
  47             Couleur_Courante := Couleur_Courante + 1;
  48
  49             -- Attribue la couleur jusqu'a la fin du degrade
  50             while Couleur_Courante <= Degrade'Last - 1 loop
  51
  52                -- Attribution de la couleur au point courant en fonction du pas
  53                Degrade(Couleur_Courante).R := Limite(Points_Definis(Couleur_Reference).R + Integer(Pas_R * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  54                Degrade(Couleur_Courante).G := Limite(Points_Definis(Couleur_Reference).G + Integer(Pas_G * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  55                Degrade(Couleur_Courante).B := Limite(Points_Definis(Couleur_Reference).B + Integer(Pas_B * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  56                Couleur_Courante := Couleur_Courante + 1;
  57             end loop;
  58
  59          else
  60             -- Definition du pas pour chaque couleur en fonction du point definit precedant et le suivant
  61             Pas_R := Float((Points_Definis(Couleur_Reference + 1).R - Points_Definis(Couleur_Reference).R)) / Float(Nb_Coul_Partie);
  62             Pas_G := Float((Points_Definis(Couleur_Reference + 1).G - Points_Definis(Couleur_Reference).G)) / Float(Nb_Coul_Partie);
  63             Pas_B := Float((Points_Definis(Couleur_Reference + 1).B - Points_Definis(Couleur_Reference).B)) / Float(Nb_Coul_Partie);
  64
  65             -- Parcours des points de couleurs jusqu'au prochain point definit
  66             while Couleur_Courante /= Nb_Coul_Partie * Couleur_Reference loop --Couleur_Courante <= Degrade'Last - 1 loop
  67
  68                -- Attribution de la couleur au point courant en fonction du pas
  69                Degrade(Couleur_Courante).R := Limite(Points_Definis(Couleur_Reference).R + Integer(Pas_R * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  70                Degrade(Couleur_Courante).G := Limite(Points_Definis(Couleur_Reference).G + Integer(Pas_G * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  71                Degrade(Couleur_Courante).B := Limite(Points_Definis(Couleur_Reference).B + Integer(Pas_B * Float(Couleur_Courante - (Couleur_Reference - Points_Definis'First) * Nb_Coul_Partie + 1)));
  72
  73                Couleur_Courante := Couleur_Courante + 1;
  74
  75             end loop;
  76          end if;
  77          Couleur_Reference := Couleur_Reference + 1;
  78       end loop;
  79
  80       Degrade(Degrade'Last).R := 0;
  81       Degrade(Degrade'Last).G := 0;
  82       Degrade(Degrade'Last).B := 0;
  83    end Creer_Degrade;
  84
  85
  86    ------------------------------------------------------------------------------------------------
  87    -- Nom      : Affiche_Degrade                                                                 --
  88    -- But      : Affiche le degrade sur la longueur demandé sur 5 pixels de hauteur              --
  89    ------------------------------------------------------------------------------------------------
  90    procedure Affiche_Degrade (Points_Definis : in T_Tab_Couleur; Longueur : in Integer) is
  91       Degrade : T_Tab_Couleur(0 .. Longueur-1);
  92    begin
  93       Creer_Degrade(Points_Definis, Degrade, Longueur);
  94       for X in Degrade'range loop
  95          for Y in 0 .. 5 loop
  96             Color_Back.R := Degrade(X).R;
  97             Color_Back.G := Degrade(X).G;
  98             Color_Back.B := Degrade(X).B;
  99             Set_Color_Pen(Color_Back);
 100
 101             Move_To(X,Y);
 102             Put_Pixel;
 103          end loop;
 104
 105       end loop;
 106
 107    end Affiche_Degrade;
 108
 109
 110    ------------------------------------------------------------------------------------------------
 111    -- Nom      : Conversion_Couleur                                                              --
 112    -- But      : Convertit une matrice d'iteration en une matrice de couleur                     --
 113    ------------------------------------------------------------------------------------------------
 114    procedure Conversion_Couleur (Matrice : in T_Matrice_Iteration; Degrade : in T_Tab_Couleur; Matrice_Couleur : out T_Matrice_Couleur) is
 115    begin -- Conversion_Couleur
 116    for X in Matrice'range(1) loop
 117       for Y in  Matrice'range(2) loop
 118 --      Put(X);
 119 --      Put(", ");
 120 --      Put(Y);
 121          Matrice_Couleur(X, Y) := Degrade(Matrice(X, Y));
 122       end loop;
 123    end loop;
 124    end Conversion_Couleur;
 125
 126
 127    ------------------------------------------------------------------------------------------------
 128    -- Nom      : Calcul_Antialiasing                                                             --
 129    -- But      : Contracter une matrice en une autre 2 fois plus petite                          --
 130    ------------------------------------------------------------------------------------------------
 131    function Calcul_Antialiasing(Matrice_Antialiasing : T_Matrice_Iteration) return  T_Matrice_Iteration is
 132
 133       X, Y : Natural;
 134       Matrice_Retour : T_Matrice_Iteration ( 0..Matrice_Antialiasing'Last(1) / 2, 0..Matrice_Antialiasing'Last(2) / 2);
 135
 136    begin
 137          X:=0;
 138          while X <= Matrice_Antialiasing'Last(1) - 1 loop
 139             Y:=0;
 140             while Y <= Matrice_Antialiasing'Last(2) - 1 loop
 141
 142                Matrice_Retour(X/2, Y/2) := (Matrice_Antialiasing(X,Y)+Matrice_Antialiasing(X +1,Y)
 143                                              +Matrice_Antialiasing(X,Y+1)+Matrice_Antialiasing(X+1,Y+1))/4;
 144             Y:=Y+2;
 145             end loop ;
 146             X:=X+2;
 147          end loop ;
 148       return Matrice_Retour;
 149
 150    end;
 151
 152    ------------------------------------------------------------------------------------------------
 153    -- Nom      : Mandel_Gen                                                                      --
 154    -- But      : Genere une matrice d'iteration selon Mandelbrot                                 --
 155    ------------------------------------------------------------------------------------------------
 156    function Mandel_Gen (Largeur_Zone, Hauteur_Zone : Natural ; Zoom, C_Diverge_Limite : Long_Float;
 157                         NB_Iteration_Max : Positive;  Centre : T_Centre;
 158                         Antialiasing : Boolean := False) return T_Matrice_Iteration is
 159
 160       A,B,Ao,Bo,Temp : Long_Float;
 161       Nb_Iteration : Natural;
 162       Matrice_Retour : T_Matrice_Iteration (0..Largeur_Zone, 0..Hauteur_Zone);
 163       Matrice_Antialiasing : T_Matrice_Iteration (0..2*Largeur_Zone+1, 0..2*Hauteur_Zone+1);
 164
 165       Largeur_Zone_Tmp_Float : Long_Float := Long_Float(Largeur_Zone);
 166       Hauteur_Zone_Tmp_Float : Long_Float := Long_Float(Hauteur_Zone);
 167
 168       Largeur_Zone_Tmp : Natural := Largeur_Zone;
 169       Hauteur_Zone_Tmp : Natural := Hauteur_Zone;
 170
 171
 172    begin -- Mandel_Gen
 173
 174       if Antialiasing then
 175          Largeur_Zone_Tmp := 2 * Largeur_Zone_Tmp + 1;
 176          Hauteur_Zone_Tmp := 2 * Hauteur_Zone_Tmp + 1;
 177
 178          Largeur_Zone_Tmp_Float := 2.0 * Largeur_Zone_Tmp_Float + 1.0;
 179          Hauteur_Zone_Tmp_Float := 2.0 * Hauteur_Zone_Tmp_Float + 1.0;
 180
 181       end if;
 182
 183       for X in 0..Largeur_Zone_Tmp loop
 184          for Y in 0..Hauteur_Zone_Tmp loop
 185
 186             Ao :=  ( (Long_Float(X) / (Largeur_Zone_Tmp_Float)) - 0.5 )   / Zoom   +   Centre.X ; -- de 0 a 1
 187             Bo :=  (2.0 * Long_Float(Y) - Hauteur_Zone_Tmp_Float) / (2.0 * Largeur_Zone_Tmp_Float) / Zoom -  Centre.Y ; -- de 0 a 1
 188             --Bo :=  ((Long_Float(Y) / Largeur_Zone) - (Hauteur_Zone / Largeur_Zone / 2.0  )) / Zoom +  Centre.Y ; -- de 0 a 1
 189
 190             Nb_Iteration := 0;
 191             A:=Ao;
 192             B:=Bo;
 193
 194             loop
 195                Temp := A**2 - B**2 + Ao;
 196                B := 2.0 * A * B + Bo;
 197                A := Temp;
 198                Nb_Iteration := Nb_Iteration + 1;
 199                exit when Nb_Iteration >= NB_Iteration_Max or else (A**2 + B**2) > C_Diverge_Limite ;
 200             end loop;
 201
 202             --put(float(Nb_Iteration),2,2);
 203             if Antialiasing then
 204                Matrice_Antialiasing(X,Y) := Nb_Iteration;
 205             else
 206                Matrice_Retour(X,Y) := Nb_Iteration;
 207             end if;
 208
 209          end loop;
 210       end loop;
 211
 212       if Antialiasing then
 213          Matrice_Retour := Calcul_Antialiasing(Matrice_Antialiasing);
 214       end if;
 215
 216       return Matrice_Retour;
 217
 218    end Mandel_Gen;
 219
 220
 221    ------------------------------------------------------------------------------------------------
 222    -- Nom      : Julia_Gen                                                                      --
 223    -- But      : Genere une matrice d'iteration selon Mandelbrot                                 --
 224    ------------------------------------------------------------------------------------------------
 225    function Julia_Gen (Largeur_Zone, Hauteur_Zone : Natural;  Zoom, C_Diverge_Limite : Long_Float;
 226                         NB_Iteration_Max : Positive;  Centre : T_Centre; Cx, Cy : Long_Float; Antialiasing : Boolean)
 227                         return T_Matrice_Iteration is
 228
 229       A,B,Ao,Bo,Temp : Long_Float;
 230       Nb_Iteration : Natural;
 231       Matrice_Retour : T_Matrice_Iteration (0..Largeur_Zone, 0..Hauteur_Zone);
 232       Matrice_Antialiasing : T_Matrice_Iteration (0..2*Largeur_Zone+1, 0..2*Hauteur_Zone+1);
 233
 234       Largeur_Zone_Tmp_Float : Long_Float := Long_Float(Largeur_Zone);
 235       Hauteur_Zone_Tmp_Float : Long_Float := Long_Float(Hauteur_Zone);
 236
 237       Largeur_Zone_Tmp : Natural := Largeur_Zone;
 238       Hauteur_Zone_Tmp : Natural := Hauteur_Zone;
 239
 240    begin -- Julia_Gen
 241
 242       if Antialiasing then
 243          Largeur_Zone_Tmp := 2 * Largeur_Zone_Tmp + 1;
 244          Hauteur_Zone_Tmp := 2 * Hauteur_Zone_Tmp + 1;
 245
 246          Largeur_Zone_Tmp_Float := 2.0 * Largeur_Zone_Tmp_Float + 1.0;
 247          Hauteur_Zone_Tmp_Float := 2.0 * Hauteur_Zone_Tmp_Float + 1.0;
 248
 249       end if;
 250
 251       for X in 0..Largeur_Zone_Tmp loop
 252          for Y in 0..Hauteur_Zone_Tmp loop
 253             A :=  ( (Long_Float(X) / (Largeur_Zone_Tmp_Float)) - 0.5 )   / Zoom   +   Centre.X ; -- de 0 a 1
 254             B :=  (2.0 * Long_Float(Y) - Hauteur_Zone_Tmp_Float) / (2.0 * Largeur_Zone_Tmp_Float) / Zoom -  Centre.Y ; -- de 0 a 1
 255             --Bo :=  ((Long_Float(Y) / Largeur_Zone) - (Hauteur_Zone / Largeur_Zone / 2.0  )) / Zoom +  Centre.Y ; -- de 0 a 1
 256
 257             Nb_Iteration := 0;
 258
 259             loop
 260                Temp := A**2 - B**2 + Cx;
 261                B := 2.0 * A * B + Cy;
 262                A := Temp;
 263
 264                Nb_Iteration := Nb_Iteration + 1;
 265
 266                exit when Nb_Iteration >= NB_Iteration_Max or else (A**2 + B**2) > C_Diverge_Limite ;
 267
 268             end loop;
 269
 270             --put(float(Nb_Iteration),2,2);
 271
 272             if Antialiasing then
 273                Matrice_Antialiasing(X,Y) := Nb_Iteration;
 274             else
 275                Matrice_Retour(X,Y) := Nb_Iteration;
 276             end if;
 277
 278          end loop;
 279       end loop;
 280
 281       if Antialiasing then
 282          Matrice_Retour := Calcul_Antialiasing(Matrice_Antialiasing);
 283       end if;
 284
 285       return Matrice_Retour;
 286
 287    end Julia_Gen;
 288
 289
 290 end Pkg_Outils_Fractals;