package body Pkg_Outils_Fractals is ------------------------------------------------------------------------------------------------ -- Nom : Creer_Degrade -- -- But : Creer un tableau de degrade de couleur en fonction de couleur determinee -- ------------------------------------------------------------------------------------------------ procedure Creer_Degrade (Points_Definis_Param : in T_Tab_Couleur; Degrade : out T_Tab_Couleur; Nb_Iteration : in Natural) is --------------------------------------------------------------------------------------------- -- Nom : Limite -- -- But : Empeche le depassement des limites fixées -- --------------------------------------------------------------------------------------------- function Limite ( Nombre : in Integer) return Natural is Tmp : Integer := Nombre; -- Nombre temporaire Limite_Min : constant Integer := 0; -- Limite inferieure Limite_Max : constant Integer := 255;-- Limite superieure begin -- Limite if Tmp < Limite_Min then Tmp := Limite_Min; elsif Tmp > Limite_Max then Tmp := Limite_Max; end if; return Natural(Tmp); end Limite; -- Changement des borne du tableau Points_Definis : T_Tab_Couleur (1 .. Points_Definis_Param'Length) := Points_Definis_Param; Pas_R : Float := 0.0; -- Pour le pas de la couleur rouge Pas_G : Float := 0.0; -- Pour le pas de la couleur verte Pas_B : Float := 0.0; -- Pour le pas de la couleur bleue Couleur_Reference : Integer := Points_Definis'First; Couleur_Courante : Integer := Degrade'First; Nb_Coul_Partie : Natural := Nb_Iteration / (Points_Definis'Length - 1); begin -- Creer_Degrader -- Parcours de tout le degrade while Couleur_Courante <= Degrade'Last loop -- Si c'est la derniere partie du degrade if Couleur_Reference >= Points_Definis'Last then -- Degrade'Last then Couleur_Courante := Couleur_Courante + 1; -- Attribue la couleur jusqu'a la fin du degrade while Couleur_Courante <= Degrade'Last - 1 loop -- Attribution de la couleur au point courant en fonction du pas 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))); 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))); 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))); Couleur_Courante := Couleur_Courante + 1; end loop; else -- Definition du pas pour chaque couleur en fonction du point definit precedant et le suivant Pas_R := Float((Points_Definis(Couleur_Reference + 1).R - Points_Definis(Couleur_Reference).R)) / Float(Nb_Coul_Partie); Pas_G := Float((Points_Definis(Couleur_Reference + 1).G - Points_Definis(Couleur_Reference).G)) / Float(Nb_Coul_Partie); Pas_B := Float((Points_Definis(Couleur_Reference + 1).B - Points_Definis(Couleur_Reference).B)) / Float(Nb_Coul_Partie); -- Parcours des points de couleurs jusqu'au prochain point definit while Couleur_Courante /= Nb_Coul_Partie * Couleur_Reference loop --Couleur_Courante <= Degrade'Last - 1 loop -- Attribution de la couleur au point courant en fonction du pas 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))); 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))); 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))); Couleur_Courante := Couleur_Courante + 1; end loop; end if; Couleur_Reference := Couleur_Reference + 1; end loop; Degrade(Degrade'Last).R := 0; Degrade(Degrade'Last).G := 0; Degrade(Degrade'Last).B := 0; end Creer_Degrade; ------------------------------------------------------------------------------------------------ -- Nom : Affiche_Degrade -- -- But : Affiche le degrade sur la longueur demandé sur 5 pixels de hauteur -- ------------------------------------------------------------------------------------------------ procedure Affiche_Degrade (Points_Definis : in T_Tab_Couleur; Longueur : in Integer) is Degrade : T_Tab_Couleur(0 .. Longueur-1); begin Creer_Degrade(Points_Definis, Degrade, Longueur); for X in Degrade'range loop for Y in 0 .. 5 loop Color_Back.R := Degrade(X).R; Color_Back.G := Degrade(X).G; Color_Back.B := Degrade(X).B; Set_Color_Pen(Color_Back); Move_To(X,Y); Put_Pixel; end loop; end loop; end Affiche_Degrade; ------------------------------------------------------------------------------------------------ -- Nom : Conversion_Couleur -- -- But : Convertit une matrice d'iteration en une matrice de couleur -- ------------------------------------------------------------------------------------------------ procedure Conversion_Couleur (Matrice : in T_Matrice_Iteration; Degrade : in T_Tab_Couleur; Matrice_Couleur : out T_Matrice_Couleur) is begin -- Conversion_Couleur for X in Matrice'range(1) loop for Y in Matrice'range(2) loop -- Put(X); -- Put(", "); -- Put(Y); Matrice_Couleur(X, Y) := Degrade(Matrice(X, Y)); end loop; end loop; end Conversion_Couleur; ------------------------------------------------------------------------------------------------ -- Nom : Calcul_Antialiasing -- -- But : Contracter une matrice en une autre 2 fois plus petite -- ------------------------------------------------------------------------------------------------ function Calcul_Antialiasing(Matrice_Antialiasing : T_Matrice_Iteration) return T_Matrice_Iteration is X, Y : Natural; Matrice_Retour : T_Matrice_Iteration ( 0..Matrice_Antialiasing'Last(1) / 2, 0..Matrice_Antialiasing'Last(2) / 2); begin X:=0; while X <= Matrice_Antialiasing'Last(1) - 1 loop Y:=0; while Y <= Matrice_Antialiasing'Last(2) - 1 loop Matrice_Retour(X/2, Y/2) := (Matrice_Antialiasing(X,Y)+Matrice_Antialiasing(X +1,Y) +Matrice_Antialiasing(X,Y+1)+Matrice_Antialiasing(X+1,Y+1))/4; Y:=Y+2; end loop ; X:=X+2; end loop ; return Matrice_Retour; end; ------------------------------------------------------------------------------------------------ -- Nom : Mandel_Gen -- -- But : Genere une matrice d'iteration selon Mandelbrot -- ------------------------------------------------------------------------------------------------ function Mandel_Gen (Largeur_Zone, Hauteur_Zone : Natural ; Zoom, C_Diverge_Limite : Long_Float; NB_Iteration_Max : Positive; Centre : T_Centre; Antialiasing : Boolean := False) return T_Matrice_Iteration is A,B,Ao,Bo,Temp : Long_Float; Nb_Iteration : Natural; Matrice_Retour : T_Matrice_Iteration (0..Largeur_Zone, 0..Hauteur_Zone); Matrice_Antialiasing : T_Matrice_Iteration (0..2*Largeur_Zone+1, 0..2*Hauteur_Zone+1); Largeur_Zone_Tmp_Float : Long_Float := Long_Float(Largeur_Zone); Hauteur_Zone_Tmp_Float : Long_Float := Long_Float(Hauteur_Zone); Largeur_Zone_Tmp : Natural := Largeur_Zone; Hauteur_Zone_Tmp : Natural := Hauteur_Zone; begin -- Mandel_Gen if Antialiasing then Largeur_Zone_Tmp := 2 * Largeur_Zone_Tmp + 1; Hauteur_Zone_Tmp := 2 * Hauteur_Zone_Tmp + 1; Largeur_Zone_Tmp_Float := 2.0 * Largeur_Zone_Tmp_Float + 1.0; Hauteur_Zone_Tmp_Float := 2.0 * Hauteur_Zone_Tmp_Float + 1.0; end if; for X in 0..Largeur_Zone_Tmp loop for Y in 0..Hauteur_Zone_Tmp loop Ao := ( (Long_Float(X) / (Largeur_Zone_Tmp_Float)) - 0.5 ) / Zoom + Centre.X ; -- de 0 a 1 Bo := (2.0 * Long_Float(Y) - Hauteur_Zone_Tmp_Float) / (2.0 * Largeur_Zone_Tmp_Float) / Zoom - Centre.Y ; -- de 0 a 1 --Bo := ((Long_Float(Y) / Largeur_Zone) - (Hauteur_Zone / Largeur_Zone / 2.0 )) / Zoom + Centre.Y ; -- de 0 a 1 Nb_Iteration := 0; A:=Ao; B:=Bo; loop Temp := A**2 - B**2 + Ao; B := 2.0 * A * B + Bo; A := Temp; Nb_Iteration := Nb_Iteration + 1; exit when Nb_Iteration >= NB_Iteration_Max or else (A**2 + B**2) > C_Diverge_Limite ; end loop; --put(float(Nb_Iteration),2,2); if Antialiasing then Matrice_Antialiasing(X,Y) := Nb_Iteration; else Matrice_Retour(X,Y) := Nb_Iteration; end if; end loop; end loop; if Antialiasing then Matrice_Retour := Calcul_Antialiasing(Matrice_Antialiasing); end if; return Matrice_Retour; end Mandel_Gen; ------------------------------------------------------------------------------------------------ -- Nom : Julia_Gen -- -- But : Genere une matrice d'iteration selon Mandelbrot -- ------------------------------------------------------------------------------------------------ function Julia_Gen (Largeur_Zone, Hauteur_Zone : Natural; Zoom, C_Diverge_Limite : Long_Float; NB_Iteration_Max : Positive; Centre : T_Centre; Cx, Cy : Long_Float; Antialiasing : Boolean) return T_Matrice_Iteration is A,B,Ao,Bo,Temp : Long_Float; Nb_Iteration : Natural; Matrice_Retour : T_Matrice_Iteration (0..Largeur_Zone, 0..Hauteur_Zone); Matrice_Antialiasing : T_Matrice_Iteration (0..2*Largeur_Zone+1, 0..2*Hauteur_Zone+1); Largeur_Zone_Tmp_Float : Long_Float := Long_Float(Largeur_Zone); Hauteur_Zone_Tmp_Float : Long_Float := Long_Float(Hauteur_Zone); Largeur_Zone_Tmp : Natural := Largeur_Zone; Hauteur_Zone_Tmp : Natural := Hauteur_Zone; begin -- Julia_Gen if Antialiasing then Largeur_Zone_Tmp := 2 * Largeur_Zone_Tmp + 1; Hauteur_Zone_Tmp := 2 * Hauteur_Zone_Tmp + 1; Largeur_Zone_Tmp_Float := 2.0 * Largeur_Zone_Tmp_Float + 1.0; Hauteur_Zone_Tmp_Float := 2.0 * Hauteur_Zone_Tmp_Float + 1.0; end if; for X in 0..Largeur_Zone_Tmp loop for Y in 0..Hauteur_Zone_Tmp loop A := ( (Long_Float(X) / (Largeur_Zone_Tmp_Float)) - 0.5 ) / Zoom + Centre.X ; -- de 0 a 1 B := (2.0 * Long_Float(Y) - Hauteur_Zone_Tmp_Float) / (2.0 * Largeur_Zone_Tmp_Float) / Zoom - Centre.Y ; -- de 0 a 1 --Bo := ((Long_Float(Y) / Largeur_Zone) - (Hauteur_Zone / Largeur_Zone / 2.0 )) / Zoom + Centre.Y ; -- de 0 a 1 Nb_Iteration := 0; loop Temp := A**2 - B**2 + Cx; B := 2.0 * A * B + Cy; A := Temp; Nb_Iteration := Nb_Iteration + 1; exit when Nb_Iteration >= NB_Iteration_Max or else (A**2 + B**2) > C_Diverge_Limite ; end loop; --put(float(Nb_Iteration),2,2); if Antialiasing then Matrice_Antialiasing(X,Y) := Nb_Iteration; else Matrice_Retour(X,Y) := Nb_Iteration; end if; end loop; end loop; if Antialiasing then Matrice_Retour := Calcul_Antialiasing(Matrice_Antialiasing); end if; return Matrice_Retour; end Julia_Gen; end Pkg_Outils_Fractals;