(*DCT et/ou FFT*)
(*fft*)
let pi=3.1415926535897932384626433832795;;
let fft mat = let m1=make_matrix 8 8 0. and m2=make_matrix 8 8 0. and temp =ref 0. and temp2=ref 0. in
for u = 0 to 7 do
for v = 0 to 7 do
temp:=0.;
temp2:=0.;
for i = 0 to 7 do
for j = 0 to 7 do
temp:= !temp +. cos ( pi /. 4. *. ( (float_of_int u)*. (float_of_int i)+.(float_of_int v)*. (float_of_int j)))*. mat.(i).(j) ;
temp2:= !temp2 -. sin ( pi /. 4. *. ( (float_of_int u)*. (float_of_int i)+.(float_of_int v)*. (float_of_int j)))*. mat.(i).(j) ;
done;done;
m1.(u).(v)<- !temp /. 8.;
m2.(u).(v)<- !temp2 /. 8.;
done;done;(m1,m2);;
let unfft (m1,m2) = let mat=make_matrix 8 8 0. and temp =ref 0. and temp2=ref 0. in
for u = 0 to 7 do
for v = 0 to 7 do
temp:=0.;
temp2:=0.;
for i = 0 to 7 do
for j = 0 to 7 do
temp:= !temp +. cos ( pi /. 4. *. ( (float_of_int u)*. (float_of_int i)+.(float_of_int v)*. (float_of_int j)))*. m1.(i).(j) ;
temp:= !temp -. sin ( pi /. 4. *. ( (float_of_int u)*. (float_of_int i)+.(float_of_int v)*. (float_of_int j)))*. m2.(i).(j) ;
done;done;
mat.(u).(v)<- !temp /. 8.;
done;done;mat;;
let un_of_deux (m1,m2)= let mat = make_matrix 8 8 0. in
for i = 5 to 7 do
for j = 0 to 7 do
mat.(i).(j)<- m2.(i).(j);
done;done;
for j = 5 to 7 do
for i = 0 to 7 do
mat.(i).(j)<- m2.(i).(j);
done;done;
for j = 0 to 4 do
for i = 0 to 4 do
mat.(i).(j)<- m1.(i).(j);
done;done;
mat.(5).(1)<-m1.(5).(1);
mat.(5).(2)<-m1.(5).(2);
mat.(6).(1)<-m1.(6).(1);
mat.(1).(5)<-m1.(1).(5);
mat.(1).(6)<-m1.(1).(6);
mat.(1).(7)<-m1.(1).(7);
mat.(2).(5)<-m1.(2).(5);
mat.(2).(6)<-m1.(2).(6);
mat.(3).(5)<-m1.(3).(5);
mat;;
let ch0 =int_of_char `0`;;
let ch i=char_of_int (i + ch0);;
let deux_of_un mat = let m1 = make_matrix 8 8 0. and m2 = make_matrix 8 8 0. in
for i = 0 to 7 do
for j = 0 to 7 do
begin
match (ch i,ch j) with
|(`0`..`4`,`0`..`4`)|(`1`,`5`..`7`)|(`2`,`5`..`6`)|(`3`,`5`)|(`5`,`1`..`2`)|(`6`,`1`)->m1.(i).(j)<-mat.(i).(j); m1.((8-i) mod 8).((8-j) mod 8)<-mat.(i).(j);
|_->m2.(i).(j)<-mat.(i).(j); m2.((8-i) mod 8).((8-j) mod 8)<-(-. mat.(i).(j));
end
done;done;(m1,m2);;
let makerand ()= let m = make_matrix 8 8 0 in
for i = 0 to 7 do
for j = 0 to 7 do
m.(i).(j)<-random__int 256;
done;done;m;;
let simp (m1,m2)= let l1 = make_matrix 8 8 0 and l2 = make_matrix 8 8 0 in
for i = 0 to 7 do
for j = 0 to 7 do
l1.(i).(j)<-int_of_float(m1.(i).(j));
l2.(i).(j)<-int_of_float(m2.(i).(j));
done;done;(l1,l2);;
let simp2 m1= let l1 = make_matrix 8 8 0 in
for i = 0 to 7 do
for j = 0 to 7 do
l1.(i).(j)<-int_of_float(m1.(i).(j));
done;done;(l1);;
let moins (m1,m2) (m3,m4)= let l1 = make_matrix 8 8 0. and l2 = make_matrix 8 8 0. in
for i = 0 to 7 do
for j = 0 to 7 do
l1.(i).(j)<-m1.(i).(j) -. m3.(i).(j);
l2.(i).(j)<-m2.(i).(j) -. m4.(i).(j);
done;done;(l1,l2);;
let moins2 m1 m3= let l1 = make_matrix 8 8 0. in
for i = 0 to 7 do
for j = 0 to 7 do
l1.(i).(j)<-(float_of_int m1.(i).(j)) -. m3.(i).(j);
done;done;(l1);;
let fourier mat = un_of_deux (fft mat);;
let unfourier mat = unfft (deux_of_un mat);;
(*fin FFT*)
(*let tempory = ref [||];;*)
let c = function
0->1.0/.(sqrt 2.)
|_->1.0;;
let sousftab = make_matrix 8 8 0.;;
let creersousftab () =for a=0 to 7 do
for b = 0 to 7 do
let a1=float_of_int a and b1=float_of_int b and pi=acos((-.1.)) in
sousftab.(a).(b)<-cos ((2.*.a1+.1.)*.b1*.pi/.16.);done;done;;
creersousftab();;
(*let sousf1 a b = let a1=float_of_int a and b1=float_of_int b and pi=3.14159265 in
cos ((2.*.a1+.1.)*.b1*.pi/.16.);;*)
let sousf1 a b = sousftab.(a).(b);;
let nbDCT u v mat = let s=ref 0. in
for i = 0 to 7 do
for j = 0 to 7 do
s:= !s +. (mat.(i).(j)) *. (sousf1 i u ) *. ( sousf1 j v )
done;done;1.0/.4.0*. (c u)*.(c v)*. !s;;
let DCT mat = let mat2 = (make_matrix 8 8 0.) in
for u = 0 to 7 do
for v= 0 to 7 do
mat2.(u).(v)<-nbDCT u v mat
done;done;mat2;;
let DCT_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- DCT (a.(i).(j))
done;done;a2;;
let nbunDCT i j mat = let s = ref 0. in
for u = 0 to 7 do
for v = 0 to 7 do
s:= !s +. (c u) *. (c v) *. (mat.(u).(v)) *. (sousf1 i u) *. (sousf1 j v)
done;done;1.0/.4.0*. !s;;
let unDCT mat = let mat2 = make_matrix 8 8 0. in
for i = 0 to 7 do
for j = 0 to 7 do
mat2.(i).(j)<- nbunDCT i j mat
done;done;mat2;;
let unDCT_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- unDCT (a.(i).(j))
done;done;a2;;
(*fft*)
let FFT_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- fourier (a.(i).(j))
done;done;a2;;
let unFFT_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- unfourier (a.(i).(j))
done;done;a2;;
(*Quantification*)
let creermatquant n = let mat = make_matrix 8 8 0 in
for i = 0 to 7 do
for j = 0 to 7 do
mat.(i).(j)<- 1+(1+i+j)*n
done;done;mat;;
let quantification mat mat2 = let mat3=make_matrix 8 8 0 in (*mat2:mat de quantification*)
for i = 0 to 7 do
for j = 0 to 7 do
mat3.(i).(j)<-int_of_float ( mat.(i).(j)/. float_of_int mat2.(i).(j));
(*if mat3.(i).(j)>128 then mat3.(i).(j)<-128 else
if mat3.(i).(j)<(-128) then mat3.(i).(j)<-(-128)*)
done;done;mat3;;
let quantification_mat a n = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] and mat2=creermatquant n in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- quantification (a.(i).(j)) mat2
done;done;a2;;
let dequantification mat mat2 = let mat3=make_matrix 8 8 0. in (*mat2:mat de quantification*)
for i = 0 to 7 do
for j = 0 to 7 do
mat3.(i).(j)<-(float_of_int mat.(i).(j))*. (float_of_int mat2.(i).(j));
done;done;mat3;;
(*let matr = ref [||];;*)
let dequantification_mat a n = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] and mat2=creermatquant n in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- dequantification (a.(i).(j)) mat2
done;done;a2;;
(*zig-zag*)
let pair a = ((a/2)*2)=a;;
let impair a =not (pair a);;
let lecturezigzag mat = let liste= (make_vect 64 0) and x=ref 0 and y = ref 0 and des= ref true in
for i = 0 to 63 do
liste.(i)<-mat.(!x).(!y);
if ((!y=0 or !y=7) & (pair !x)) then begin x:= !x+1;des:=(!y=0) end
else begin
if ((!x=0 or !x=7) & (not (pair !y))) then begin y:= !y+1;des:=(!x=7) end
else begin
if !des then begin y:=!y+1; x:=!x-1 end
else begin y:=!y-1; x:=!x +1 end
end
end
done;liste;;
let ecriturezigzag liste = let mat= make_matrix 8 8 0 and x=ref 0 and y=ref 0 and des = ref true in
for i = 0 to 63 do
mat.(!x).(!y)<-liste.(i);
if ((!y=0 or !y=7) & (pair !x)) then begin x:= !x+1;des:=(!y=0) end
else begin
if ((!x=0 or !x=7) & (not (pair !y))) then begin y:= !y+1;des:=(!x=7) end
else begin
if !des then begin y:=!y+1; x:=!x-1 end
else begin y:=!y-1; x:=!x +1 end
end
end
done;mat;;
let approx n= if (n-.(floor n)) >=.0.5 then int_of_float ((floor n) +.1.) else (int_of_float (floor n));;
(*downsample*)
let downsample mat n =let mat2=make_matrix 4 (4*(3-n)) 0. and s=ref 0. in
for x = 0 to 3 do
for y = 0 to (4*(3-n)-1) do
s:=0.;
for i = 0 to n-1 do
s:= !s+. mat.(2*x).(y*n+i)+. mat.(2*x+1).(y*n+i)
done;
mat2.(x).(y)<-(!s)/. (float_of_int (2*n)) (*pas d'approx car ensuite on applique dct*)
done;done;mat2;;
let undownsample mat = let mat2 = make_matrix 8 8 0. and n = 3-(vect_length (mat.(0)))/4 in
for x = 0 to 7 do
for y = 0 to 7 do
mat2.(x).(y)<-(mat.(x/2).(y/n))
done;done;mat2;;
let downsample_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- downsample (a.(i).(j)) 2
done;done;a2;;
let undownsample_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
a2.(i).(j)<- undownsample (a.(i).(j))
done;done;a2;;
let reco a b c d = let e = make_matrix 8 8 0. in
for i = 0 to 3 do
for j = 0 to 3 do
e.(i).(j)<-a.(i).(j);
e.(4+i).(j)<-b.(i).(j);
e.(i).(j+4)<-c.(i).(j);
e.(i+4).(j+4)<-d.(i).(j);
done;done;e;;
let moye a = let s = ref 0. in
for i = 0 to 3 do
for j = 0 to 3 do
s:=a.(i).(j) +. !s
done;done;!s/.16.;;
let approxi a b = if a/b *b= a then a/b else a/b+1;;
let recolle_downsample (a:float vect vect vect vect) =let larg = vect_length a and haut = vect_length (a.(0)) in
let a2 = make_matrix (approxi larg 2) (approxi haut 2) [|[||]|] in
for i = 0 to larg/2-1 do
for j = 0 to haut/2-1 do
a2.(i).(j)<-reco (a.(i*2).(j*2)) (a.(i*2+1).(j*2)) (a.(i*2).(j*2+1)) (a.(i*2+1).(j*2+1))
done;done;
begin if (impair haut) then
for i = 0 to (larg/2)-1 do
let temp = make_matrix 8 8 (((moye (a.(i*2).(haut-1))) +. (moye (a.(i*2).(haut-1))))/.2.) in
for x = 0 to 3 do
for y = 0 to 3 do
temp.(x).(y)<-a.(i*2).(haut-1).(x).(y);
temp.(x).(y+4)<-a.(i*2+1).(haut-1).(x).(y);
done;done;a2.(i).(haut/2)<-temp;done;end;
begin if (impair larg) then
for i = 0 to (haut/2)-1 do
let temp = make_matrix 8 8 (((moye (a.(larg-1).(i*2))) +. (moye (a.(larg-1).(i*2))))/.2.) in
for x = 0 to 3 do
for y = 0 to 3 do
temp.(x).(y)<-a.(larg-1).(i*2).(x).(y);
temp.(x+4).(y)<-a.(larg-1).(i*2+1).(x).(y);
done;done;a2.(larg/2).(i)<-temp;done;end;
begin if (impair (haut*larg)) then
let temp = make_matrix 8 8 (moye (a.(larg-1).(haut-1))) in
for x = 0 to 3 do
for y = 0 to 3 do
temp.(x).(y)<-a.(larg-1).(haut-1).(x).(y);
done;done;a2.(larg/2).(haut/2)<-temp;end;a2;;
let decoupe mat = let a = make_matrix 4 4 0. and b = make_matrix 4 4 0. and c = make_matrix 4 4 0. and d = make_matrix 4 4 0. in
for i = 0 to 3 do
for j = 0 to 3 do
a.(i).(j)<-mat.(i).(j);
b.(i).(j)<-mat.(i+4).(j);
c.(i).(j)<-mat.(i).(j+4);
d.(i).(j)<-mat.(i+4).(j+4);
done;done;(a,b,c,d);;
let unrecolle_downsample a largeur hauteur = (*largeur et hauteur de l'image en pixels*)
let nbl =approxi largeur 8 and nbh = approxi hauteur 8 in
let a2 = make_matrix nbl nbh [|[||]|]
and larg = vect_length a and haut = vect_length (a.(0)) in
for i = 0 to larg -1 do
for j = 0 to haut -1 do
let temp = decoupe (a.(i).(j)) in
a2.(2*i).(2*j)<-(function (a,b,c,d)->a) temp;
begin if 2*i+1<=nbl-1 then a2.(2*i+1).(2*j)<-(function (a,b,c,d)->b) temp;end;
begin if 2*j+1<=nbh-1 then a2.(2*i).(2*j+1)<-(function (a,b,c,d)->c) temp;end;
begin if 2*i+1<=nbl-1 & 2*j+1<=nbh-1 then a2.(2*i+1).(2*j+1)<-(function (a,b,c,d)->d) temp;end;
done;done;a2;;
(*RLE*)
let chr n = string_of_char ( char_of_int n);;
exception zeroRLE;;
exception errRLE;;
let RLE liste= let chaine = ref "" and zero = ref 0 in
for i =1 to 63 do (*on stocke le premier ailleur!!!!!!*)
if liste.(i)=128 then zero:=!zero+1 (*le zero est en fait 128*)
else if !zero = 0 then chaine:=concat [ !chaine; chr liste.(i)]
else begin
chaine:= concat [ !chaine; chr 128 ;chr !zero; chr liste.(i)] ;
if !zero>63 then raise errRLE else
zero:=0; end;
done;
if !zero<> 0 then
concat [!chaine; chr 128; chr !zero]
else !chaine;;
let sature liste = let liste2=make_vect 64 0 in (*ajoute 128 pour que tout soit positif et applique saturation si >255 ou <0*)
liste2.(0)<-liste.(0);
for i = 1 to 63 do (*ATTENTION ON NE TOUCHE PAS AU PREMIER:liste (0)*)
liste2.(i)<-128+liste.(i);
if liste2.(i)>255 then liste2.(i)<-255
else if liste2.(i)<0 then liste2.(i)<-0
done;liste2;;
let unsature liste = let liste2=make_vect 64 0 in
liste2.(0)<-liste.(0);
for i = 1 to 63 do
liste2.(i)<-liste.(i)-128;
done;liste2;;
let asc chai=int_of_char chai;;
(*ATTENTION PENSER A RECUPERER LE PREMIER QUE L'ON A MIS AILLEURs*)
exception ErreurUnrle;;
let unRLE chaine = let liste = make_vect 64 0 and i=ref 1 and j = ref 0 in
while !i<= 63 do
if (asc chaine.[!j])=128 then begin
if (asc chaine.[!j+1])= 0 then raise zeroRLE else
for k = 0 to ((asc chaine.[!j+1])-1) do
if !i+k>63 then raise ErreurUnrle else
liste.(!i+k)<-128
done;
i:=!i+(asc chaine.[!j+1]);j:=!j+2 end
else begin
liste.(!i)<-(ascchaine.[!j]);i:=!i+1;j:=!j+1 end;
done;(liste,sub_string chaine !j ((string_length chaine)- !j));;
let RLE_mat a = let larg = vect_length a and haut = vect_length (a.(0)) in
let prem = make_vect (larg*haut) 0 and chai=ref "" and chai2 = ref "" in
for i = 0 to larg-1 do
for j = 0 to haut-1 do
prem.(i*haut+j)<-a.(i).(j).(0).(0);
chai2:=concat [!chai2; (RLE (sature (lecturezigzag (a.(i).(j)))))]
done;
chai:= concat [!chai; !chai2];chai2:="";
done;
(!chai,prem);;
exception ErreurRLE of int;;
let unRLE_mat chaine = let chai = ref "" and vecte = ref [||] and vecte2= ref [||] in
chai:=chaine;
while (string_length !chai) <> 0 do
let temp = unRLE !chai in
chai := (function (a,b)->b) temp ;
vecte2 := concat_vect !vecte2 [|ecriturezigzag (unsature ((function (a,b)->a) temp))|];
if vect_length !vecte2 >= 1000 then begin vecte:= concat_vect !vecte !vecte2 ; vecte2:=[||];end ;
done;concat_vect !vecte !vecte2 ;;
(*Huffman*)
let compte chai = let m = make_vect 256 0 in
for i = 0 to ((string_length chai)-1) do
m.(asc chai.[i]) <- m.(asc chai.[i]) + 1
done;m;;
let plus_petit liste=let ppe = ref (-1) and ppe2=ref (-1) and vppe=ref (float_of_int max_int) and vppe2=ref (float_of_int max_int) in
for i = 0 to ((vect_length liste)-1) do
ifliste.(i)<=!vppethenbeginppe2:=!ppe;ppe:=i;vppe2:=!vppe;vppe:=liste.(i) end
else if liste.(i)<= !vppe2thenbeginppe2:=i;vppe2:=liste.(i) end;
done;[|!ppe;!ppe2|];;
(*let copy_string chai = let chai2=make_string (string_length chai) `1` in
for i = 0 to ((string_length chai) -1) do
chai2.[i]<-chai.[i];
done;chai2;;*)
let copy_string chai = concat ["";chai];;
let rec sous_creer_arbre arb nomb = let n = vect_length nomb in
let arb2=make_vect (n-1) "" and nomb2=make_vect (n-1) 0 and min1=ref max_int and min2=ref max_int and ind1 = ref 259 and ind2= ref 259 and tem=ref 0 and arb3=copy_vect arb in
if n = 2 then [|"0";"1"|] else begin
for i = 0 to (n-1) do
if i <> (n-1) then begin arb2.(i)<-(copy_string (arb.(i))) ; nomb2.(i)<-nomb.(i);end;
if nomb.(i)< !min2 then
if nomb.(i)< !min1 then
begin min2:= !min1;min1:=nomb.(i);ind2:= !ind1;ind1:=i ; end
elsebeginmin2:=nomb.(i);ind2:=i end;
done;
if !ind1 = !ind2 then raise Exit;
if !ind1 <> (n-1) & !ind2 <> (n-1) then begin
nomb2.(!ind1)<-nomb2.(!ind1) + nomb2.(!ind2);
nomb2.(!ind2)<-nomb.(n-1);
arb2.(!ind2)<-(copy_string (arb.(n-1)));
arb2.(!ind1)<-"";
let temp = sous_creer_arbre arb2 nomb2 in
arb3.(!ind1)<- (concat [temp.(!ind1);arb.(!ind1);"0"]);
arb3.(!ind2)<- (concat [temp.(!ind1);arb.(!ind2);"1"]);
arb3.(n-1) <- concat [temp.(!ind2);arb.(n-1)];
for i = 0 to n-2 do
if i <> !ind1 & i <> !ind2 then arb3.(i)<- concat [temp.(i);arb.(i)]
done;arb3;
end
else begin begin if !ind1=(n-1) then tem:= !ind2 else tem:= !ind1 end;
nomb2.(!tem)<-nomb.(!ind1) + nomb.(!ind2);
arb2.(!tem)<-"";
let temp = sous_creer_arbre arb2 nomb2 in
arb3.(!ind1)<- (concat [temp.(!tem);arb.(!ind1);"0"]);
arb3.(!ind2)<- (concat [temp.(!tem);arb.(!ind2);"1"]);
for i = 0 to n-2 do
if i <> !ind1 & i <> !ind2 then arb3.(i)<- concat [temp.(i);arb.(i)]
done;arb3;
end;
end;;
let creer_arbre chai = let arbre2= make_vect 256 "" and nb = compte chai in
let mat=ref [||] in
for i = 0 to 255 do
if nb.(i)<> 0 then mat := concat_vect !mat [|nb.(i)|];
done;
let arbr = make_vect (vect_length !mat) "" in
let result = sous_creer_arbre arbr !mat and ind = ref 0 in
for i = 0 to 255 do
if nb.(i)<> 0 then begin arbre2.(i)<-result.(!ind);ind:= !ind+1 end
done;arbre2;;
let val = function
`1`->1
|`0`->0
|_->raise Exit;;
let unbinar chaine = let chaine2=ref "" and n = string_length chaine and chainep = ref "" and temp = ref 0 in
chainep :=concat [chaine; make_string ((8-(n-n/8*8)) mod 8) `0`];
begin if n/8*8=n then temp:=n/8-1else temp:=n/8;end ;
for i = 0 to !temp do
chaine2:=concat [!chaine2; chr ((val !chainep.[i*8]*128)+(val !chainep.[i*8+1]*64)+(val !chainep.[i*8+2]*32)+
(val !chainep.[i*8+3]*16)+(val !chainep.[i*8+4]*8)+(val !chainep.[i*8+5]*4)+(val !chainep.[i*8+6]*2)+(val !chainep.[i*8+7]))]
done;(!chaine2,(8-(n-n/8*8)) mod 8);;
let concate a b = match a with
(c,d)->(c,d,b);;
let huffman chaine = begin if chaine ="" then raise Exit end;
let arbre = creer_arbre chaine and chaine2=ref "" and result = ref "" and temp= ref ("",0) in
for i = 0 to ((string_length chaine) -1) do
chaine2:=concat [!chaine2;arbre.(asc chaine.[i])];
if (string_length !chaine2)>400 then begin temp:= unbinar (sub_string !chaine2 0 400);
chaine2:=sub_string !chaine2 400 ((string_length !chaine2)-400);
if ((function(a,b)->b) !temp)<> 0 then raise Exit else result := concat [!result;(function (a,b)->a) !temp] end
done;
temp:=(unbinar !chaine2);
let temp2 = (concat [!result;(function (a,b)->a) !temp],(function (a,b)->b) !temp) in
concate temp2 arbre;;
let puiss2 i = int_of_float (2.** (float_of_int i));;
let binaire a = let n = ref (int_of_char a ) and chai = ref "" in
for i = 7 downto 0 do
if !n >= (puiss2 i) then begin n:=!n- (puiss2 i);chai := concat [!chai;"1"] end
else chai:=concat [!chai;"0"] done;!chai;;
let binar chaine nb = let chaine2=ref "" and chaine3=ref "" in
for i = 0 to (string_length chaine)-2 do
chaine3:=concat[!chaine3;binaire chaine.[i]] ;
if i/1000*1000 = i then begin chaine2:= concat [ !chaine2;!chaine3];chaine3:="" end;
done;
concat [!chaine2;!chaine3;sub_string (binaire (chaine.[(string_length chaine)-1])) 0 (8-nb)];; (* if nb <> 0 then else !chaine2;;*)
let creermatarbre liste= let mat1 = ref [||] and mat2=ref [||] in
for i = 0 to 255 do
if liste.(i)<> "" then begin mat1:=concat_vect !mat1 [|chr i|];mat2:=concat_vect !mat2 [|liste.(i)|];end;
done;[|!mat1;!mat2|];;
let verifadd chaine mat = let mat2=ref [] and mat3 = ref [] and n=string_length chaine and temp=ref true in
for i = 0 to (vect_length mat.(0)-1) do
< p>ifmat.(1).(i)=chainethenbeginmat2:=[mat.(0).(i)];mat3:=[mat.(1).(i)];temp:=false ;end else if !temp thenif sub_string mat.(1).(i) 0 n= chaine then begin mat2:= (mat.(0).(i))::(!mat2);mat3:=(mat.(1).(i))::(!mat3);end;
done;[|vect_of_list (rev !mat2);vect_of_list (rev !mat3)|];;
let unhuffman chaine arbre nb = let chaine2 =binar chaine nb and chaine3=ref "" and chaine4 = ref "" and
mat=creermatarbre arbre and enc=ref false and temp= ref "" and temp2= ref [||] in
for i = 0 to ((string_length chaine2)-1) do
begin if not !enc then begin temp:= string_of_charchaine2.[i];temp2:=mat;enc:=true end
else temp:=concat [ !temp ;(string_of_char chaine2.[i])] end;
temp2:= verifadd !temp !temp2;
if vect_length !temp2.(0)=1 then begin chaine4:=concat [ !chaine4 ; !temp2.(0).(0)];enc:=false end;
if i/1000*1000=i then begin chaine3:= concat [!chaine3;!chaine4] ; chaine4:="" ;end;
done;
concat [!chaine3;!chaine4];;
(*lecture du fichier BMP*)
let dword a b c d = d*16777216+c*65536+b*256+a;;
let moy_mat mat x y = match (x,y) with
(0,y)->mat
|(x,0)->mat
|(x,y)->begin let mo = ref 0 in
for i = 0 to (x-1) do
for j = 0 to (y-1) do
mo:=mat.(i).(j)+ !mo
done;done;mo:= !mo / (x*y);
let mat2= make_matrix 8 8 !mo in
for i = 0 to (x-1) do
for j = 0 to (y-1) do
mat2.(i).(j)<- mat.(i).(j)
done;done; mat2;end;;
let undword x = (x mod 256 , (x/256) mod 256,(x/65536) mod 256,x/16777216);;
#open "io";;
let charge_bmp fichier =let fic = open_in_bin fichier and temp = make_vect 55 0 in
for i = 1 to 54 do temp.(i)<-(input_byte fic) ;done;
if (temp.(1),temp.(2),temp.(29),temp.(30),temp.(31),temp.(32),temp.(33),temp.(34))<> (66,77,24,0,0,0,0,0) then raise Exit else begin
let hauteur = dword temp.(23) temp.(24) temp.(25) temp.(26)
and largeur = dword temp.(19) temp.(20) temp.(21) temp.(22) in
let nbh = approxi hauteur 8
and nbl = approxi largeur 8 in
let vert = (make_matrix nbl nbh [|[||]|]) and rouge = (make_matrix nbl nbh [|[||]|]) and bleu = (make_matrix nbl nbh [|[||]|]) in
for i = 0 to (nbl - 1) do
for j = 0 to (nbh - 1) do
vert.(i).(j)<- make_matrix 8 8 0;
rouge.(i).(j)<- make_matrix 8 8 0;
bleu.(i).(j)<- make_matrix 8 8 0;
done;done;
let longli = (approxi (largeur) 4)*4 and temp1=ref 0 and temp2=ref 0 and temp3=ref 0 in
for j = 0 to (hauteur -1) do
for i = 0 to (longli -1) do
temp1:=input_byte fic ; temp2:=input_byte fic ; temp3:=input_byte fic;
if i<(largeur-1) then begin
(bleu.(i/8).(j/8)).(i mod 8).(j mod 8) <- !temp1 ;
(vert.(i/8).(j/8)).(i mod 8).(j mod 8) <- !temp2 ;
(rouge.(i/8).(j/8)).(i mod 8).(j mod 8) <- !temp3 ; end;
done;done;
(*on enleve les zero qd haut ou larg n'est pas mult de 8. on met la moy à la place*)
for i = 0 to ((hauteur /8 )-1) do
bleu.(nbl-1).(i)<- moy_mat (bleu.(nbl-1).(i)) (largeur mod 8) 8;
vert.(nbl-1).(i)<- moy_mat (vert.(nbl-1).(i)) (largeur mod 8) 8;
rouge.(nbl-1).(i)<- moy_mat (rouge.(nbl-1).(i)) (largeur mod 8) 8;
done;
for i = 0 to ((largeur /8 )-1) do
bleu.(i).(nbh-1)<- moy_mat (bleu.(i).(nbh-1)) 8 (hauteur mod 8) ;
vert.(i).(nbh-1)<- moy_mat (vert.(i).(nbh-1)) 8 (hauteur mod 8) ;
rouge.(i).(nbh-1)<- moy_mat (rouge.(i).(nbh-1)) 8 (hauteur mod 8) ;
done;
bleu.(nbl-1).(nbh-1)<- moy_mat (bleu.(nbl-1).(nbh-1)) (largeur mod 8) (hauteur mod 8) ;
vert.(nbl-1).(nbh-1)<- moy_mat (vert.(nbl-1).(nbh-1)) (largeur mod 8) (hauteur mod 8) ;
rouge.(nbl-1).(nbh-1)<- moy_mat (rouge.(nbl-1).(nbh-1)) (largeur mod 8) (hauteur mod 8) ;
close_in fic;(rouge,vert,bleu,largeur,hauteur);end;;
let ecrdword n fic = match (undword n ) with
(a,b,c,d)->output_byte fic a;output_byte fic b;output_byte fic c;output_byte fic d;;
let sat a = if a>255 then 255 else if a<0 then 0 else a;;
let sauve_bmp fichier rouge vert bleu largeur hauteur = let fic = open_out_bin fichier in
(*debut entete*)
output_byte fic 66;
output_byte fic 77;
ecrdword (hauteur* (approxi (largeur*3) 4)*4 +54) fic;
ecrdword 0 fic;
ecrdword 54 fic;
ecrdword 40 fic;
ecrdword largeur fic;
ecrdword hauteur fic;
output_byte fic 1;
output_byte fic 0;
output_byte fic 24;
output_byte fic 0;
ecrdword 0 fic;
ecrdword (hauteur* (approxi (largeur*3) 4)*4) fic;
ecrdword 3780 fic;
ecrdword 3780 fic;
ecrdword 0 fic;
ecrdword 0 fic;
(*fin entete*)
let rajout = (approxi (largeur*3) 4)*4-(largeur*3) in
for j = 0 to hauteur-1 do
for i = 0 to largeur-1 do
output_byte fic (sat ((bleu.(i/8).(j/8)).(i mod 8).(j mod 8)));
output_byte fic (sat ((vert.(i/8).(j/8)).(i mod 8).(j mod 8)));
output_byte fic (sat ((rouge.(i/8).(j/8)).(i mod 8).(j mod 8)));
done;
for i = 0 to rajout-1 do output_byte fic 0 done;
done;
close_out fic;;
(*transformation RGB <-> YCbCr*)
let YCbCr_of_RGB r g b = let y = make_matrix 8 8 0. and cb= make_matrix 8 8 0. and cr = make_matrix 8 8 0. in
for i = 0 to 7 do
for j = 0 to 7 do
y.(i).(j)<-0.299 *. (float_of_int r.(i).(j)) +. 0.587 *. (float_of_int g.(i).(j)) +. 0.114 *. (float_of_int b.(i).(j));
cb.(i).(j)<- (-.0.1687) *. (float_of_int r.(i).(j)) -. 0.3313 *. (float_of_int g.(i).(j)) +. 0.5 *. (float_of_int b.(i).(j))+.128.;
cr.(i).(j)<-0.5 *. (float_of_int r.(i).(j)) -. 0.4187 *. (float_of_int g.(i).(j)) -. 0.0813 *. (float_of_int b.(i).(j))+.128.;
done;done;(y,cb,cr);;
let RGB_of_YCbCr y cb cr = let r = make_matrix 8 8 0 and g= make_matrix 8 8 0 and b = make_matrix 8 8 0 in
for i = 0 to 7 do
for j = 0 to 7 do
r.(i).(j)<-approx ((-.0.000036819903261) *. cb.(i).(j) +. 1.40198757694 *. cr.(i).(j) +. y.(i).(j)-.179.449696889);
g.(i).(j)<-approx ((-.0.344113281313) *. cb.(i).(j) -. 0.714103821115 *. cr.(i).(j) +. y.(i).(j)+.135.451789111);
b.(i).(j)<-approx (1.77197811674 *. cb.(i).(j) -. 0.000134583412916 *. cr.(i).(j) +. y.(i).(j)-.226.795972265);
done;done;(r,g,b);;
let YCbCr_of_RGB_mat r g b = let larg = vect_length r and haut = vect_length (r.(0)) in
let y = make_matrix larg haut [|[||]|] and cb = make_matrix larg haut [|[||]|] and cr = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut -1 do
y.(i).(j)<- (function (a,b,c)->a) (YCbCr_of_RGB (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
cb.(i).(j)<- (function (a,b,c)->b) (YCbCr_of_RGB (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
cr.(i).(j)<- (function (a,b,c)->c) (YCbCr_of_RGB (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
done;done;(y,cb,cr);;
let RGB_of_YCbCr_mat r g b = let larg = vect_length r and haut = vect_length (r.(0)) in
let y = make_matrix larg haut [|[||]|] and cb = make_matrix larg haut [|[||]|] and cr = make_matrix larg haut [|[||]|] in
for i = 0 to larg-1 do
for j = 0 to haut -1 do
y.(i).(j)<- (function (a,b,c)->a) (RGB_of_YCbCr (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
cb.(i).(j)<- (function (a,b,c)->b) (RGB_of_YCbCr (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
cr.(i).(j)<- (function (a,b,c)->c) (RGB_of_YCbCr (r.(i).(j)) (g.(i).(j)) (b.(i).(j)));
done;done;(y,cb,cr);;
(*cretion du fichier jpeg*)
let prem_string a = let chaine=ref "" in
for i = 0 to ((vect_length a)-1) do
chaine:=concat [!chaine;chr (a.(i) mod 256);chr (a.(i)/256)];
done;!chaine;;
let unprem_string chai = let a = make_vect ((string_length chai)/2) 0 in
for i = 0 to ((string_length chai)/2-1) do
a.(i)<-(asc chai.[2*i])+(asc chai.[2*i+1])*256
done;a;;
(*attention si code binaire > 16 bits il est tronque*)
let string_of_arbre arb = let chaine = ref ""
and ds a=if a = "" then "ÿÿ" else
if (string_length a) = 1 then concat [a;(chr 0)] else if (string_length a)>2 then raise Exit else a
and ma a= if a = 0 then 1 else if a >16 then 16 else a in
for i = 0 to 127 do
let t1=ma (string_length (arb.(2*i))) and t2=ma (string_length (arb.(2*i+1))) in
chaine:=concat [!chaine ;ds ((function (a,b)->a) (unbinar ( arb.(2*i))));chr (t1-1+16*(t2-1));ds ((function (a,b)->a) (unbinar ( arb.(2*i+1))))];
done;!chaine;;
(*si longueur est 1 et chaine est "1" et si elle etait suivie de 1, ce n'est pas "1" mais ""
ceci permet de stocker les caractères qui ne sont pas représentés*)
let arbre_of_string chai = let arb = make_vect 256 "" and chai2=ref "" and chai3=ref "" and temp1=ref"" and temp2=ref "" in
chai2:=chai;
for i = 0 to 127 do
chai3:=sub_string !chai2 0 5 ; chai2:=sub_string !chai2 5 ((string_length !chai2)-5);
begin let t1 = ((asc !chai3.[2]) mod 16)+1 and t2= (asc !chai3.[2])/16+1 in
temp1:=sub_string (concat [binaire !chai3.[0];binaire !chai3.[1]]) 0 t1;
temp2:=sub_string (concat [binaire !chai3.[3];binaire !chai3.[4]]) 0 t2 ;
begin if !temp1= "1" & (binaire !chai3.[0]).[1] = `1` then temp1:="" end;
begin if !temp2= "1" & (binaire !chai3.[3]).[1] = `1` then temp2:="" end;
arb.(i*2)<- (!temp1);
arb.(i*2+1)<- (!temp2);end
done;arb;;
let crstde a =begin if a<0 then raise Exit end;concat [chr (a mod 256);chr (a/256)];;
let uncrstde a = (asc a.[0])+256*(asc a.[1]);;
(*let tempory2= ref "";;*)
let creer_fichier fichier nbquant = let image = charge_bmp fichier in
let r = (function (a,b,c,d,e)->a) image
and g = (function (a,b,c,d,e)->b) image
and b = (function (a,b,c,d,e)->c) image
and largeur = (function (a,b,c,d,e)->d) image
and hauteur = (function (a,b,c,d,e)->e) image in
let lumi = YCbCr_of_RGB_mat r g b in
let y = (function (a,b,c)->a) lumi
and Cb = (function (a,b,c)->b) lumi
and Cr = (function (a,b,c)->c) lumi in
(*pour y:*)
let ycod = RLE_mat (quantification_mat (DCT_mat y) nbquant) in
let ystring = (function (a,b)->a) ycod
and yprem = (function (a,b)->b) ycod in
(*pour cb et cr*)
let cb2=downsample_mat Cb
and cr2=downsample_mat Cr in
let cb3=recolle_downsample cb2
and cr3=recolle_downsample cr2 in
let cbcod = RLE_mat (quantification_mat (DCT_mat cb3) nbquant)
and crcod = RLE_mat (quantification_mat (DCT_mat cr3) nbquant) in
let cbstring = (function (a,b)->a) cbcod
and cbprem = (function (a,b)->b) cbcod
and crstring = (function (a,b)->a) crcod
and crprem = (function (a,b)->b) crcod in
(*on applique huffman*)
print_newline();
print_string "taille après RLE:";
print_int (string_length (concat [(prem_string yprem);(prem_string cbprem);(prem_string crprem);ystring;cbstring;crstring]));
print_newline();
let huf = huffman (concat [(prem_string yprem);(prem_string cbprem);(prem_string crprem);ystring;cbstring;crstring] ) in
let hufstring = (function (a,b,c)->a) huf
and hufreste = (function (a,b,c)->b) huf
and huftab = (function (a,b,c)->c) huf in
concat [(chr (hufreste+(8*nbquant)));(crstde largeur);(crstde hauteur);(string_of_arbre huftab);hufstring];;
(*creer_fichier2 fabrique un fichier jpeq avec cb et cr non downsample*)
let creer_fichier2 fichier nbquant = let image = charge_bmp fichier in
let r = (function (a,b,c,d,e)->a) image
and g = (function (a,b,c,d,e)->b) image
and b = (function (a,b,c,d,e)->c) image
and largeur = (function (a,b,c,d,e)->d) image
and hauteur = (function (a,b,c,d,e)->e) image in
let lumi = YCbCr_of_RGB_mat r g b in
let y = (function (a,b,c)->a) lumi
and Cb = (function (a,b,c)->b) lumi
and Cr = (function (a,b,c)->c) lumi in
(*pour y:*)
let ycod = RLE_mat (quantification_mat (DCT_mat y) nbquant) in
let ystring = (function (a,b)->a) ycod
and yprem = (function (a,b)->b) ycod in
(*pour cb et cr*)
let cbcod = RLE_mat (quantification_mat (DCT_mat Cb) nbquant)
and crcod = RLE_mat (quantification_mat (DCT_mat Cr) nbquant) in
let cbstring = (function (a,b)->a) cbcod
and cbprem = (function (a,b)->b) cbcod
and crstring = (function (a,b)->a) crcod
and crprem = (function (a,b)->b) crcod in
(*on applique huffman*)
let huf = huffman (concat [(prem_string yprem);(prem_string cbprem);(prem_string crprem);ystring;cbstring;crstring] ) in
let hufstring = (function (a,b,c)->a) huf
and hufreste = (function (a,b,c)->b) huf
and huftab = (function (a,b,c)->c) huf in
concat [(chr (hufreste+(8*nbquant)));(crstde largeur);(crstde hauteur);(string_of_arbre huftab);hufstring];;
let JPEG fichier_bmp fichier_jpeg quant =
let ficjpeg = creer_fichier fichier_bmp quant in
let fic = open_out_bin fichier_jpeg in output_string fic ficjpeg;close_out fic;
print_newline();print_string "operation réalisée avec succès";;
(*jpeg2 fait jpeg sans downsample*)
let JPEG2 fichier_bmp fichier_jpeg quant =
let ficjpeg = creer_fichier2 fichier_bmp quant in
let fic = open_out_bin fichier_jpeg in output_string fic ficjpeg;close_out fic;
print_newline();print_string "operation réalisée avec succès";;
(*attention quantification<32*)
let input_string fic = let arret = ref false and chaine = ref "" in
while (not !arret) do
begin try chaine:=concat [!chaine; chr (input_byte fic)]
with End_of_file -> arret:=true
end;done;!chaine ;;
(*let appel a =if a = [|[|[|0|]|]|] then () else ();;
trace "appel";;*)
(*let lar= ref 0;;
let hau=ref 0;;*)
let unJPEG fichier_jpeg fichier_bmp =
let fic = open_in_bin fichier_jpeg in
let chai =input_string fic in
let hufraj= (asc (chai.[0])) mod 8
and quant = (asc (chai.[0]))/8
and chai1=sub_string chai 1 2
and chai2=sub_string chai 3 2 in
let largeur= uncrstde chai1
and hauteur= uncrstde chai2
and charb= sub_string chai 5 640
and chaihuf=sub_string chai 645 ((string_length chai)-645) in
let arb = arbre_of_string charb in
let chaidec = unhuffman chaihuf arb hufraj in
let z=( (approxi hauteur 8) * (approxi largeur 8) + 2* ((approxi (approxi hauteur 8) 2) * (approxi (approxi largeur 8) 2))) in
let prem = sub_string chaidec 0 (2*z) (*2*z car stocké sur deux octets*)
and reste = sub_string chaidec (2*z) ((string_length chaidec)-(2*z)) in
let matri =unRLE_mat reste
and premiers=unprem_string prem in
for i = 0 to ((vect_length premiers)-1) do
matri.(i).(0).(0)<-premiers.(i);done;
(*on a les matrices en lignes qui se suivent y puis cb puis cr*)
let x = ref 0
and y = make_matrix (approxi largeur 8) (approxi hauteur 8) [|[||]|]
and cb= make_matrix (approxi (approxi largeur 8) 2) (approxi (approxi hauteur 8) 2) [|[||]|]
and cr= make_matrix (approxi (approxi largeur 8) 2) (approxi (approxi hauteur 8) 2) [|[||]|] in
for i = 0 to ((approxi largeur 8 )-1) do
for j = 0 to ((approxi hauteur 8 )-1) do
y.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi (approxi largeur 8 ) 2)-1) do
for j = 0 to ((approxi (approxi hauteur 8 ) 2)-1) do
cb.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi (approxi largeur 8 ) 2)-1) do
for j = 0 to ((approxi (approxi hauteur 8 ) 2)-1) do
cr.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
let y2 = unDCT_mat (dequantification_mat y quant)
in
let cb2 = undownsample_mat (unrecolle_downsample (unDCT_mat (dequantification_mat cb quant)) largeur hauteur)
in
let cr2 = undownsample_mat (unrecolle_downsample (unDCT_mat (dequantification_mat cr quant)) largeur hauteur) in
let rgb= RGB_of_YCbCr_mat y2 cb2 cr2 in
sauve_bmp fichier_bmp ((function (a,b,c)->a) rgb) ((function (a,b,c)->b) rgb) ((function (a,b,c)->c) rgb) largeur hauteur;
print_newline();print_string "opération terminée avec succès";;
(*unjpeg2 fait le contraire de jpeg2 donc jpeg sans downsample *)
let unJPEG2 fichier_jpeg fichier_bmp =
let fic = open_in_bin fichier_jpeg in
let chai =input_string fic in
let hufraj= (asc (chai.[0])) mod 8
and quant = (asc (chai.[0]))/8
and chai1=sub_string chai 1 2
and chai2=sub_string chai 3 2 in
let largeur= uncrstde chai1
and hauteur= uncrstde chai2
and charb= sub_string chai 5 640
and chaihuf=sub_string chai 645 ((string_length chai)-645) in
let arb = arbre_of_string charb in
let chaidec = unhuffman chaihuf arb hufraj in
let z=((approxi hauteur 8) * (approxi largeur 8))*3 in
let prem = sub_string chaidec 0 (2*z) (*2*z car stocké sur deux octets*)
and reste = sub_string chaidec (2*z) ((string_length chaidec)-(2*z)) in
let matri =unRLE_mat reste
and premiers=unprem_string prem in
for i = 0 to ((vect_length premiers)-1) do
matri.(i).(0).(0)<-premiers.(i);done;
(*on a les matrices en lignes qui se suivent y puis cb puis cr*)
let x = ref 0
and y = make_matrix (approxi largeur 8) (approxi hauteur 8) [|[||]|]
and cb= make_matrix (approxi largeur 8) (approxi hauteur 8) [|[||]|]
and cr= make_matrix (approxi largeur 8) (approxi hauteur 8) [|[||]|] in
for i = 0 to ((approxi largeur 8 )-1) do
for j = 0 to ((approxi hauteur 8 )-1) do
y.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi largeur 8 ) -1) do
for j = 0 to ((approxi hauteur 8 ) -1) do
cb.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi largeur 8 ) -1) do
for j = 0 to ((approxi hauteur 8 ) -1) do
cr.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
let y2 = unDCT_mat (dequantification_mat y quant)
in
let cb2 = unDCT_mat (dequantification_mat cb quant)
in
let cr2 = unDCT_mat (dequantification_mat cr quant) in
let rgb= RGB_of_YCbCr_mat y2 cb2 cr2 in
sauve_bmp fichier_bmp ((function (a,b,c)->a) rgb) ((function (a,b,c)->b) rgb) ((function (a,b,c)->c) rgb) largeur hauteur;
print_newline();print_string "opération terminée avec succès";;
(*fft*)
let creer_fichierFFT fichier nbquant = let image = charge_bmp fichier in
let r = (function (a,b,c,d,e)->a) image
and g = (function (a,b,c,d,e)->b) image
and b = (function (a,b,c,d,e)->c) image
and largeur = (function (a,b,c,d,e)->d) image
and hauteur = (function (a,b,c,d,e)->e) image in
let lumi = YCbCr_of_RGB_mat r g b in
let y = (function (a,b,c)->a) lumi
and Cb = (function (a,b,c)->b) lumi
and Cr = (function (a,b,c)->c) lumi in
(*pour y:*)
let ycod = RLE_mat (quantification_mat (FFT_mat y) nbquant) in
let ystring = (function (a,b)->a) ycod
and yprem = (function (a,b)->b) ycod in
(*pour cb et cr*)
let cb2=downsample_mat Cb
and cr2=downsample_mat Cr in
let cb3=recolle_downsample cb2
and cr3=recolle_downsample cr2 in
let cbcod = RLE_mat (quantification_mat (FFT_mat cb3) nbquant)
and crcod = RLE_mat (quantification_mat (FFT_mat cr3) nbquant) in
let cbstring = (function (a,b)->a) cbcod
and cbprem = (function (a,b)->b) cbcod
and crstring = (function (a,b)->a) crcod
and crprem = (function (a,b)->b) crcod in
(*on applique huffman*)
let huf = huffman (concat [(prem_string yprem);(prem_string cbprem);(prem_string crprem);ystring;cbstring;crstring] ) in
let hufstring = (function (a,b,c)->a) huf
and hufreste = (function (a,b,c)->b) huf
and huftab = (function (a,b,c)->c) huf in
concat [(chr (hufreste+(8*nbquant)));(crstde largeur);(crstde hauteur);(string_of_arbre huftab);hufstring];;
let JPEGFFT fichier_bmp fichier_jpeg quant =
let ficjpeg = creer_fichierFFT fichier_bmp quant in
let fic = open_out_bin fichier_jpeg in output_string fic ficjpeg;close_out fic;
print_newline();print_string "operation réalisée avec succès";;
let unJPEGFFT fichier_jpeg fichier_bmp =
let fic = open_in_bin fichier_jpeg in
let chai =input_string fic in
let hufraj= (asc (chai.[0])) mod 8
and quant = (asc (chai.[0]))/8
and chai1=sub_string chai 1 2
and chai2=sub_string chai 3 2 in
let largeur= uncrstde chai1
and hauteur= uncrstde chai2
and charb= sub_string chai 5 640
and chaihuf=sub_string chai 645 ((string_length chai)-645) in
let arb = arbre_of_string charb in
let chaidec = unhuffman chaihuf arb hufraj in
let z=( (approxi hauteur 8) * (approxi largeur 8) + 2* ((approxi (approxi hauteur 8) 2) * (approxi (approxi largeur 8) 2))) in
let prem = sub_string chaidec 0 (2*z) (*2*z car stocké sur deux octets*)
and reste = sub_string chaidec (2*z) ((string_length chaidec)-(2*z)) in
let matri =unRLE_mat reste
and premiers=unprem_string prem in
for i = 0 to ((vect_length premiers)-1) do
matri.(i).(0).(0)<-premiers.(i);done;
(*on a les matrices en lignes qui se suivent y puis cb puis cr*)
let x = ref 0
and y = make_matrix (approxi largeur 8) (approxi hauteur 8) [|[||]|]
and cb= make_matrix (approxi (approxi largeur 8) 2) (approxi (approxi hauteur 8) 2) [|[||]|]
and cr= make_matrix (approxi (approxi largeur 8) 2) (approxi (approxi hauteur 8) 2) [|[||]|] in
for i = 0 to ((approxi largeur 8 )-1) do
for j = 0 to ((approxi hauteur 8 )-1) do
y.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi (approxi largeur 8 ) 2)-1) do
for j = 0 to ((approxi (approxi hauteur 8 ) 2)-1) do
cb.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
for i = 0 to ((approxi (approxi largeur 8 ) 2)-1) do
for j = 0 to ((approxi (approxi hauteur 8 ) 2)-1) do
cr.(i).(j)<-matri.(!x);
x:= !x +1;
done;done;
let y2 = unFFT_mat (dequantification_mat y quant)
in
let cb2 = undownsample_mat (unrecolle_downsample (unFFT_mat (dequantification_mat cb quant)) largeur hauteur)
in
let cr2 = undownsample_mat (unrecolle_downsample (unFFT_mat (dequantification_mat cr quant)) largeur hauteur) in
let rgb= RGB_of_YCbCr_mat y2 cb2 cr2 in
sauve_bmp fichier_bmp ((function (a,b,c)->a) rgb) ((function (a,b,c)->b) rgb) ((function (a,b,c)->c) rgb) largeur hauteur;
print_newline();print_string "opération terminée avec succès";;