compression/decodage.pas

program decodage;

uses crt,dos,math;

type
	liste=^cellule;
	cellule=record
			octet:byte;
			freq:longword;
			suiv:liste;
			gauche:liste;
			droite:liste;
			end;
	fichier=array of byte;
	catalogue=array[0..255] of byte;

var p:fichier;l:liste;premier:byte;taille,index:longword;chemin:string;

function prefixe(ind:fichier):longword;
var s,i:longword;
begin
s:=0;
for i:=length(ind)-1 downto 0 do s:=(ind[i] div 2)*trunc(power(2,7*(length(ind)-1-i)))+s;
prefixe:=s;
end;

procedure importer(var p:fichier; var l:liste; var premier:byte;var chemin:string);
var f:file;i:longword;j,longueur:byte;ind:fichier;l1,l2:liste;
begin
write('Chemin du fichier : ');
readln(chemin);
assign(f,chemin);
reset(f,1);
writeln('Importation...');
blockread(f,longueur,1);
(*Pour éviter les problèmes avec longueur=0, on fera une boucle de 0 à longueur-1*)
longueur:=longueur-1;
new(l);
l^.suiv:=nil;
setlength(ind,0);
for j:=0 to longueur do
	begin
	l^.gauche:=nil;
	l^.droite:=nil;
	blockread(f,l^.octet,1);
	repeat
		begin
		setlength(ind,length(ind)+1);
		blockread(f,ind[length(ind)-1],1);
		end;
	until ind[length(ind)-1] mod 2 = 0;
	l^.freq:=prefixe(ind);
	setlength(ind,0);
	new(l1);
	l1^.suiv:=l;
	l:=l1;
	end;
l2:=l;
l:=l^.suiv;
dispose(l2);
blockread(f,premier,1);
i:=0;
setlength(p,filesize(f)-filepos(f));
while not eof(f) do
	begin
	blockread(f,p[i],1);
	i:=i+1;
	end;
close(f);
end;

function inserer(var l:liste; var l1:liste):liste;
begin
if l=nil then
	begin
	l1^.suiv:=nil;
	inserer:=l1;
	end
else
	begin
	if l1^.freq<=l^.freq then
		begin
		l1^.suiv:=l;
		inserer:=l1;
		end
	else
		begin
		l^.suiv:=inserer(l^.suiv,l1);
		inserer:=l;
		end;
	end;
end;

procedure arbre(var l:liste);
var l1:liste;
begin
if l^.suiv<>nil then
	begin
	new(l1);
	l1^.gauche:=l;
	l1^.droite:=l^.suiv;
	l1^.freq:=l^.freq+l^.suiv^.freq;
	l:=inserer(l^.suiv^.suiv,l1);
	arbre(l);
	end;
end;

function bit(b,position:byte):byte;
begin
bit:=(b div trunc(power(2,position)))-(2*(b div trunc(power(2,position+1))));
end;

procedure interpreter(l:liste;var p:fichier;premier:byte);
var m:byte;l1:liste;f:fichier;i:longword;
begin
m:=premier;
l1:=l;
setlength(f,0);
for i:=0 to length(p)-1 do
	begin
	repeat
		begin
		if bit(p[i],m)=0 then l1:=l1^.gauche else l1:=l1^.droite;
		if ((l1^.gauche=nil) and (l1^.droite=nil)) then
			begin
			setlength(f,length(f)+1);
			f[length(f)-1]:=l1^.octet;
			l1:=l;
			end;
		m:=m-1;
		end;
	until m=255;
	m:=7;
	end;
p:=f;
setlength(f,0);
end;

procedure coder(p:fichier;taille:longword);
var ref,car:catalogue;i:longword;j,k,l:byte;f:fichier;
begin
for i:=0 to 255 do ref[i]:=i;
car:=ref;
setlength(f,taille);
for i:=0 to taille-1 do
	begin
	j:=p[i];
	f[i]:=car[j];
	l:=car[j];
	for k:=j downto 1 do
		begin
		car[k]:=car[k-1];
		end;
	car[0]:=l;
	end;
p:=f;
setlength(f,0);
end;

function prefixe(ind:fichier;taille:longword):longword;
var s,i:longword;
begin
s:=0;
for i:=taille-1 downto 0 do s:=(ind[i] div 2)*trunc(power(2,7*(taille-1-i)))+s;
prefixe:=s;
end;

procedure preliminaire(var f:fichier;var index:longword);
var ind,p:fichier;i,j:longword;
begin
i:=0;
setlength(ind,0);
repeat
	begin
	setlength(ind,i+1);
	ind[i]:=f[i];
	i:=i+1;
	end;
until ind[i-1] mod 2 = 0;
index:=prefixe(ind,i);
setlength(ind,0);
setlength(p,length(f)-i);
for j:=i to length(f)-1 do p[j-i]:=f[i];
f:=p;
setlength(p,0);
end;

function decode(index,taille:longword;t:fichier):fichier;
var i,j,sum:longword;C,P:array of longword;S:fichier;
begin
setlength(C,256);
setlength(P,taille);
setlength(S,taille);
for i:=0 to 255 do C[i]:=0;
for i:=0 to taille-1 do
	begin
	P[i]:=C[t[i]];
	C[t[i]]:=C[t[i]]+1;
	end;
sum:=0;
for i:=0 to 255 do
	begin
	sum:=sum+C[i];
	C[i]:=sum-C[i];
	end;
i:=index;
for j:=taille-1 downto 0 do
	begin
	S[j]:=t[i];
	i:=P[i]+C[t[i]];
	end;
decode:=S;
end;

function nouv_chemin(chemin,nom:string):string;
var i:byte;s:string;
begin
s:=chemin;
i:=length(chemin);
while s[i]<>'/' do i:=i-1;
delete(s,i,length(chemin)-i+1);
nouv_chemin:=s+'/'+nom
end;

procedure ecrire(d:fichier;taille:longword;chemin:string);
var f1:file;nom:string;i:longword;
begin
write('Nom du fichier : ');
readln(nom);
assign(f1,nouv_chemin(chemin,nom));
rewrite(f1,1);
writeln('Écriture de la séquence...');
for i:=0 to taille-1 do
	begin
	blockwrite(f1,d[i],1);
	end;
close(f1);
end;

begin
importer(p,l,premier,chemin);
arbre(l);
interpreter(l,p,premier);
taille:=length(p);
coder(p,taille);
preliminaire(p,index);
taille:=length(p);
p:=decode(index,taille,p);
writeln('ok');
ecrire(p,taille,chemin);
end.