Board logo
Compression d'images sans perte de qualité
ftbass - 30/04/2004 à 00:16

Voilà... On efface tout et on recommence...

Première étape : faire un RLE.

J'ai fait la procédure de compression, il me reste à faire la décompression...

Je pense poster tout ca demain :ange:

ftbass - 30/04/2004 à 16:51

J'ai bien avancé dans les procédures de compression et décompression. Je sais, c'est pas compliqué, mais c'est encore buggé... :mad:

Je les posterai plutot ce week-end, si je m'en sors...

ftbass - 30/04/2004 à 17:31

Bah en fait, comme ça, ça a l'air de marcher.

code:
with text_io; use text_io;
with ada.integer_Text_Io; use ada.integer_Text_Io;
with sequential_io;

procedure ProjetCompression is

--////////////////////////////////////////////////////////////////////////--
--                                    Paquetages                          --
--////////////////////////////////////////////////////////////////////////--
package fichier_car is new sequential_IO(character); use fichier_car;

--////////////////////////////////////////////////////////////////////////--
--                                    Procedures                          --
--////////////////////////////////////////////////////////////////////////--
procedure CompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is

nbPixels : integer;
CarLu, CarRef : Character;

begin
 -- Lecture et ecriture de l'entête
 for i in 1..256 loop
   read(fichierInitial, CarLu);
   write(FichierResultat, CarLu);
 end loop;
 -- Compression du contenu de l'image
 read(FichierInitial, carRef);
 nbPixels := 1;
 write(FichierResultat, carRef);
 -- On lit le fichier jusqu'à la fin
 while not end_of_file(fichierInitial) loop
   read(fichierInitial, CarLu);
   nbPixels := nbPixels + 1;
   if (carLu /= CarRef) then
     write(FichierResultat, character'val(nbPixels - 1));
     nbPixels := 1;
     carRef := carLu;
     write(FichierResultat, carRef);
   else
     if nbPixels = 255 then
       write(FichierResultat, character'val(nbPixels));
       nbPixels := 1;
       read(fichierInitial, carRef);
       write(fichierResultat, carRef);
     end if;
   end if;
 end loop;
 write(FichierResultat, character'val(NbPixels));
end CompresserFichier;

procedure decompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is
 
ValPixel, nbPixels : Character;

begin
 -- Lecture et ecriture de l'entête
 for i in 1..256 loop
   read(fichierInitial, valPixel);
   write(FichierResultat, ValPixel);
 end loop;
 while not end_of_file(fichierInitial) loop
   read(FichierInitial, ValPixel);
   read(FichierInitial, NbPixels);
   for i in 1..character'pos(nbPixels) loop
     write(FichierResultat, ValPixel);
   end loop;
 end loop;
end DecompresserFichier;

--////////////////////////////////////////////////////////////////////////--
--                                Programme principal                     --
--////////////////////////////////////////////////////////////////////////--
Choix : Character;
NomFichierInitial, NomFichierResultat : string(1..30);
comptChaine : integer;
fichierInitial, FichierResultat: fichier_car.file_type;

begin
 -- On demande à l'utilisateur ce qu'il souhaite faire
 put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");
 get(choix);
 skip_line;
 -- Suivant ce choix, on effectue le traitement correspondant
 case choix is
   when 'c' =>
     put("Donnez le nom du fichier source : ");
      get_line(item => nomFichierInitial, last => comptChaine);
      open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
     put("Entrez le nom du fichier de destination : ");
     get_line(item => NomfichierResultat, last => comptChaine);
      create(FichierResultat, name => NomFichierResultat(1..comptChaine));
     CompresserFichier(FichierInitial, FichierResultat);
     close(FichierInitial);
     Close(FichierResultat);
   when 'd' =>
     put("Donnez le nom du fichier source : ");
      get_line(item => nomFichierInitial, last => comptChaine);
      open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
     put("Entrez le nom du fichier de destination : ");
     get_line(item => NomfichierResultat, last => comptChaine);
      create(FichierResultat, name => NomFichierResultat(1..comptChaine));
     decompresserFichier(FichierInitial, FichierResultat);
     close(FichierInitial);
     Close(FichierResultat);
   when others =>
     put("Aucun traitement effectue. ");
 end case;
end ProjetCompression;


Si quelqu'un trouve des bugs, c'est cool de me le signaler :)

Y'a moyen de faire mieux. Je tâcherai de poster les améliorations (comme de l'adapter aux .png,...)

ftbass - 26/05/2004 à 23:32

Demain, je poste une update :D

Comme il faut le rendre cette semaine...

Pour la douleur, une photo de mon pied :
http://ada95000.free.fr/Images/pied.jpg

Aucun maquillage... :)

ftbass - 27/05/2004 à 00:16

Alors voilà, en fait le premier RLE correspond un parcours du type :

http://ada95000.free.fr/Images/parcourssimple.jpg
  Image de 8 x 8

Ici, les pixels sont lus les uns à la suite des autres, comme on lirait un texte.

Or, dans une images, les pixels qui ont a priori le plus de chance d'être de la même couleur que le
pixel de référence, sont ceux situés dans son voisinage proche.

Ainsi, la deuxième étape a consisté en un RLE plus complexe, se basant sur un parcours du type :

http://ada95000.free.fr/Images/parcourscomplexe.jpg
  Image de 8 x 8

...la suite demain...

ftbass - 27/05/2004 à 17:14

Avec un parcours complexe, j'arrive au code suivant :

code:

--////////////////////////////////////////////////////////////////////////--
--                       Code ecrit par Julien COIGNET              --
--                  Pour le CNAM de Cergy                  --
--          Sujet : Compression d'images sans perte de qualité        --
--            Traite exclusivement les images au format .pgm        --
--                d'une taille de 256 x 256 pixels              --
--            (intervalle du type TypeEntete à adapter            --
--              selon le logiciel qui a créé le .pgm)            --
--////////////////////////////////////////////////////////////////////////--

-- A FAIRE :
--        - Effacer les fichiers temporaires


with text_io; use text_io;
with ada.integer_Text_Io; use ada.integer_Text_Io;
with sequential_io;

procedure ProjetCompression is

--////////////////////////////////////////////////////////////////////////--
--                                    Paquetages                          --
--////////////////////////////////////////////////////////////////////////--

package fichier_car is new sequential_IO(character); use fichier_car;

--////////////////////////////////////////////////////////////////////////--
--                                    Types                              --
--////////////////////////////////////////////////////////////////////////--

-- Type Bit: Binaire; peut prendre les valeurs 0 ou 1
type TypeBit is new integer range 0..1;

-- Type Octet: Ensemble de 8 bits
type TypeOctet is array (1..8) of TypeBit;

-- Type Entete: Vecteur qui contient l'entete du fichier image
     -- Intervalles de TypeEntete suivant le logiciel :    --
     --        irfanview : 0..37                  --
     --        Paint Shop Pro : 0..42              --
     --        CréationImage (logiciel maison) : 0..42  --
type TypeEntete is array (0..42) of character;

-- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels
type TypeMatrice is array (0..255, 0..255) of character;

--////////////////////////////////////////////////////////////////////////--
--                                    Fonctions                           --
--////////////////////////////////////////////////////////////////////////--

function puissance(i, j : integer) return integer is

resultat : integer := 1;

begin
  if j = 0 then
   return 1;
  else
   if i = 0 then
     return 0;
   end if;
  end if;
  for nbBoucles in 1..j loop
   resultat := resultat * i;
  end loop;
  return resultat;
end puissance;

function EntierVersBinaire(nbEntier : integer) return TypeOctet is

ValDec : integer := NbEntier; -- Valeur décimale à convertir
NbBit : integer := 0;         -- Nombre de bits sur lequel se code l'entier
Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
  -- Si le décimal vaut 0, le binaire est 00000000
  if NbEntier = 0 then return Resultat;
  end if;
  -- On détermine le nombre de bits qu'il faut pour coder le décimal
  while NbEntier >= puissance(2, NbBit) loop
     NbBit := NbBit + 1;
  end loop;
  for PoidBit in reverse 1..NbBit loop
     if ValDec >= puissance(2, (PoidBit - 1)) then
        ValDec := ValDec - puissance(2, (PoidBit - 1));
        Resultat(PoidBit) := 1;
     end if;
  end loop;
  return Resultat;
end entierVersBinaire;

function BinaireVersEntier(Octet : TypeOctet) return integer is

Resultat : integer := 0;

begin
  for i in 1..8 loop
     if Octet(i) = 1 then
        Resultat := Resultat + puissance(2, (i - 1));
     end if;
  end loop;
  return Resultat;
end BinaireVersEntier;

function EtLogique(Bit1, Bit2 : TypeBit) return TypeBit is

Resultat : TypeBit;

begin
  if (Bit1 = 1) and (Bit2 = 1) then
     Resultat := 1;
  else
     Resultat := 0;
  end if;
  return Resultat;
end EtLogique;


-- Applique un masque à l'octet envoyé en paramètre
function TraiterOctet(Octet : TypeOctet; Niveau : integer := 3) return TypeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);
Masque : TypeOctet := (1, 1, 1, 1, 1, 1, 1, 1);

begin
  for i in 1..Niveau loop
     Masque(i) := 0;
  end loop;
  for i in 1..8 loop
     Resultat(i) := EtLogique(Octet(i), Masque(i));
  end loop;
  return Resultat;
end TraiterOctet;

-- Transforme un binaire naturel en binaire réfléchi
function binaireNVersBinaireR(octet : typeOctet) return typeOctet is
 
OctetDecalGauche : typeOctet := (0, 0, 0, 0, 0, 0, 0, 0);
Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
 for i in 1..7 loop
   OctetDecalGauche(i + 1) := Octet(i);
 end loop;
 for i in 2..8 loop
   if octet(i) = 1 xor octetDecalGauche(i) = 1 then
     resultat(i - 1) := 1;
   end if;
 end loop;
 return Resultat;
end binaireNVersBinaireR;

-- Transforme un binaire réfléchi en un binaire naturel
function binaireRVersBinaireN(Octet : typeOctet) return typeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);
 
begin
 for i in reverse 1..8 loop
   if i = 8 then
     resultat(i) := Octet(i);
   else
     if octet(i) = 1 then
       if resultat(i + 1) = 1 then
         resultat(I) := 0;
       else
         resultat(i) := 1;
       end if;
     else
       if resultat(i + 1) = 1 then
         resultat(I) := 1;
       else
         resultat(i) := 0;
       end if;
     end if;
   end if;
 end loop;
 return resultat;
end binaireRVersBinaireN;

-- Détermine la colonne de la matrice à remplir à partir des coordonnées initiales
function GetColonneComp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
 for i in 1..4 loop
   Resultat(2 * i) := OctetLigne(i);
   resultat((2 * i) - 1) := OctetColonne(i);
 end loop;
 return Resultat;
end GetColonneComp;

-- Détermine la ligne de la matrice à remplir à partir des coordonnées initiales
function GetLigneComp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
 for i in 1..4 loop
   Resultat(2 * i) := OctetLigne(i + 4);
   resultat((2 * i) - 1) := OctetColonne(i + 4);
 end loop;
 return Resultat;
end GetLigneComp;

-- Retourne la colonne initiale du pixel  à partir de ses coordonnées après parcours complexe
function GetColonneDecomp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
 for i in 1..4 loop
   Resultat(i) := OctetColonne((2 * i) - 1);
   resultat(i + 4) := OctetLigne((2 * i) - 1);
 end loop;
 return Resultat;
end GetColonneDecomp;

-- Retourne la ligne initiale du pixel  à partir de ses coordonnées après parcours complexe
function GetLigneDecomp(OctetLigne, OctetColonne : in TypeOctet) return typeOctet is

Resultat : TypeOctet := (0, 0, 0, 0, 0, 0, 0, 0);

begin
 for i in 1..4 loop
   Resultat(i) := OctetColonne(2 * i);
   resultat(i + 4) := OctetLigne(2 * i);
 end loop;
 return Resultat;
end GetLigneDecomp;

-- Lit le fichier et le met dans une matrice
function FichierDansMatrice(fichier : in fichier_car.file_type) return typeMatrice is

CarLu : character;
Resultat : TypeMatrice;

begin
 -- On zappe l'entete
 for i in TypeEntete'Range loop
   read(Fichier, carLu);
 end loop;
 -- On remplit la matrice avec le contenu de l'image
 for i in 0..255 loop
   for j in 0..255 loop
     read(Fichier, carLu);
     resultat(i, j) := carLu;
   end loop;
 end loop;
 return resultat;
end FichierDansMatrice;

-- fonction qui crée une matrice modifiée selon parcours complexe
function ModifierMatrice(MatriceOriginale : in typeMatrice) return typeMatrice is

Resultat : TypeMatrice;
k, l : integer;

begin
 for i in 0..255 loop
   for j in 0..255 loop
     k := BinaireVersEntier(getLigneComp(entierVersBinaire(i), entierVersBinaire(j)));
     l := BinaireVersEntier(getColonneComp(entierVersBinaire(i), entierVersBinaire(j)));
     resultat(k, l) := MatriceOriginale(i, j);
   end loop;
 end loop;
 return resultat;
end ModifierMatrice;

-- Fonction qui récupère l'entête du fichier image
function getEntete(fichier : in fichier_car.file_type) return typeEntete is

 Car : character;
 Resultat : typeEntete;

begin
 for i in TypeEntete'Range loop
   read(Fichier, car);
   resultat(I) := Car;
 end loop;
 return resultat;
end GetEntete;

--////////////////////////////////////////////////////////////////////////--
--                                    Procedures                          --
--////////////////////////////////////////////////////////////////////////--

procedure CompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is

nbPixels : integer;
CarLu, CarRef, choix : Character;

begin
 
 -- Lecture et ecriture de l'entête
 for i in TypeEntete'Range loop
   read(fichierInitial, CarLu);
   write(FichierResultat, CarLu);
 end loop;

 -- On demande à l'utilisateur s'il veut conserver toutes les nuances de gris
 put("Souhaitez-vous conserver toutes les nuances de gris ? (o/n) : ");
 get(choix);
 skip_line;
 -- Selon ce choix, on fait le traitement adéquat
 case choix is
   when 'n' =>
     -- Compression du contenu de l'image
     read(FichierInitial, carRef);
     carRef := character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(carRef)))));
     nbPixels := 1;
     write(FichierResultat, carRef);
     -- On lit le fichier jusqu'à la fin
     while not end_of_file(fichierInitial) loop
       read(fichierInitial, CarLu);
       carlu := character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(carLu)))));
       nbPixels := nbPixels + 1;
       if (carLu /= CarRef) then
         write(FichierResultat, character'val(nbPixels - 1));
         nbPixels := 1;
         carRef := carLu;
         write(FichierResultat, carRef);
       else
         if nbPixels = 255 then
           write(FichierResultat, character'val(nbPixels));
           nbPixels := 1;
           read(fichierInitial, carRef);
           write(fichierResultat, carRef);
         end if;
       end if;
     end loop;
     write(FichierResultat, character'val(NbPixels));

   when others =>
     if choix /= 'o' then
       put("Aucun traitement ne correspond. Toutes les nuances seront conservees.");
       new_line;
     end if;
     -- Compression du contenu de l'image
     read(FichierInitial, carRef);
     nbPixels := 1;
     write(FichierResultat, carRef);
     -- On lit le fichier jusqu'à la fin
     while not end_of_file(fichierInitial) loop
       read(fichierInitial, CarLu);
       nbPixels := nbPixels + 1;
       if (carLu /= CarRef) then
         write(FichierResultat, character'val(nbPixels - 1));
         nbPixels := 1;
         carRef := carLu;
         write(FichierResultat, carRef);
       else
         if nbPixels = 255 then
           write(FichierResultat, character'val(nbPixels));
           nbPixels := 1;
           read(fichierInitial, carRef);
           write(fichierResultat, carRef);
         end if;
       end if;
     end loop;
     write(FichierResultat, character'val(NbPixels));
 end case;

end CompresserFichier;

procedure decompresserFichier(fichierInitial : in fichier_car.file_type; FichierResultat : in out fichier_car.file_type) is
 
ValPixel, nbPixels : Character;

begin
 -- Lecture et ecriture de l'entête
 for i in TypeEntete'Range loop
   read(fichierInitial, valPixel);
   write(FichierResultat, ValPixel);
 end loop;
 while not end_of_file(fichierInitial) loop
   read(FichierInitial, ValPixel);
   read(FichierInitial, NbPixels);
   for i in 1..character'pos(nbPixels) loop
     write(FichierResultat, ValPixel);
   end loop;
 end loop;
end DecompresserFichier;

-- Procedure qui lit une matrice (TypeMatrice) et l'ecrit dans un fichier
procedure EcrireMatriceDansFichier(Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin
 for i in 0..255 loop
   for j in 0..255 loop
     write(Fichier, matrice(i, j));
   end loop;
 end loop;
end ecrireMatriceDansFichier;

procedure EcrireMatriceDansFichier(entete : in typeEntete; Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin
 for i in TypeEntete'Range loop
   write(fichier, entete(i));
 end loop;
 for i in 0..255 loop
   for j in 0..255 loop
     write(Fichier, matrice(i, j));
   end loop;
 end loop;
end ecrireMatriceDansFichier;


-- Procedure qui ecrit la matrice modifiee dans un fichier temporaire
-- puis compresse ce fichier dans un autre (et y inclut aussi l'entete)
procedure CompresserMatriceModifiee(entete : in typeEntete; matrice : in typeMatrice; fichierResultat : in out fichier_car.file_type) is

 fichierTemp : fichier_car.file_type;
 CarRef, CarLu, choix : character;
 NbPixels : integer;

begin
 -- On deùande à l'utilisateur s'il souhaite conserver toutes les nuances de gris
 put("Voulez-vous conserver toutes les nuances de gris ? (o/n) : ");
 get(choix);
 skip_line;

 -- On cree le fichier de tavail
 create(FichierTemp, name => "DataComp.trv");

 -- On le remplit à l'aide d'une matrice suivant je choix de l'utilisateur
 case choix is
   when 'o' =>
     for i in 0..255 loop
       for j in 0..255 loop
         -- Sans perte de nuances
         write(FichierTemp, Matrice(i, j));
       end loop;
     end loop;
   when 'n' =>
     for i in 0..255 loop
       for j in 0..255 loop
         -- Avec 32 nuances de gris max (on fait "sauter" les trois de poids
         -- faible de l'octet codant le caractère
         write(FichierTemp, character'val(binaireVersEntier(traiterOctet(entierVersBinaire(character'pos(Matrice(i, j)))))));
       end loop;
     end loop;
   when others =>
     put("Aucun traitement ne correspond a ce choix.");
     new_line;
     put("Toutes les nuances de gris seront conservees.");
     for i in 0..255 loop
       for j in 0..255 loop
         -- Sans perte de nuances
         write(FichierTemp, Matrice(i, j));
       end loop;
     end loop;
 end case;

 -- On reinitialise le fichier de travail en lecture seule
 reset(fichierTemp, in_File);
 
 --Ecriture de l'entete dans le fichier résultat
 for i in TypeEntete'Range loop
   write(fichierResultat, entete(i));
   carLu := entete(i);
 end loop;

 -- Compression du fichier de travail
 read(FichierTemp, carRef);
 nbPixels := 1;
 write(FichierResultat, carRef);
 -- On lit le fichier jusqu'à la fin
 while not end_of_file(fichierTemp) loop
   read(fichierTemp, CarLu);
   nbPixels := nbPixels + 1;
   if (carLu /= CarRef) then
     write(FichierResultat, character'val(nbPixels - 1));
     nbPixels := 1;
     carRef := carLu;
     write(FichierResultat, carRef);
   else
     if nbPixels = 255 then
       write(FichierResultat, character'val(nbPixels));
       nbPixels := 1;
       read(fichierTemp, carRef);
       write(fichierResultat, carRef);
     end if;
   end if;
 end loop;
 write(FichierResultat, character'val(NbPixels));

 -- On ferme le fichier de travaille...
 close(fichierTemp);
 -- ... puis on l'efface
 --delete(FichierTemp);
end CompresserMatriceModifiee;


Ca tient pas sur un seul post, je poste la suite sur le suivant.

ftbass - 27/05/2004 à 17:17

code à coller juste à la suite du code précédent :

code:

-- Procedure qui va decompresser le fichier dans un fichier temporaire...
-- ... puis remplir la matrice
procedure DecompresserFichierModifie(fichierInitial : in fichier_car.file_type; entete : in out typeEntete; matrice : in out typeMatrice) is

 fichierTemp : fichier_car.file_type;
 valPixel, NbPixels : character;
 k, l : integer;

begin
 -- On cree le fichier de travail
 create(FichierTemp, name => "DataDecomp.trv");
 
 -- On récupère l'entete du fichier compressé
 for i in TypeEntete'Range loop
   read(fichierInitial, entete(i));
 end loop;

 -- On le remplit ce fichier à l'aide des données compressées
 while not end_of_file(fichierInitial) loop
   read(FichierInitial, ValPixel);
   read(FichierInitial, NbPixels);
   for i in 1..character'pos(nbPixels) loop
     write(FichierTemp, ValPixel);
   end loop;
 end loop;
 -- On réinitialise le fichier temporaire en lecture seule
 reset(fichierTemp, in_file);
 for i in 0..255 loop
   for j in 0..255 loop
     read(fichierTemp, ValPixel);
     k := BinaireVersEntier(getLigneDecomp(entierVersBinaire(i), entierVersBinaire(j)));
     l := BinaireVersEntier(getColonneDecomp(entierVersBinaire(i), entierVersBinaire(j)));
     Matrice(k, l) := ValPixel;
   end loop;
 end loop;
 -- On ferme le fichier temporaire
 close(fichierTemp);
 -- et on l'efface
 --delete(fichierTemp);

end decompresserFichierModifie;

--////////////////////////////////////////////////////////////////////////--
--                                Programme principal                     --
--////////////////////////////////////////////////////////////////////////--

Choix1, choix2 : Character;
NomFichierInitial, NomFichierResultat : string(1..30);
comptChaine : integer;
fichierInitial, FichierResultat : fichier_car.file_type;
Entete : TypeEntete;

Octet : typeOctet := (0, 0, 1, 1, 0, 0, 0, 0);

matriceI, MatriceR : typeMatrice;

begin
 
 -- On demande à l'utilisateur le mode de parcours avec lequel il veut travailler
 put("Parcours simple (s), ou parcours complexe (c) ? ");
 get(choix1);
 skip_line;

 case choix1 is
 
 --////////////////////////////////////////////////////////////////--
 --                parcours simple                --
 --////////////////////////////////////////////////////////////////--

   when 's' =>
     -- On demande à l'utilisateur ce qu'il souhaite faire
     put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");
     get(choix2);
     skip_line;
     -- Suivant ce choix, on effectue le traitement correspondant
     case choix2 is
       when 'c' =>
         put("Donnez le nom du fichier a compresser : ");
          get_line(item => nomFichierInitial, last => comptChaine);
          open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
         put("Entrez le nom du fichier de destination : ");
         get_line(item => NomfichierResultat, last => comptChaine);
          create(FichierResultat, name => NomFichierResultat(1..comptChaine));
         CompresserFichier(FichierInitial, FichierResultat);
         close(FichierInitial);
         Close(FichierResultat);
         put("Traitement effectue.");
       when 'd' =>
         put("Donnez le nom du fichier a decompresser : ");
          get_line(item => nomFichierInitial, last => comptChaine);
          open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
         put("Entrez le nom du fichier de destination : ");
         get_line(item => NomfichierResultat, last => comptChaine);
          create(FichierResultat, name => NomFichierResultat(1..comptChaine));
         decompresserFichier(FichierInitial, FichierResultat);
         close(FichierInitial);
         Close(FichierResultat);
         put("Traitement effectue.");
       when others =>
         put("Aucun traitement effectue. ");
     end case;

 --////////////////////////////////////////////////////////////////--
 --                parcours complexe                --
 --////////////////////////////////////////////////////////////////--
   when 'c' =>  
     -- On demande à l'utilisateur ce qu'il souhaite faire
     put("Souhaitez-vous compresser (c), ou decompresser un fichier (d) ? ");
     get(choix2);
     skip_line;
   
     -- Suivant ce choix, on effectue le traitement correspondant
     case choix2 is
       
       -- Compression du fichier
       when 'c' =>
         -- On récupère le nom du fichier initial
         put("Donnez le nom du fichier a compresser : ");
         get_line(item => nomFichierInitial, last => comptChaine);
          -- On l'ouvre en lecture seule
         open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
         -- On récupere l'entete de ce fichier
         entete := getEntete(fichierInitial);
         -- On remet le pointeur au début du fichier
         reset(fichierInitial);
         -- On demande à l'utilisateur le nom du fichier de destination
         put("Entrez le nom du fichier de destination : ");
         get_line(item => NomfichierResultat, last => comptChaine);
         -- On crée le fichier de destination
         create(FichierResultat, name => NomFichierResultat(1..comptChaine));
         -- On insère l'image telle quelle dans MatriceI (sans l'entete)
         matriceI := FichierDansMatrice(FichierInitial);
         -- MatriceR récupère le contenu de MatriceI, mais suivant le parcours complexe
         matriceR := ModifierMatrice(matriceI);
         -- On insère ensuite l'entete du fichier source, puis le RLE de la matrice
         -- modifiée dans le fichier de destination
         CompresserMatriceModifiee(entete, MatriceR, FichierResultat);
         -- On ferme les fichiers
         close(FichierInitial);
         Close(FichierResultat);
         -- On indique que le traitement est terminé
         put("Traitement effectue.");
   
       -- Décompression du fichier
       when 'd' =>
         -- On récupère le nom du fichier à décompresser
         put("Donnez le nom du fichier a decompresser : ");
         get_line(item => nomFichierInitial, last => comptChaine);
         -- On ouvre ce fichier
         open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
         -- On place l'entete de ce fichier dans dans Entete
         -- on décompresse l'image dans MatriceI en remettant dans les pixels dans l'ordre
         decompresserFichierModifie(fichierInitial, entete, matriceI);
         -- On réinitialise FichierInitial en lecture seule
         reset(fichierInitial, in_file);
         -- On récupère le nom du fichier de destination
         put("Entrez le nom du fichier de destination : ");
         get_line(item => NomfichierResultat, last => comptChaine);
          -- on crée ce fichier
         create(FichierResultat, name => NomFichierResultat(1..comptChaine));
         -- On écrit l'entete et le contenu de l'image dans FichierResultat
         ecrireMatriceDansFichier(entete, MatriceI, FichierResultat);
         -- On ferme les fichiers
         close(fichierInitial);
         close(fichierResultat);
         -- On indique à l'utilisateur que le programme est terminé
         put("Traitement effectue.");
       when others =>
         put("Aucun traitement effectue. ");
     end case;

     when others =>
       put("Aucun traitement effectue.");
       new_line;
       put("Programme termine.");
 end case  ;

end ProjetCompression;



J'ai ajouté le choix de garder 255 niveaux de gris, ou de n'en conserver que 32 (a priori meilleure
compression, et non perceptible par l'oeuil humain).

C'est à n'en pas douter perfectible...
Je suis pas non plus tout à fait sûr que ça fasse exactement le parcours décrit plus haut...
Faut que je teste plus en profondeur...

Mais je perds pas de pixel pendant la compression / décompression, et ils se remettent a priori
bien à leur place.

Ouvert à toutes question, discussion, ou suggestion. :)

ftbass - 28/05/2004 à 01:05

J'ai modifié le prog pour qu'il prenne en compte les .pgm

Les résultats ne sont pas satisfaisants car la méthode de parcours simple donne un meilleur
résultat sur une image complexe que le parcours complexe justement... :(

Pourtant je parcours l'image comme expliqué plus haut (en Z), et d'aprés le prof, les résultats
devraient être meilleurs (ça me semble aussi logique...).

J'ai fait un logiciel pour créer une image (un .pgm) particulier pour vérifier que je ne m'étais pas
planté dans le parcours complexe, et visiblement, je parcours le fichier comme il faut.

Voilà le code de ce programme :

code:

--//////////////////////////////////////////////////////////--
--          Code écrit par Julien COIGNET            --
--      afin de vérifier le programme de compression      --
--//////////////////////////////////////////////////////////--


with text_io; use text_io;
with ada.integer_Text_Io; use ada.integer_Text_Io;
with sequential_io;

procedure creationImage is

--////////////////////////////////////////////////////////////////////////--
--                                    Paquetages                          --
--////////////////////////////////////////////////////////////////////////--

package fichier_car is new sequential_IO(character); use fichier_car;

--////////////////////////////////////////////////////////////////////////--
--                                    Types                              --
--////////////////////////////////////////////////////////////////////////--

-- Type Entete: Vecteur qui contient l'entete du fichier image
type TypeEntete is array (0..42) of character;

-- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels
type TypeMatrice is array (0..255, 0..255) of character;

--////////////////////////////////////////////////////////////////////////--
--                  Programme principal                  --
--////////////////////////////////////////////////////////////////////////--

Fichier : fichier_car.file_type;
Matrice : typeMatrice;
entete : typeEntete;
compteur : integer := 0;

begin
 
 create(Fichier, name => "img.pgm");

 entete(0..1) := "P5";
 entete(2) := character'val(10);
 entete(3..29) := "# Created by Julien COIGNET";
 entete(30) := character'val(10);
 entete(31..37) := "256 256";
 entete(38) := character'val(10);
 entete(39..41) := "255";
 entete(42) := character'val(10);

 for i in 0..42 loop
   write(fichier, entete(i));
 end loop;

 for i in 0..255 loop
   for j in 0..255 loop
     compteur := compteur + 1;
     if compteur <= 2 then
       write(fichier, character'val(0));
     else
       write(fichier, character'val(255));
     end if;
     if compteur = 4 then
       compteur := 0;
     end if;
   end loop;
 end loop;

 close(fichier);
 
 put("Image creee avec succes.");

end creationImage;


On crée ici une image avec des rayures verticales de 2 pixels de large. D'après les descriptions
des 2 types de RLE étudiés, il semble évident que la compression avec le parcours complexe doit
prendre 2 fois moins de place que la compression avec le parcours simple.
Et c'est ce qu'il se passe en effet...

Donc je ne comprends pas pourquoi les résultats sur une image complexe sont décevants...

ftbass - 28/05/2004 à 19:06

voilà 3 images de test :

http://ada95000.free.fr/Images/imgTest.jpg
premiere (image réalisée avec le programme ci-dessus.

http://ada95000.free.fr/Images/Image1.jpg
deuxieme

http://ada95000.free.fr/Images/cassis256.jpg
troisieme, ou les limites de ma méthode RLE :grin:

Attention, elles apparaissent en jpg, il faut cliquer sur lien pour télécharger la version .pgm.

voilà :D

arnaud - 25/08/2004 à 14:17

eh ! mais qu'est-ce que t'as fais a ta guibole !

ftbass - 25/08/2004 à 20:41

Une entorse grave. 10 semaines d'arrêt de travail :)

arnaud - 26/08/2004 à 13:01

ca t'es arrive comment ?

ftbass - 27/08/2004 à 12:18

En jouant au basket...

C'est dangeureux pour la santé le sport...