ftbass
|
Publié le 27/08/2004 à 12:18 |
RE : Compression d'images sans perte de qualité
En jouant au basket...
C'est dangeureux pour la santé le sport... |
arnaud
Member 
Messages: 5
Inscrit(e) le: 25/08/2004 Lieu de résidence : montataire
Déconnecté(e)
|
Publié le 26/08/2004 à 13:01 |
RE : Compression d'images sans perte de qualité
ca t'es arrive comment ? |
ftbass
|
Publié le 25/08/2004 à 20:41 |
RE : Compression d'images sans perte de qualité
Une entorse grave. 10 semaines d'arrêt de travail  |
arnaud
Member
Messages: 5
Inscrit(e) le: 25/08/2004 Lieu de résidence : montataire
Déconnecté(e)
|
Publié le 25/08/2004 à 14:17 |
RE : Compression d'images sans perte de qualité
eh ! mais qu'est-ce que t'as fais a ta guibole ! |
ftbass
|
Publié le 28/05/2004 à 19:06 |
RE : Compression d'images sans perte de qualité
voilà 3 images de test :
premiere (image réalisée avec le programme ci-dessus.
deuxieme
troisieme, ou les limites de ma méthode RLE 
Attention, elles apparaissent en jpg, il faut cliquer sur lien pour télécharger la version .pgm.
voilà  |
ftbass
|
Publié le 28/05/2004 à 01:05 |
RE : Compression d'images sans perte de qualité
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
|
Publié le 27/05/2004 à 17:17 |
RE : Compression d'images sans perte de qualité
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
|
Publié le 27/05/2004 à 17:14 |
RE : Compression d'images sans perte de qualité
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
|
Publié le 27/05/2004 à 00:16 |
RE : Compression d'images sans perte de qualité
Alors voilà, en fait le premier RLE correspond un parcours du type :
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 :
Image de 8 x 8
...la suite demain... |
ftbass
|
Publié le 26/05/2004 à 23:32 |
RE : Compression d'images sans perte de qualité
Demain, je poste une update
Comme il faut le rendre cette semaine...
Pour la douleur, une photo de mon pied :
Aucun maquillage... |
ftbass
|
Publié le 30/04/2004 à 17:31 |
RE : Compression d'images sans perte de qualité
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
|
Publié le 30/04/2004 à 16:51 |
RE : Compression d'images sans perte de qualité
J'ai bien avancé dans les procédures de compression et décompression. Je sais, c'est pas compliqué, mais c'est encore buggé... 
Je les posterai plutot ce week-end, si je m'en sors... |
ftbass
|
Publié le 30/04/2004 à 00:16 |
Compression d'images sans perte de qualité
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  |
|
