View difference between Paste ID: <a href="/EmemNwvg">EmemNwvg</a> and <a href="/HfbdCLxh">HfbdCLxh</a> - Pastebin.com

View difference between Paste ID: EmemNwvg and HfbdCLxh

SHOW: | | - or go back to the newest paste.

1		#/bin/perl
2		#
3		# Conversion d'image au format MAP thomson.
4		#
5		# Usage: perl <script.pl> <image>.<ext> <image>.<ext> ...
6		# ou find <dir> -name '*.gif' \| perl <script.pl> (entrée des images par l'entrée standard)
7		# ==> produit x<image>.map (image thomson) et x<image>.gif (version visible ailleurs que thomson).
8		#
9		# Ce script est complètement expérimental et change tout le temps. Beaucoup de code est inutilisé
10		# ou commenté du fait des évolution succéssives. Il n'est pas écrit pour être utilisé en production.
11		# Un jour j'en ferais une version belle et propre en créant un plugin XnView.
12		#
13		# (c) Samuel DEVULDER 2007-2013
14		#
15
16		#use Graphics::MagickXX;
17		use Image::Magick;
18
19		$SIG{'INT'} = 'DEFAULT';
20		$SIG{'CHLD'} = 'IGNORE';
21
22		# suppression du buffer pour l'affichage en sortie
23		#$\| = 1;
24
25		# variables globale
26		$glb_magick = Image::Magick->new;
27		$glb_to7pal = 2; # 2 = palette TO7, 1 = TO7/70, 0 = TO9
28		$glb_maxcol = $glb_to7pal>1?8:16; # nb total de couls
29		$glb_lab = 0; # distance couleur cielab
30		$glb_dith = 0; # avec 3 ca donne des images pas mal colorées!
31		$glb_gamma = 2.20; #1/0.45;
32		$glb_clean = 0.2;
33		$glb_att = 1; #.85;
34
35		# error dispersion matrix. Index represents:
36		# X 3
37		# 0 1 2
38		@glb_err = (0.000, 0.000, 0.000, 0.000) if 1; # no dith
39		@glb_err = (0.200, 0.700, 0.100, 0.000) if 0; # nice lines
40		@glb_err = (0.062, 0.312, 0.187, 0.437) if 0; # floyd steinberg
41		@glb_err = (0.187, 0.312, 0.062, 0.437) if 1; # floyd steinberg
42		@glb_err = (0.000, 0.500, 0.000, 0.500) if 0; # simple
43		@glb_err = (0.000, 1.000, 0.000, 0.000) if 0;
44		@glb_err = (0.100, 0.500, 0.100, 0.300) if 0;
45		@glb_err = (0.300, 0.500, 0.100, 0.100) if 0;
46		@glb_err = (0.250, 0.500, 0.125, 0.125) if 0;
47		@glb_err = (0.500, 0.000, 0.500, 0.000) if 0; # motifs inca
48		@glb_err = (0.200, 0.500, 0.100, 0.200) if 0; # motifs inca
49		@glb_err = (0.000, 0.400, 0.400, 0.200) if 0; # motifs inca
50		@glb_err = (0.250, 0.250, 0.000, 0.500) if 0; # sierra 2-4a
51		@glb_err = (0.333, 0.334, 0.000, 0.333) if 0;
52		@glb_err = (0.233, 0.333, 0.234, 0.200) if 0; # à voir
53		@glb_err = (0.233, 0.367, 0.200, 0.200) if 1*0; # à voir
54
55		@glb_err = (0.250, 0.500, 0.250, 0.000) if 0;
56
57		@glb_err = (0.200, 0.233, 0.367, 0.200) if 0; # serpente
58		@glb_err = (0.250, 0.500, 0.250, 0.000) if 0;
59
60		@glb_err = (0.100, 0.500, 0.000, 0.400) if 0; # simple (horiz)
61		@glb_err = (0.025, 0.125, 0.050, 0.125) if 0; # permet d'avoir des plages de couleurs constantes . Ca rend plutot pas mal pour les jeux videos.
62		@glb_err = (0.050, 0.125, 0.050, 0.125) if 0; # permet d'avoir des plages de couleurs constantes . Ca rend plutot pas mal pour les jeux videos.
63		@glb_err = (0.100, 0.150, 0.050, 0.200) if 0; # fs attenue (pas mal pour les jeux)
64		@glb_err = (0.125, 0.250, 0.125, 0.250) if 0; # modified atkinson
65
66		@mat = (
67		[ 0,48,12,60, 3,51,15,63],
68		[32,16,44,28,35,19,47,31],
69		[ 8,56, 4,52,11,59, 7,55],
70		[40,24,36,20,43,27,39,23],
71		[ 2,50,14,62, 1,49,13,61],
72		[34,18,46,30,33,17,45,29],
73		[10,58, 6,54, 9,57, 5,53],
74		[42,26,38,22,41,25,37,21]);
75
76		$mat_y = 1+$#mat;
77		$mat_x = 1+$#{$mat[0]};
78		$max = 0;
79		for $y (0..$mat_y-1) {
80		for $x (0..$mat_x-1) {
81		++$mat[$y][$x];
82		$max = $mat[$y][$x] if $mat[$y][$x]>$max;
83		}
84		}
85		for $y (0..$mat_y-1) {
86		for $x (0..$mat_x-1) {
87		$mat[$y][$x] /= $max;
88		}
89		}
90
91		# construit les maps pour la multiplication
92		for($i = -256; $i<256; ++$i) {$glb_map0[$i & 0x1ff] = xint($i * $glb_err[0] * &glb_att($i)) & 0x1ff;}
93		for($i = -256; $i<256; ++$i) {$glb_map1[$i & 0x1ff] = xint($i * $glb_err[1] * &glb_att($i)) & 0x1ff;}
94		for($i = -256; $i<256; ++$i) {$glb_map2[$i & 0x1ff] = xint($i * $glb_err[2] * &glb_att($i)) & 0x1ff;}
95		for($i = -256; $i<256; ++$i) {$glb_map3[$i & 0x1ff] = xint($i * $glb_err[3] * &glb_att($i)) & 0x1ff;}
96		for($i = -256; $i<256; ++$i) {$glb_sqr [$i & 0x1ff] = $i * $i;}
97		$glb_err0 = $glb_err[0]>0;
98		$glb_err1 = $glb_err[1]>0;
99		$glb_err2 = $glb_err[2]>0;
100		$glb_err3 = $glb_err[3]>0;
101
102		# limit error
103		$clamp = -48;
104		for($i = -256; $i<256; ++$i) {$glb_clamp[$i & 0x1ff] = ($i< $clamp ? $clamp : $i) & 0x1ff;}
105
106		# map une intensité entre 0..255 vers l'intensité produite par le circuit EFxxx le plus proche (16 valeurs)
107		@ef_vals = (0, 39, 74, 101, 122, 140, 157, 171, 185, 195, 206, 216, 227, 237, 248, 255) if 1;
108
109		# eval perso
110		@ef_vals = (0,78,116,138,157,171,182,187,205,215,222,229,238,244,249,255) if 0;
111		@ef_vals = (0,51,91,117,142,161,172,187,199,210,220,227,236,244,248,255) if 1;
112
113		# ef TEO
114		@ef_vals = (0, 100, 127, 142, 163, 179, 191,203, 215, 223, 231, 239, 243, 247, 251, 255) if 1;
115		@ef_vals = (0, 127, 169, 188, 198, 205, 212, 219, 223, 227, 232, 239, 243, 247, 251, 255) if 0; # eval prehisto
116		@ef_vals = (0, 174, 192, 203, 211, 218, 224, 229, 233, 237, 240, 244, 247, 249, 252, 255) if 0; # prehisto 2
117		@ef_vals = (0, 169, 188, 200, 209, 216, 222, 227, 232, 236, 239, 243, 246, 249, 252, 255) if 0; # prehisto 3
118		@ef_vals = (0, 153, 175, 189, 199, 207, 215, 221, 227, 232, 236, 241, 245, 248, 252, 255) if 0; # prehisto 4
119
120		@intens = @ef_vals;
121		#@intens = (0, 16, 32, 48, 64, 80, 96, 112, 128, 144, 160, 176, 192, 218, 224, 240, 255);
122		#@intens = (0, 66, 96, 120, 138, 153, 168, 180, 192, 201, 210, 219, 228, 237, 246, 252);
123		#@intens = (0, 32, 66, 98, 128, 152, 170, 185, 200, 212, 224, 233, 245, 255);
124		#@intens = (0, 60, 98, 128, 152, 170, 185, 200, 212, 224, 233, 245, 255);
125		@intens = (0, 32, 64, 96, 128, 160, 192, 255) if 0;
126		@intens = (0, 16, 32, 48, 64, 96, 128, 160, 192, 224, 255) if 0;
127		@intens = (0, 32, 64, 128, 255) if 0;
128		@intens = (0, 50, 100, 200, 255) if 0; ## <== pas mal
129		@intens = (0, 32, 64, 128, 192, 255) if 0;
130		@intens = (0, 33, 66, 99, 133, 166, 200, 255) if 0;
131		@intens = (0, 98, 128, 152, 170,
132		185, #200,
133		212, #224,
134		233, #241,
135		251) if 0;
136		@intens = (0, 45, 98, 185, 255) if 0;
137		@intens = (0, 16, 32, 64, 128, 192, 224, 240, 255) if 0; ##
138		@intens = (0, 32, 64, 128, 192, 224, 255) if 0;
139		@intens = (0, 16, 32, 64, 128, 255) if 0;
140
141		# basse luminosité
142		@intens = (0, 39, 74, 122, 195, 227, 255) if 0; # ajustement aux niveaux thomson
143		@intens = (0, 39, 74, 122, 195, 227, 248) if 0; # ajustement aux niveaux thomson
144		@intens = (0, 39, 101, 195, 255) if 0;
145		@intens = (0, 39, 74, 122, 185, 216, 255) if 0; # ajustement aux niveaux thomson
146
147		# 0 64 128 192 256~
148		# 0 32 64 96 128 160 192 224 256
149		@intens = (0, 78, 116, 138, 157, 187, 222, 238, 255) if 0;
150		@intens = (0, 78, 116, 157, 195, 222, 255) if 0;
151		@intens = (0, 78, 138, 222, 255) if 0;
152		@intens = (0, 78, 138, 157, 255) if 0;
153		@intens = (0, 78, 157, 244) if 0;
154		@intens = (0, 138, 255) if 0;
155		@intens = (0, 51, 91, 117, 161, 187, 227, 255) if 0;
156		@intens = (0, 42, 84, 126, 168, 210, 255) if 0;
157		@intens = (0, 51, 102, 153, 204, 255) if 0;
158		@intens = (0, 16, 32, 64, 128, 192, 224, 240, 255) if 0;
159		@intens = (0, 100, 127, 142, 179, 215, 255) if 0;
160
161		# equi reparti
162		@intens = (0, 16, 32, 48, 64, 80, 96, 112, 128, 144, 160, 176, 192, 208, 224, 240, 255) if 0;
163		@intens = (0, 32, 64, 96, 128, 160, 192, 224, 255) if 0;
164		@intens = (0, 48, 96, 144, 192, 255) if 0;
165
166		if($glb_gamma) {
167		#print join(",", @intens), "\n";
168		foreach (@intens) {$_ = &gamma($_);}
169		#print join(",", @intens), "\n";
170		foreach (@ef_vals) {$_ = &gamma($_);}
171		}
172
173		# remap des intens
174		for($i=0; $i<=$#intens; ++$i) {
175		my($z) = 0;
176		for($j=0, $m=1e30; $j<=$#ef_vals; ++$j) {
177		next if $ef_vals[$j]<0;
178		$k = $intens[$i] - $ef_vals[$j]; $k = -$k if $k<0;
179		if($k<$m) {$m=$k; $z = $ef_vals[$j];}
180		}
181		$intens[$i] = $z;
182		}
183
184		# mapping des intensités
185		@map_ef = ();
186		for($i=0; $i<256; ++$i) {
187		for($j=0, $m=1e30; $j<=$#intens; ++$j) {
188		next if $intens[$j]<0;
189		$k = $i - $intens[$j]; $k = -$k if $k<0;
190		if($k<$m) {$m=$k; $map_ef[$i] = $intens[$j];}
191		}
192		for($j=0; $j<=$#intens && $intens[$j]<=$i; ++$j) {
193		next if $intens[$j]<0;
194		$map_ef2[$i] = $intens[$j];
195		}
196		}
197		#@map_ef = ();
198
199
200		# analyse des fichiers en argments
201		@files = @ARGV;
202
203		# si aucun fichier, alors on les prends depuis l'entrée standard
204		if(!@files) {
205		while(<>) {
206		chomp;
207		next if /chlgdls/;
208		y%\\%/%;
209		s%^([\S]):%/cygdrive/$1%;
210		push(@files, $_);
211		}
212		}
213
214		# extension supportées
215		$supported_ext = "\.(gif\|pnm\|png\|jpg\|jpeg\|ps)";
216		# fichier a effacer pour stopper le prog
217		$stopme = ".stop_me";
218		open(f, ">$stopme"); close(f);
219
220		#&start_wd;
221
222		# traitement de tous les fichiers
223		$cpt = 0;
224		foreach $in (@files) {
225		last if ! -e "$stopme";
226		next unless $in =~ /$supported_ext$/i;
227
228		++$cpt;
229
230		next if $in eq "-";
231		#next if $in =~ /ord/;
232		next if $in =~ /6846/;
233
234		$out = $in; $out=~s/$supported_ext$/.gif/i; $out=~s/.*[\/\\]//;
235		$out = "x$out";
236
237		print $cpt,"/",1+$#files," $in => $out\n";
238
239		&reset_wd;
240
241		next if -e $out;
242
243		# lecture
244		my(@px) = &read_image($in);
245
246		@px = &cleanup(@px) if 1;
247
248		# creation palette 16 couls (passage par une globale pour simplifier le code)
249		@glb_pal = &find_palette($glb_maxcol, @px);
250
251		#&print_pal(@glb_pal);
252
253		# precalc distance entre les couleurs de la palette
254		$glb_dist = ();
255		for($i=0; $i<$glb_maxcol; ++$i) {
256		$glb_dist[$i + $i*$glb_maxcol] = 0;
257		for($j = 0; $j<$i; ++$j) {
258		$glb_dist[$j + $i$glb_maxcol] = $glb_dist[$i + $j$glb_maxcol] = &irgb_dist($glb_pal[$i], $glb_pal[$j]);
259		}
260		}
261
262		if(0) {
263		$px[1] = &rgb2irgb(1,1,1);
264		$px[2] = &rgb2irgb(1,1,1);
265		$px[3] = &rgb2irgb(1,1,1);
266		$px[321] = &rgb2irgb(1,1,1);
267		$px[322] = &rgb2irgb(1,1,1);
268		$px[323] = &rgb2irgb(1,1,1);
269		}
270
271		if(0) {
272		# pour tester : dither sans contrainte
273		my(@p2) = @px;
274		for($p=$y=0; $y<200; ++$y) {
275		for($x=0; $x<320; ++$x) {
276		$p = 320*$y+$x;
277		my($rvb) = $p2[$p] = &irgb_map($p2[$p], \@glb_clamp);
278		for($i=0, $dm=1e30; $i<$glb_maxcol; ++$i) {
279		$d = &irgb_dist($rvb, $glb_pal[$i]);
280		print &irgb2hex($glb_pal[$i]), " $i => $d\n" if 0;
281		if($d<$dm) {$dm = $d; $p2[$p] = $glb_pal[$i];}
282		}
283		print "$x,$y : ", &irgb2hex($rvb), "=>", &irgb2hex($p2[$p]), " $dm\n\n" if 0;
284		$rvb = &irgb_sub($rvb, $p2[$p]);
285		#print " /_\\ = ", &irgb2hex($rvb), "\n";
286		$p2[$p + 319] = &irgb_add_cln($p2[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x>0;
287		$p2[$p + 320] = &irgb_add_cln($p2[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
288		$p2[$p + 321] = &irgb_add_cln($p2[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x<319;
289		$p2[$p + 001] = &irgb_add_cln($p2[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && $x<319;
290		}
291		}
292		&write_image("${out}.gif", @p2);
293		}
294
295		my(%palx);
296		foreach $i (@px) {$palx{$i} = 1;last if length(keys %palx)>2;}
297		$mono = length(keys %palx)<3;
298		%palx = ();
299
300		# process image
301		my($p, $y, $x) = (0,0,0);
302		for($y=0; $y<200; ++$y) {
303		print "\r> ", int($y/2), "% ";
304		for($x=0; $x<320; $x+=8) {
305		$p = $y * 320 + $x;
306		#for($i=0; $i<8; ++$i) {$px[$p+$i] = &irgb_map($px[$p+$i], \@glb_clamp);}
307		for($i=0; $i<8; ++$i) {$px[$p+$i] = &irgb_sat($px[$p+$i]);}
308		my($forme, $fond) = &couple6(@px[$p..$p+7]);
309		#print "===> ", &irgb2hex($forme), " ", &irgb2hex($fond),"\n";
310		for($i=0; $i<8; ++$i, ++$p) {
311		my($rvb) = &irgb_sat($px[$p]);
312		#$rvb = &irgb_add_cln($rvb, &rgb2irgb(rand(0.02),rand(0.02),rand(0.02))) if 0; #($i+$y) & 8;
313		# meilleur couleur approchante
314		$px[$p] = (&irgb_dist($forme, $rvb) < &irgb_dist($fond, $rvb)) ? $forme : $fond;
315		#print $i,"::", &irgb2hex($rvb),"=>",&irgb2hex($px[$p]),"\n";
316		#for($dm = 1e30, $k = 0; $k<$glb_maxcol; ++$k) {if(($d = &irgb_dist($rvb, $glb_pal[$k])) < $dm) {$dm = $d; $px[$p] = $glb_pal[$k];}};
317
318		#if(($px[$p] & 0xff) > 0x40) {
319		# print &irgb2hex($px[$p]),"\n", &irgb2hex($rvb), " f=", &irgb2hex($forme), ":", &irgb_dist($forme, $rvb)," F=", &irgb2hex($fond),":",&irgb_dist($fond,$rvb),"\n";
320		#}
321		#if(($px[$p] & 0xff) < 0x80) {
322		# print &irgb2hex($px[$p]),"\n", &irgb2hex($rvb), " f=", &irgb2hex($forme), ":", &irgb_dist($forme, $rvb)," F=", &irgb2hex($fond),":",&irgb_dist($fond,$rvb),"\n";
323		#}
324
325		# diffusion d'erreur
326		if(!$mono) {
327		#print " p=",&irgb2hex($rvb);
328		$rvb = &irgb_sub($rvb, $px[$p]);
329		#print " q=", &irgb2hex($px[$p]), " d=", &irgb2hex($rvb);
330		#print " m=", irgb2hex(&irgb_map($rvb, \@glb_map1)), " n=", &irgb2hex($px[$p+320]), " X=", &irgb2hex(&irgb_uadd($px[$p + 320], &irgb_map($rvb, \@glb_map1))), "\n";
331		$px[$p + 319] = &irgb_add_cln($px[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && ($x+$i)>0;
332		$px[$p + 320] = &irgb_add_cln($px[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
333		$px[$p + 321] = &irgb_add_cln($px[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && ($x+$i)<319;
334		$px[$p + 001] = &irgb_add_cln($px[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && ($x+$i)<319;
335		}
336		# pour voir les limites octets
337		$px[$p] = $i&1? $forme : $fond if 0;
338		$px[$p] ^= 0x0ff3fcff if $i==0 && 0;
339		}
340		}
341		$\| = 1; print "\r"; $\| = 0;
342		}
343		%dist_cache = ();
344
345		# ecriture des pixels et lecture
346		#$out =~ s/.gif$/.c16.gif/;
347		&write_image($out, @px);
348
349		$out =~ s/.gif$//;
350		#&write_map("$out.mpa", 1, @px);
351		#&write_map("$out.mpb", 2, @px);
352		&write_map("$out.map", 3, @px);
353
354		sleep(1);
355		}
356		unlink($stopme);
357
358		if(0) {
359		%m = ();
360		foreach $out (<rgb/*.MAP>) {
361		open(IN, "cygpath -w -s \"$out\" \|"); $zz = <IN>; chomp($zz); close(IN);
362		$zz=~y/~\\/_\//;
363		$m{$out} = $zz;
364		}
365		foreach $out (keys %m) {
366		rename($out, $m{$out});
367		}
368		}
369
370		sub glb_att {
371		return 1;
372		my($i) = @_;
373		$i = -$i if $i<0;
374		return 1 if $i>32;
375		return .5*(1+$i/32)/2;
376		}
377
378		sub print_pal {
379		my(@pal) = @_;
380		my($i, @t);
381		foreach $i (@pal) {
382		my($r) = ($i>>20) & 255;
383		my($g) = ($i>>10) & 255;
384		my($b) = ($i>>00) & 255;
385
386		push(@t, sprintf("%3d,%3d,%3d", $r, $g, $b));
387		}
388		for $i (sort(@t)) {
389		print "$i\n";
390		}
391		}
392		# retourne la palette TO7/70
393		sub to770_palette {
394		return (
395		&rgb2irgb(0.0000,0.0000,0.0000), &rgb2irgb(1.0000,0.0000,0.0000),
396		&rgb2irgb(0.0000,1.0000,0.0000), &rgb2irgb(1.0000,1.0000,0.0000),
397		&rgb2irgb(0.0000,0.0000,1.0000), &rgb2irgb(1.0000,0.0000,1.0000),
398		&rgb2irgb(0.0000,1.0000,1.0000), &rgb2irgb(1.0000,1.0000,1.0000),
399		&rgb2irgb(0.4375,0.4375,0.4375), &rgb2irgb(0.6250,0.1875,0.1875),
400		&rgb2irgb(0.1875,0.6250,0.1875), &rgb2irgb(0.6250,0.6250,0.1875),
401		&rgb2irgb(0.1875,0.1875,0.6250), &rgb2irgb(0.6250,0.1875,0.6250),
402		&rgb2irgb(0.4375,0.8750,0.8750), &rgb2irgb(0.5375,0.6875,0.0000)
403		) if 0; # pas de gamma
404		return (
405		&rgb2irgb(0.0000,0.0000,0.0000), &rgb2irgb(1.0000,0.0000,0.0000),
406		&rgb2irgb(0.0000,1.0000,0.0000), &rgb2irgb(1.0000,1.0000,0.0000),
407		&rgb2irgb(0.0000,0.0000,1.0000), &rgb2irgb(1.0000,0.0000,1.0000),
408		&rgb2irgb(0.0000,1.0000,1.0000), &rgb2irgb(1.0000,1.0000,1.0000),
409		&rgb8irgb(212, 212, 212), &rgb8irgb(242, 152, 152),
410		&rgb8irgb(152, 242, 152), &rgb8irgb(242, 242, 152),
411		&rgb8irgb(152, 152, 242), &rgb8irgb(242, 152, 242),
412		&rgb8irgb(212, 255, 255), &rgb8irgb(255, 211, 1),
413		) if 1; # gamma
414		return (
415		&rgb2irgb(0.0000,0.0000,0.0000), &rgb2irgb(1.0000,0.0000,0.0000),
416		&rgb2irgb(0.0000,1.0000,0.0000), &rgb2irgb(1.0000,1.0000,0.0000),
417		&rgb2irgb(0.0000,0.0000,1.0000), &rgb2irgb(1.0000,0.0000,1.0000),
418		&rgb2irgb(0.0000,1.0000,1.0000), &rgb2irgb(1.0000,1.0000,1.0000),
419		&rgb2irgb(0.6980,0.6980,0.6980), &rgb2irgb(0.8320,0.4640,0.4640),
420		&rgb2irgb(0.4640,0.8320,0.4640), &rgb2irgb(0.8320,0.8320,0.4640),
421		&rgb2irgb(0.4640,0.4640,0.8320), &rgb2irgb(0.8320,0.4640,0.8320),
422		&rgb2irgb(0.6980,0.9680,0.9680), &rgb2irgb(0.8710,0.4640,0.0000)
423		); # gamma
424		}
425
426		sub rgb8irgb {
427		return &rgb2irgb($_[0]/255.0, $_[1]/255.0, $_[2]/255.0);
428		}
429
430		sub test_niveaux {
431		my (@args) = @_;
432
433		my($dither) = 0;
434
435		# args=(seuil, niveaux..., -max, pixels...)
436		my($seuil, $max, $t, @niv, @px, @pal) = 0;
437
438		foreach $t (@args) {
439		if($seuil==0) {
440		$seuil = $t;
441		$max = 0;
442		} elsif($max==0) {
443		if($t>=0) {
444		push(@niv, $map_ef[$t]);
445		} else {
446		$max = -$t;
447		for($t=0; $t<256; ++$t) {
448		my($m, $d, $n); $m = 1e30;
449		foreach $n (@niv) {$d = $n - $t; $d = -$d if $d<0; if($d<$m) {$m = $d; $pal[$t] = $n;}}
450		}
451		}
452		} else {
453		push(@px, $t) if 1;
454		push(@px, ((($map_ef[$t>>20]<<10) + $map_ef[($t>>10) & 0xff])<<10) + $map_ef[$t & 0xff]) if 0;
455		}
456		}
457		my($w, $h) = (320, 200);
458		($w, $h) = (160, 200) if 160*200==1+$#px;
459		($w, $h) = (160, 100) if 160*100==1+$#px;
460		($w, $h) = (80, 100) if 80*100==1+$#px;
461		($w, $h) = (80, 50) if 80*50==1+$#px;
462		$seuil = $seuil$seuil$w*$h;
463
464		# color reduce
465		@niv = ();
466		my($x, $y, $p, $m, $d, @out);
467		if($dither) {
468		my @tmp = @px;
469		for($y=0, $p=0; $y<$h; ++$y) {
470		for($x=0; $x<$w; ++$x, ++$p) {
471		$rvb = $px[$p];
472		my ($r,$v,$b) = ($pal[$rvb>>20], $pal[($rvb>>10) & 0xff], $pal[$rvb & 0xff]);
473		push(@niv, $r, $v, $b);
474		$px[$p] = ($r<<20) + ($v<<10) + $b;
475		$rvb = &fs_diff($rvb, $px[$p]);
476		$px[$p + $w - 1] = &fs_prop($px[$p + $w - 1], $rvb, \@glb_map0) if $glb_err0 && $y<$h-1 && $x>0;
477		$px[$p + $w + 0] = &fs_prop($px[$p + $w + 0], $rvb, \@glb_map1) if $glb_err1 && $y<$h-1;
478		$px[$p + $w + 1] = &fs_prop($px[$p + $w + 1], $rvb, \@glb_map2) if $glb_err2 && $y<$h-1 && $x<$w-1;
479		$px[$p + 000001] = &fs_prop($px[$p + 000001], $rvb, \@glb_map3) if $glb_err3 && $x<$w-1;
480		}
481		}
482		@px = @tmp;
483		} else {
484		foreach $t (@px) {push(@niv, $pal[$t>>20], $pal[($t>>10) & 0xff], $pal[$t & 0xff]);}
485		}
486		open(OUT,">.toto2.pnm"); print OUT "P6\n$w $h\n255\n", pack('C*', @niv), "\n"; close(OUT);
487		@$glb_magick = ();
488		$glb_magick->Set(page=>"$wx$h+0+0");
489		$glb_magick->Read(".toto2.pnm");
490		$glb_magick->Write(".toto3.png");
491		unlink(".toto2.pnm");
492
493		$glb_magick->Quantize(colors=>$max, colorspace=>"RGB", treedepth=>0, dither=>"False");
494		$glb_magick->Write(".toto4.png");
495		@niv = $glb_magick->GetPixels(map=>"RGB", height=>$h, normalize=>"True");
496		my(%pal, $rvb);
497		for($t=$#niv+1; ($t-=3)>=0;) {
498		$rvb = &rgb2irgb(@niv[$t..$t+2]);
499		$rvb = ((($pal[$rvb>>20]<<10) + $pal[($rvb>>10) & 0xff])<<10) + $pal[$rvb & 0xff];
500		$pal{$rvb} = 1;
501		}
502		@niv = (keys(%pal), (0) x $max)[0..($max-1)];
503
504		# dither & calcul d'erreur
505		my($err) = 0;
506		my($cache, %cache) = 1;
507		for($y=$p=0; $err < $seuil && $y<$h; ++$y) {
508		for($x=0; $err < $seuil && $x<$w; ++$x, ++$p) {
509		$rvb = $px[$p];
510		# on trouve le niv le plus proche
511		$t = $cache{$rvb} if $cache;
512		if(!$cache \|\| !defined($t)) {
513		$m = 1e30; foreach $t (@niv) {$d = &irgb_dist($t, $rvb); if($d<$m) {$m = $d;$px[$p] = $t;}}
514		$cache{$rvb} = $px[$p] if $cache;
515		} else {
516		$m = &irgb_dist($t, $rvb);
517		$px[$p] = $t;
518		}
519		push(@out, $px[$p]>>20, ($px[$p]>>10)&255, $px[$p]&255);
520		$err += &sq($m);
521		if($dither) {
522		$rvb = &fs_diff($rvb, $px[$p]);
523		$px[$p + $w - 1] = &fs_prop($px[$p + $w - 1], $rvb, \@glb_map0) if $glb_err0 && $y<$h-1 && $x>0;
524		$px[$p + $w + 0] = &fs_prop($px[$p + $w + 0], $rvb, \@glb_map1) if $glb_err1 && $y<$h-1;
525		$px[$p + $w + 1] = &fs_prop($px[$p + $w + 1], $rvb, \@glb_map2) if $glb_err2 && $y<$h-1 && $x<$w-1;
526		$px[$p + 000001] = &fs_prop($px[$p + 000001], $rvb, \@glb_map3) if $glb_err3 && $x<$w-1;
527		}
528		}
529		}
530
531		if($err < $seuil) {
532		open(OUT,">.toto2.pnm"); print OUT "P6\n$w $h\n255\n", pack('C*', @out), "\n"; close(OUT);
533		@$glb_magick = ();
534		$glb_magick->Set(page=>"$wx$h+0+0");
535		$glb_magick->Read(".toto2.pnm");
536		$glb_magick->Write(".toto2.png");
537		unlink(".toto2.pnm");
538		}
539
540		# fini
541		$glb_magick->Set(page=>"320x200+0+0");
542		sleep(0.5);
543		return (sprintf("%.05f", sqrt($err/$w/$h)), @niv);
544		}
545
546		# calcul d'une palette de 16 couleurs
547		sub find_palette_orig {
548		my($max, @px) = @_;
549
550		# cas TO7
551		return &to770_palette if $glb_to7pal;
552
553		# vrai algo
554		my($mask) = 0x0f03c0f0; $mask = -1;
555
556		# si l'image a suffisament peu de couleurs alors on retourne la palette de l'image
557		# directement
558		my($i, %pal);
559		foreach $i (@px) {
560		$pal{$i & $mask} = 1;
561		last if length(keys %pal)>$max;
562		}
563		my(@t) = keys(%pal);
564		return @t if $#t<$max;
565		%pal = ();
566
567		# sinon on quantifie l'image:
568
569		#return &xxx_palette($max, @px) if $#map_ef>=0;
570
571		# on remap l'image aux niveau produits par les puces thomson!
572		if($#map_ef>=0) {
573		@t = ();
574		my($x, $y, $p, $rvb, $r, $v, $b);
575		for($y=0, $p=0; $y<200; ++$y) {
576		for($x=0; $x<320; ++$x, ++$p) {
577		$rvb = $px[$p];
578		$r=$map_ef[$rvb>>20]; $v=$map_ef[($rvb>>10) & 0xff]; $b=$map_ef[$rvb & 0xff];
579		push(@t, &ammag($r), &ammag($v), &ammag($b));
580		#push(@t, $r=($rvb>>20), $v=(($rvb>>10) & 0xff), $b=($rvb & 0xff));
581		if(1) {
582		$px[$p] = ((($r<<10)+$v)<<10)+$b;
583		$rvb = &irgb_sub($rvb, $px[$p]);
584		$px[$p + 319] = &irgb_uadd($px[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x>0;
585		$px[$p + 320] = &irgb_uadd($px[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
586		$px[$p + 321] = &irgb_uadd($px[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x<319;
587		$px[$p + 001] = &irgb_uadd($px[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && $x<319;
588		}
589		}
590		}
591		open(OUT,">.toto2.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @t), "\n"; close(OUT);
592		@$glb_magick = ();
593		$glb_magick->Read(".toto2.pnm");
594		#$glb_magick->Resize(geometry=>"160x100!");
595		#$glb_magick->Resize(geometry=>"320x200!");
596		$glb_magick->Write(".toto2.png");
597		#$glb_magick->Read(".toto2.png");
598		unlink(".toto2.pnm");
599		}
600
601		if(0) { #recherche
602		# sinon on quantifie l'image:
603		my($c, $err, @pal, $e, @p) = (0, 1e30);
604
605		# on divise le nombre de pixels par 4
606		if(1) {
607		my($x, $y, $p, @t);
608		for($p=$y=0; $y<200; $y+=2, $p+=320) {
609		for($x=0; $x<320; $x+=2, $p+=2) {
610		push(@t, &irgb_avg(&irgb_avg($px[$p], $px[$p+1]), &irgb_avg($px[$p+320], $px[$p+321])));
611		}
612		}
613		@px = @t; @t = ();
614		if(0) {
615		for($p=$y=0; $y<100; $y+=1, $p+=0) {
616		for($x=0; $x<160; $x+=2, $p+=2) {
617		push(@t, &irgb_avg($px[$p], $px[$p+1]));
618		}
619		}
620		@px = @t; @t = ();
621		if(0) {
622		for($p=$y=0; $y<100; $y+=2, $p+=80) {
623		for($x=0; $x<80; $x+=1, $p+=1) {
624		push(@t, &irgb_avg($px[$p], $px[$p+80]));
625		}
626		}
627		@px = @t; @t = ();
628		}
629		}
630		}
631
632		# 0
633		($e, @p) = &test_niveaux($err, @ef_vals, -$max, @px);
634		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
635
636		# 1
637		#($e, @p) = &test_niveaux($err, (0, 16, 32, 48, 64, 80, 96, 112, 128, 144, 160, 176, 192, 208, 224, 240, 255), -$max, @px);
638		($e, @p) = &test_niveaux($err, (0, 50, 100, 150, 200, 250), -$max, @px);
639		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
640
641		# 2
642		($e, @p) = &test_niveaux($err, (0, 32, 64, 96, 128, 160, 192, 224, 255), -$max, @px);
643		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
644
645		# 3
646		($e, @p) = &test_niveaux($err, (0, 50, 100, 200, 255), -$max, @px);
647		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
648
649		# 4
650		($e, @p) = &test_niveaux($err, (0, 100, 140, 180, 200, 220, 240, 255), -$max, @px);
651		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
652
653		# 5
654		($e, @p) = &test_niveaux($err, (0, 32, 64, 128, 192, 224, 255), -$max, @px);
655		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
656
657		# 6
658		($e, @p) = &test_niveaux($err, (0, 16, 32, 48, 80, 112, 144, 208, 208, 240, 255), -$max, @px);
659		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
660
661		# 7
662		($e, @p) = &test_niveaux($err, (0, 16, 32, 64, 128, 192, 224, 240, 255), -$max, @px);
663		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
664
665		# 8
666		($e, @p) = &test_niveaux($err, (0, 64, 128, 192, 255), -$max, @px);
667		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
668
669		# 9
670		($e, @p) = &test_niveaux($err, (0, 48, 96, 144, 192, 255), -$max, @px);
671		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
672
673		# 10
674		($e, @p) = &test_niveaux($err, (0, 96, 112, 128, 144, 192, 255), -$max, @px);
675		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
676
677		# 11
678		($e, @p) = &test_niveaux($err, (0, 128, 255), -$max, @px);
679		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
680
681		# 12
682		($e, @p) = &test_niveaux($err, (0, 39, 101, 195, 255), -$max, @px);
683		print $c++,"=$e"; if($e < $err) {@pal = @p; $err = $e; print "*";} print "\n";
684
685		return @pal;
686		}
687
688
689
690		my($colorspace) = "CMYK";
691		#$colorspace="HSV";
692		$colorspace = "RGB";
693		#$colorspace="YUV";
694		$glb_magick->AdaptiveResize(geometry=>"80x200!") if 0;
695		$glb_magick->Posterize(levels=>16, dither=>"False") if 0;
696		$glb_magick->Posterize(levels=>6, dither=>"False") if 0;
697		$glb_magick->Posterize(levels=>4, dither=>"False") if 0;
698		$glb_magick->Posterize(levels=>3, dither=>"False") if 0;
699		# pas mal du tout:
700		$glb_magick->Quantize(colors=>$max, colorspace=>$colorspace, treedepth=>0, dither=>"False");
701		@t = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
702		for($i=$#t+1; ($i-=3)>=0;) {
703		$rvb = &rgb2irgb(@t[$i..$i+2]);
704		#$rvb = ((($map_ef2[$rvb>>20]<<10) + $map_ef2[($rvb>>10) & 0xff])<<10) + $map_ef2[$rvb & 0xff] if $#map_ef>=0;
705		$rvb = ((($map_ef[$rvb>>20]<<10) + $map_ef[($rvb>>10) & 0xff])<<10) + $map_ef[$rvb & 0xff] if $#map_ef>=0;
706		$pal{$rvb & $mask} = 1;
707		}
708		@t = (keys(%pal), (0) x $max)[0..($max-1)];
709		#foreach $t (@t) { print &irgb2hex($t), "\n"; }
710		return @t;
711		}
712
713		# calcul d'une palette de 16 couleurs
714		sub find_palette {
715		my($max, @px) = @_;
716
717		# cas TO7
718		return &to770_palette if $glb_to7pal;
719
720		# vrai algo
721		my($mask) = 0x0f03c0f0; $mask = -1;
722
723		# si l'image a suffisament peu de couleurs alors on retourne la palette de l'image
724		# directement
725		my($i, %pal);
726		foreach $i (@px) {
727		$pal{$i & $mask} = 1;
728		last if length(keys %pal)>$max;
729		}
730		my(@t) = keys(%pal);
731		#for $t (@t) {
732		# print &irgb2hex($t), " = ", $pal{$t},"\n";
733		#}
734		return @t if $#t<$max;
735		%pal = ();
736
737		# sinon on quantifie l'image:
738		my($use_dith) = 1;
739		my($alt) = 0;
740
741		#return &xxx_palette($max, @px) if $#map_ef>=0;
742
743		# on remap l'image aux niveau produits par les puces thomson!
744		if($#map_ef>=0) {
745		@t = simple_dither($use_dith, @px) unless $alt;
746		@t = prox_dither ($use_dith, @px) if $alt;
747		}
748
749		# idee par groupe de $w pixels on sature les valeurs RGB avec
750		# les min/max ontenus pour ce groupe. L'idee est de réduire
751		# la disperssion des couleurs
752		if(1) {
753		my($w) = 8;
754		for($i=0; $i<=$#t; $i+=3*$w) {
755		my($r,$v,$b) = (1,1,1);
756		my($R,$V,$B) = (0,0,0);
757		my($j);
758		for($j=$i; $j<$i+$w*3; $j+=3) {
759		$r = $t[$j+0] if $t[$j+0]<$r;
760		$v = $t[$j+1] if $t[$j+1]<$v;
761		$b = $t[$j+2] if $t[$j+2]<$b;
762		$R = $t[$j+0] if $t[$j+0]>$R;
763		$V = $t[$j+1] if $t[$j+1]>$V;
764		$B = $t[$j+2] if $t[$j+2]>$B;
765		}
766		my($t) = 0.5;
767		for($j=$i; $j<$i+$w*3; $j+=3) {
768		$t[$j+0] = $t[$j+0] < (1-$t)$r + $t$R ? $r : $R;
769		$t[$j+1] = $t[$j+1] < (1-$t)$v + $t$V ? $v : $V;
770		$t[$j+2] = $t[$j+2] < (1-$t)$b + $t$B ? $b : $B;
771		}
772		}
773		}
774
775		# on réduit à 64 couls
776		$glb_magick->Quantize(colors=>($alt?48:24)0+641+1280+2560, colorspace=>"RGB", treedepth=>0, dither=>($use_dith && !$alt & 0?"True":"False"));
777		$glb_magick->Write("toto3.gif");
778		@t = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
779
780		# on comptabilise les couleurs renormalisées au format Thomson
781		%pal = ();
782		$pal{0} = 1+$#t;
783		for($i=$#t+1; ($i-=3)>=0;) {
784		$rvb = &rgb2irgb(@t[$i..$i+2]);
785		#$rvb = ((($map_ef2[$rvb>>20]<<10) + $map_ef2[($rvb>>10) & 0xff])<<10) + $map_ef2[$rvb & 0xff] if $#map_ef>=0;
786		$rvb = ((($map_ef[$rvb>>20]<<10) + $map_ef[($rvb>>10) & 0xff])<<10) + $map_ef[$rvb & 0xff] if $#map_ef>=0;
787		++$pal{$rvb & $mask};
788		}
789
790		# on trie par frequence
791		my(@cpt) = (sort { $pal{$b} - $pal{$a} } keys %pal);
792
793		# selection par popularité?
794		return (@cpt, (0) x $max)[0..($max-1)] if 0;
795
796		# affichage des stats
797		my($dbg) = 0;
798		if($dbg) {
799		for $t (@cpt) {
800		print &irgb2hex($t), " = ", $pal{$t},"\n";
801		}
802		}
803
804		# on coupe les couls sous-représentées
805		my($thr) = 8;
806		@t = @cpt; @cpt = ();
807		for $t (@t) {
808		push(@cpt, $t) if $pal{$t} >= $thr;
809		}
810
811		# on prend la couleur la plus frequente, puis la plus loin de celle là jusqu'à 10 couls ensuite une fois sur 2 on prend la plus ancienne
812		@t = ();
813		push(@t, shift(@cpt));
814		while($#t < $max && $#cpt>=0) {
815		#print "\n\n";
816		#for $t (@t) {
817		# print &irgb2hex($t), " = ", $pal{$t},"\n";
818		#}
819		if($#t < 10 \|\| ($#t & 1)) {
820		#print "\n\n\n$#t, plus loin\n";
821		$i = &find_furthest(\@t, \@cpt);
822		push(@t, splice(@cpt, $i, 1, ()));
823		} else {
824		#print "\n\n\n$#t, plus freq";
825		# on prends la plus frequente
826		push(@t, shift(@cpt));
827		}
828		}
829
830		# on complète avec des zero
831		@t = (@t, (0) x $max)[0..($max-1)];
832		$dbg = 0;
833		if($dbg) {
834		print "\n\n";foreach $t (@t) {
835		my($r) = &ammag(($t>>20) & 0x1ff);
836		my($g) = &ammag(($t>>10) & 0x1ff);
837		my($b) = &ammag(($t>>00) & 0x1ff);
838		print &irgb2hex($t), " = ", $pal{$t}, " ", $r,",",$g,",",$b," ",$t,"\n";
839		}
840		}
841
842		return @t;
843		}
844
845		# dithering simple sans contraintes de proximité
846		sub simple_dither {
847		my($use_dith, @px) = @_;
848
849		my($x, $y, $p, $rvb, $r, $v, $b, @t);
850		for($y=0, $p=0; $y<200; ++$y) {
851		for($x=0; $x<320; ++$x, ++$p) {
852		$rvb = $px[$p];
853		$r=$map_ef[$rvb>>20]; $v=$map_ef[($rvb>>10) & 0xff]; $b=$map_ef[$rvb & 0xff];
854		push(@t, &ammag($r), &ammag($v), &ammag($b));
855		#push(@t, $r=($rvb>>20), $v=(($rvb>>10) & 0xff), $b=($rvb & 0xff));
856		if($use_dith) {
857		$px[$p] = ((($r<<10)+$v)<<10)+$b;
858		$rvb = &irgb_sub($rvb, $px[$p]);
859		$px[$p + 319] = &irgb_uadd($px[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x>0;
860		$px[$p + 320] = &irgb_uadd($px[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
861		$px[$p + 321] = &irgb_uadd($px[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x<319;
862		$px[$p + 001] = &irgb_uadd($px[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && $x<319;
863		}
864		}
865		}
866		open(OUT,">.toto2.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @t), "\n"; close(OUT);
867		@$glb_magick = ();
868		$glb_magick->Read(".toto2.pnm");
869		unlink(".toto2.pnm");
870
871		$glb_magick->Write("toto2_.png");
872
873		return @t;
874		}
875
876		# dither sans contraintes de couleurs, mais avec contrainte de proximité
877		sub prox_dither {
878		my($use_dith, @px) = @_;
879
880		my($x, $y, $fond, $forme, $i, $p, $rvb, $r, $v, $b, @t);
881		for($y=$p=0; $y<200; ++$y) {
882		for($x=0; $x<320; $x += 8) {
883		($fond, $forme) = &prox_couple(@px[$p..$p+7]);
884		for($i = 0; $i<8; ++$i, ++$p) {
885		$rvb = $px[$p];
886		$rvb = &irgb_dist($fond, $rvb) < &irgb_dist($forme, $rvb) ? $fond : $forme;
887		$r=$map_ef[$rvb>>20]; $v=$map_ef[($rvb>>10) & 0xff]; $b=$map_ef[$rvb & 0xff];
888		push(@t, &ammag($r), &ammag($v), &ammag($b));
889		if($use_dither \| 1) {
890		#$px[$p] = ((($r<<10)+$v)<<10)+$b;
891		$rvb = &irgb_sub($px[$p], $rvb);
892		$px[$p + 319] = &irgb_uadd($px[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x+$i>0;
893		$px[$p + 320] = &irgb_uadd($px[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
894		$px[$p + 321] = &irgb_uadd($px[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x+$i<319;
895		$px[$p + 001] = &irgb_uadd($px[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && $x+$i<319;
896		}
897		}
898		}
899		}
900		open(OUT,">.toto2.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @t), "\n"; close(OUT);
901		@$glb_magick = ();
902		$glb_magick->Read(".toto2.pnm");
903		#$glb_magick->Write(".toto2.png");
904		unlink(".toto2.pnm");
905
906		return @t;
907		}
908
909		sub prox_couple {
910		my(@octet) = @_;
911
912		my($i, $im, $j, $jm, $d, $dm, $rgb, $r, $g, $b, %cpt, @px);
913
914		# dither de l'octet sans contraintes pour extraire les stats
915		@px = (@octet);
916		for($i=0; $i<8; ++$i) {
917		$rgb = $px[$i];
918		$r=$map_ef[$rgb>>20]; $v=$map_ef[($rgb>>10) & 0xff]; $b=$map_ef[$rgb & 0xff];
919		++$cpt{$px[$i] = ((($r<<10)+$v)<<10)+$b};
920		$px[$i+1] = &irgb_add_cln($px[$i+1], &irgb_map(&irgb_sub($rgb, $px[$i]), \@glb_map3)) if $i<7;
921		}
922
923		# on trie par frequence
924		my(@cpt) = (sort { $cpt{$b} - $cpt{$a} } keys %cpt);
925
926		#print "\n\n";
927		#foreach $t (@octet) {
928		# print &irgb2hex($t), " ";
929		#}
930		#print "\n\n";
931		#foreach $t (@cpt) {
932		# print &irgb2hex($t), " = ", $cpt{$t}, "\n";
933		#}
934
935		# 1 ou 2 couls utilisées: pas de probs
936		if($#cpt<=1) {
937		# on s'assure qu'on en a au moins 2
938		$cpt[1] = $cpt[0] if $#cpt==0;
939
940		return ($cpt[1], $cpt[0]);
941		}
942
943		# les 2 couls principales couvrent 7 pixels sur les 8, on les gardes, tant pis pour la mintorité
944		if($cpt{$cpt[0]} + $cpt{$cpt[1]} >= 6) {
945		return ($cpt[1], $cpt[0]);
946		}
947
948		# si la 1ere couvre 4 pixels, on prend comme 2eme celle qui fait le moins d'err
949		if($cpt{$cpt[0]} >= 6) {
950		$dm = 1e30;
951		for($i=1; $i<=$#cpt; ++$i) {
952		@px = (@octet);
953		for($d = $j = 0; $j<8 && $d<$dm; ++$j) {
954		$d1 = &irgb_dist($cpt[0], $px[$j]);
955		$d2 = &irgb_dist($cpt[$i],$px[$j]);
956		if($d1 < $d2) {$d += &sq($d1); $rgb = $cpt[0];} else {$d += &sq($d2); $rgb = $cpt[$i];}
957		$px[$j+1] = &irgb_add_cln($px[$j+1], &irgb_map(&irgb_sub($px[$j], $rgb), \@glb_map3)) if $glb_err3 && $j<7;
958		}
959		if($d < $dm) {$dm = $d; $im = $i;}
960		}
961		return ($cpt[$im], $cpt[0]);
962		}
963
964		# sinon tester tous les couple avec dither
965		my($r, $rm);
966		$dm = 1e30;
967		for($i=0; $i<=$#cpt; ++$i) {
968		for($j=0; $j<$i; ++$j) {
969		@px = (@octet);
970		for($r = $d = $k = 0; $k<8 && $d<$dm; ++$k) {
971		$di = &irgb_dist($cpt[$i], $px[$k]);
972		$dj = &irgb_dist($cpt[$j], $px[$k]);
973		if($di <= $dj) {$r \|= 1; $rgb = $cpt[$i]; $d += &sq($di);} else {$r \|= 2; $rgb = $cpt[$j]; $d += &sq($dj);}
974		$px[$k+1] = &irgb_add_cln($px[$k+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $k<7;
975		}
976		if($d < $dm) {$rm = $r; $dm = $d; $im = $i; $jm = $j}
977		}
978		}
979		return ($cpt[$im], $cpt[$jm]);
980		}
981
982		sub find_furthest {
983		my ($set, $cols) = @_;
984		my ($d, $dm, $i, $im);
985		for($i = $#{$cols}, $dm = $im = 0; $i>=0; --$i) {
986		$d = &set_dist($cols->[$i], $set);
987		#print "$i ", &irgb2hex($cols->[$i])," ==> $d, $dm\n";
988		if($d > $dm) {$dm = $d; $im = $i; #print"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n";
989		}
990		}
991		#print "*** ", &irgb2hex($cols->[$im])," $im ($dm)\n";
992		return $im;
993		}
994
995		sub set_dist {
996		my($rgb, $set) = @_;
997		my($dm, $d, $col) = 1e30;
998		my $dc = 0;
999		foreach $col (@$set) {
1000		$d = &irgb_dist($rgb, $col);
1001		$dc += $d;
1002		#print &irgb2hex($rgb),",",&irgb2hex($col), "====$d\n";
1003		if($d<$dm) {$dm = $d;}
1004		}
1005		return $dm; # + $dc;
1006		}
1007
1008		# sauvegarde de l'image
1009		sub write_image {
1010		my($file, @px) = @_;
1011
1012		# on replace tout entre 0 et 255
1013		my($t, $c, @p);
1014		foreach $t (@px) {
1015		my($b) = $t & 0x100 ? 0 : $t & 0xff; $t >>= 10;
1016		my($v) = $t & 0x100 ? 0 : $t & 0xff; $t >>= 10;
1017		my($r) = $t & 0x100 ? 0 : $t & 0xff;
1018		if(0 && $#map_ef>=0) {
1019		$r = $map_ef2[$r];
1020		$v = $map_ef2[$v];
1021		$b = $map_ef2[$b];
1022		}
1023		push(@p, &ammag($r), &ammag($v), &ammag($b)); #, $r, $v, $b);
1024		}
1025		# on passe par un fichier temporaire
1026		open(OUT,">.toto.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @p), "\n"; close(OUT);
1027		#open(OUT, ">.toto.pnm"); print OUT "P6\n640 400\n255\n"; for($t = 0; $t<=$#p; $t+=6403) {print OUT pack('C', @p[$t..$t+6403-1], @p[$t..$t+6403-1]);} print OUT "\n"; close(OUT);
1028		@$glb_magick = ();
1029		$glb_magick->Read(".toto.pnm");
1030		$glb_magick->Set(page=>"320x200+0+0");
1031		# $glb_magick->Set(page=>"640x400+0+0");
1032		#$glb_magick->Gamma(gamma=>1.2);
1033		#$glb_magick->Resize(geometry=>"640x400!");
1034		#$glb_magick->Border(width=>"320",height=>"100",color=>"black");
1035		#unlink(".toto.pnm");
1036
1037		# sauvegarde
1038		$glb_magick->Write($file);
1039		}
1040
1041		# gamma / normalize / sigmoidal
1042		# 0 = orig / Linear / off
1043		# 1 = orig / Linear / on
1044		# 2 = orig / Normalize / off
1045		# 3 = orig / Normalize / on
1046		# 4 = gamma / Linear / off
1047		# 5 = gamma / Linear / on
1048		# 6 = gamma / Normalize / off
1049		# 7 = gamma / Normalize / on
1050
1051		# lit une image au format 320 x 200 sous la forme r10v10b10
1052		sub read_image {
1053		my($file) = @_;
1054
1055		@$glb_magick = ();
1056		my($x) = $glb_magick->Read($file);
1057		warn "$x" if "$x";
1058
1059		# formattage en 320x200 si necessaire
1060		$glb_magick->Enhance();
1061		$glb_magick->Normalize(); #
1062		#$glb_magick->LinearStretch('black-point'=>0, 'white-point'=>1);
1063		#$glb_magick->Contrast(sharpen=>"True");
1064		#$glb_magick->Set(antialias=>"True");
1065		$glb_magick->SigmoidalContrast(contrast=>2);
1066		$glb_magick->AdaptiveResize(geometry=>"320x200", filter=>"lanczos", blur=>1);
1067		$glb_magick->Border(width=>"320",height=>"100",color=>"black");
1068		# $glb_magick->Blur(1);
1069		# $glb_magick->OilPaint(2);
1070		$glb_magick->Set(gravity=>"Center");
1071		# $glb_magick->Crop(geometry=>"320x200!", gravity=>"center");
1072		$glb_magick->Crop(geometry=>"320x200!");
1073		$glb_magick->Set(page=>"320x200+0+0");
1074		$glb_magick->Resize(geometry=>"320x200!", filter=>"lanczos", blur=>1);
1075		#$glb_magick->ReduceNoise(radius=>0);
1076		#$glb_magick->Gamma(gamma=>0.8) if $glb_to7pal;
1077		#$glb_magick->Gamma(gamma=>0.45);
1078		#$glb_magick->AdaptiveSharpen(radius=>3);
1079		#$glb_magick->AdaptiveBlur(radius=>4);
1080		#$glb_magick->Contrast(sharpen=>"True");
1081		#$glb_magick->Evaluate(operator=>"Multiply", value=>"0.9");
1082
1083		#$glb_magick->Quantize(colors=>$glb_maxcol, colorspace=>"CYMK", dither=>"True");
1084		#$glb_magick->OrderedDither(threshold=>"h4x4", channel=>"RGB");
1085		if($glb_dith>=2) {
1086		#dither en 16 couls
1087		my(@t) = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
1088		my($i, $j, $t, $p, @p);
1089		my($m) = $glb_dith-1;
1090		for($j=$p=0; $j<200; ++$j) {
1091		for($i=0; $i<320; ++$i) {
1092		$t = $t[$p] * $m; ++$t if $t<$m && $t - int($t)>=$mat[$i % $mat_x][$j % $mat_y]; $t[$p++] = (int($t)*255)/$m;
1093		$t = $t[$p] * $m; ++$t if $t<$m && $t - int($t)>=$mat[$i % $mat_x][$j % $mat_y]; $t[$p++] = (int($t)*255)/$m;
1094		$t = $t[$p] * $m; ++$t if $t<$m && $t - int($t)>=$mat[$i % $mat_x][$j % $mat_y]; $t[$p++] = (int($t)*255)/$m;
1095		}
1096		}
1097		open(OUT,">.toto.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @t), "\n"; close(OUT);
1098		@$glb_magick = ();
1099		$glb_magick->Read(".toto.pnm");
1100		$glb_magick->Write(".toto.png");
1101		unlink(".toto.pnm");
1102		}
1103		my(@t) = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
1104		my($i, @px);
1105		for($i = 0; $i<$#t; $i += 3) {
1106		push(@px, &rgb2irgb($t[$i], $t[$i+1], $t[$i+2]));
1107		}
1108
1109		#$glb_magick->Write("totof.png");
1110
1111		return @px;
1112		}
1113
1114		sub ammag {
1115		return $_[0] unless $glb_gamma;
1116		my $t = $_[0]/255;
1117		#if($t<=0.018) {$t = 4.5$t;} else {$t = 1.099($t**(1/$glb_gamma))-0.099;}
1118		$t = $t**(1/$glb_gamma);
1119		return xint(255*$t);
1120		}
1121
1122		sub gamma {
1123		return $_[0] unless $glb_gamma;
1124		my $t = $_[0]/255;
1125		#if($t<=0.081) {$t = $t/4.5;} else {$t = (($t+0.099)/1.099)**$glb_gamma;}
1126		$t = $t**$glb_gamma;
1127		return xint($t255); #1.2; #*1.4;
1128		}
1129
1130		# affichage
1131		sub irgb2hex {
1132		my($irgb) = @_;
1133		my($s) = "";
1134		if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
1135		if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
1136		if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
1137		return $s;
1138		}
1139
1140		# addition d'une valeur irgb signée .. inclu saturation -256 +255
1141		sub irgb_add {
1142		my($irgb1, $irgb2) = @_;
1143
1144		my($r) = $irgb1 + $irgb2;
1145		my($o) = (($irgb1 & 0x0ff3fcff) + ($irgb2 & 0x0ff3fcff)) ^ ($r>>1);
1146		$r = ($r & ~0x000003ff) \| (0x00000100 - (($r & 0x00000100)>>8)) if $o & 0x00000100;
1147		$r = ($r & ~0x000ffc00) \| (0x00040000 - (($r & 0x00040000)>>8)) if $o & 0x00040000;
1148		$r = ($r & ~0x3ff00000) \| (0x10000000 - (($r & 0x10000000)>>8)) if $o & 0x10000000;
1149		return $r & 0x1ff7fdff if 1; # saturation -256 et +255
1150		}
1151
1152		sub irgb_add_cln {
1153		my($t) = &irgb_add(@_);
1154
1155		return $t;
1156
1157		my($r, $g, $b);
1158
1159		$r = ($t>>00) & 0x1FF;
1160		$g = ($t>>10) & 0x1FF;
1161		$b = ($t>>20) & 0x1FF;
1162
1163		$r = ($r^0x1FF)+1 if $r & 0x100;
1164		$g = ($g^0x1FF)+1 if $g & 0x100;
1165		$b = ($b^0x1FF)+1 if $b & 0x100;
1166
1167		my($M) = $r;
1168		$M = $g if $g>$M;
1169		$M = $b if $b>$M;
1170
1171		$M/=4.2;
1172
1173		$t &= ~(0x1FF<<00) if $r<$M;
1174		$t &= ~(0x1FF<<10) if $g<$M;
1175		$t &= ~(0x1FF<<20) if $b<$M;
1176
1177		return $t;
1178		}
1179
1180		# addition d'une valeur irgb signée .. inclu saturation 0 +255
1181		sub irgb_uadd {
1182		return &irgb_sat(&irgb_add(@_));
1183		}
1184
1185		# sature les irgb<0 à 0
1186		sub irgb_sat {
1187		my($irgb) = @_;
1188
1189		return (((0x10040100 - (($irgb & 0x10040100)>>8)) ^ 0xff3fcff) & $irgb) & 0xff3fcff;
1190		}
1191
1192		# soustraction de deux valeurs irgb>=0 (pas de satur)
1193		sub irgb_sub {
1194		my($rgb1, $rgb2) = @_;
1195		return (($rgb1 \| 0x20080200) - $rgb2) & 0x1ff7fdff;
1196		}
1197
1198		sub irgb_sub2 {
1199		my($rgb1, $rgb2) = @_;
1200		my($t) = &irgb_sub(@_);
1201
1202		my($r) = ($t>>00) & 0x1FF;
1203		my($g) = ($t>>10) & 0x1FF;
1204		my($b) = ($t>>20) & 0x1FF;
1205
1206		$r = ($r^0x1FF)+1 if $r & 0x100;
1207		$g = ($g^0x1FF)+1 if $g & 0x100;
1208		$b = ($b^0x1FF)+1 if $b & 0x100;
1209
1210		my($m) = ($r+$g+$b)/3;
1211		$r = 0 if $r<$m;
1212		$g = 0 if $g<$m;
1213		$b = 0 if $b<$m;
1214
1215		$r = 0x1ff&(-$r) if $t & 0x100;
1216		$g = 0x1ff&(-$g) if $t & 0x100<<10;
1217		$b = 0x1ff&(-$b) if $t & 0x100<<20;
1218		return ((($b<<10)\|$g)<<10)\|$r;
1219		}
1220
1221		# valeur opposée
1222		sub irgb_neg {
1223		my($rgb) = @_;
1224		return (0x20080200 - $rgb) & 0x1ff7fdff;
1225		}
1226
1227		# module du vecteur irgb
1228		sub irgb_module {
1229		my($rgb) = @_;
1230		my($d);
1231		$d = $glb_sqr[0x1ff & $rgb]; $rgb >>= 10;
1232		$d += $glb_sqr[0x1ff & $rgb]; $rgb >>= 10;
1233		$d += $glb_sqr[0x1ff & $rgb];
1234		return sqrt($d);
1235		}
1236
1237		# applique une table sur un irgb (en gros ca sert pour les multiplications par des constantes)
1238		sub irgb_map {
1239		my($rgb, $map) = @_;
1240		my($r);
1241		$r = $map->[$rgb & 0x1ff]; $rgb >>= 10;
1242		$r \|= $map->[$rgb & 0x1ff]<<10; $rgb >>= 10;
1243		$r \|= $map->[$rgb]<<20;
1244		return $r;
1245		}
1246
1247		sub irgb_cln {
1248		my($t) = @_;
1249
1250		my($r) = ($t>>00) & 0x1FF;
1251		my($g) = ($t>>10) & 0x1FF;
1252		my($b) = ($t>>20) & 0x1FF;
1253
1254		$r = ($r^0x1FF)+1 if $r & 0x100;
1255		$g = ($g^0x1FF)+1 if $g & 0x100;
1256		$b = ($b^0x1FF)+1 if $b & 0x100;
1257
1258		#print "$r $g $b => ";
1259
1260		my($m) = ($r+$g+$b)/4;
1261		$r = 0 if $r<$m;
1262		$g = 0 if $g<$m;
1263		$b = 0 if $b<$m;
1264
1265		#print "$r $g $b ";
1266
1267		$r = 0x1ff&(-$r) if $t & 0x100;
1268		$g = 0x1ff&(-$g) if $t & 0x100<<10;
1269		$b = 0x1ff&(-$b) if $t & 0x100<<20;
1270		return ((($b<<10)\|$g)<<10)\|$r;
1271		}
1272
1273		# rgb (0..1) vers irgb
1274		sub rgb2irgb {
1275		my(@rgb) = @_;
1276		my($t);
1277		if($glb_gamma) {
1278		$rgb[0] = &gamma($rgb[0]*255)/255;
1279		$rgb[1] = &gamma($rgb[1]*255)/255;
1280		$rgb[2] = &gamma($rgb[2]*255)/255;
1281		}
1282		$t = (int(255*$rgb[0]) & 0x1ff);
1283		$t = (int(255*$rgb[1]) & 0x1ff) \| ($t<<10);
1284		$t = (int(255*$rgb[2]) & 0x1ff) \| ($t<<10);
1285		return $t;
1286		}
1287
1288		# irgb vers rgb (0..1). si la composante est negative, elle est clampée à 0
1289		sub irgb2rgb {
1290		my($t) = @_;
1291
1292		my($b) = ($t & 0x100) ? 0 : ($t & 255)/255.0; $t >>= 10;
1293		my($v) = ($t & 0x100) ? 0 : ($t & 255)/255.0; $t >>= 10;
1294		my($r) = ($t & 0x100) ? 0 : ($t & 255)/255.0;
1295
1296		return ($r, $v, $b);
1297		}
1298
1299		# moyenne de 2 couleurs >= 0
1300		sub irgb_avg {
1301		my($rgb1, $rgb2) = @_;
1302		return (($rgb1 + $rgb2 + 0x100401) & ~0x20180601)>>1;
1303		}
1304
1305		# rgb (0..1) vers xyz
1306		sub rgb2xyz {
1307		my($r, $v, $b) = @_;
1308		return (0.618$r + 0.177$v + 0.205*$b,
1309		0.299$r + 0.587$v + 0.114*$b,
1310		0.056$v + 0.944$b);
1311		}
1312
1313		# xyz vers cie lab
1314		sub xyz2lab {
1315		my($x, $y, $z) = @_;
1316		#my($xn, $yn, $zn) = &rgb2xyz(1,1,1); $x /= $xn; $y /= $yn; $z /= $zn;
1317		my($l,$a,$b);
1318		if($y>0.008856) {
1319		$l = 116($y * 0.33333333333333) - 16;
1320		} else {
1321		$l = 903*$y;
1322		}
1323		$a = 500*(&f_lab($x) - &f_lab($y));
1324		$b = 200*(&f_lab($y) - &f_lab($z));
1325		return ($l,$a,$b);
1326		}
1327
1328		sub f_lab {
1329		my($v) = @_;
1330
1331		if($v>0.008856) {
1332		return $v ** 0.333333333333333;
1333		} else {
1334		return 7.787*$v + 16/116.0;
1335		}
1336		}
1337
1338		# rgb vers lab
1339		sub rgb2lab {
1340		return &xyz2lab(&rgb2xyz(@_));
1341		}
1342
1343		# approximated CIE formula from http://www.compuphase.com/cmetric.htm#GAMMA
1344		sub irgb_cie_dist_fast {
1345		my($rgb1, $rgb2) = @_;
1346
1347		my($rmean) = (($rgb1 + $rgb2) >> 21) & 0x1ff;
1348		my($rgb) = &irgb_sub($rgb1, $rgb2);
1349
1350		$d = ($glb_sqr[0x1ff & $rgb] * (512 + $rmean)) >> 8; $rgb >>= 10;
1351		$d += $glb_sqr[0x1ff & $rgb] * 4; $rgb >>= 10;
1352		$d += ($glb_sqr[0x1ff & $rgb] * (767 - $rmean)) >> 8;
1353		return sqrt($d);
1354		}
1355
1356		# calcule la distance entre les deux couleurs r10g10b10
1357		sub irgb_dist {
1358		my($rgb1, $rgb2) = @_;
1359		#die &irgb2hex($rgb1) if $rgb1 & 0x10040100;
1360		#die &irgb2hex($rgb2) if $rgb2 & 0x10040100;
1361		if($glb_lab) {
1362		return &irgb_cie_dist_fast($rgb1, $rgb2);
1363		#my($k) = $rgb1."_".$rgb2;
1364		my($d); # = $dist_cache{$k};
1365		#if(!defined $d) {
1366		my($r1, $g1, $b1) = &xyz2lab(&rgb2xyz(&irgb2rgb($rgb1)));
1367		my($r2, $g2, $b2) = &xyz2lab(&rgb2xyz(&irgb2rgb($rgb2)));
1368
1369		$r1 -= $r2; $g1 -= $g2; $b1 -= $b2;
1370		$d = sqrt($r1$r1 + $g1$g1 + $b1*$b1);
1371		#$dist_cache{$k} = $d;
1372		#}
1373		return $d;
1374		} else {
1375		return &irgb_module(&irgb_sub($rgb1, $rgb2));
1376		}
1377		}
1378
1379		# retourne le couple forme/fond pour un octet donné
1380		sub couple {
1381		my(@octet) = @_;
1382
1383		return &couple2(@octet) if 0;
1384		return &couple3(@octet) if 0;
1385		return &couple4(@octet) if 1;
1386
1387		# on commence un dither classique mais horizontal de l'octet
1388		my($i, $im, $j, $jm, $d, $dm, $rgb, @octet_pal);
1389		$#octet_pal = 7;
1390		for($i=0; $i<8; ++$i) {
1391		$rgb = $octet[$i];
1392		# on trouve la coul la plus proche
1393		$dm = 1e30;
1394		for($j=0; $j<$glb_maxcol; ++$j) {
1395		$d = &irgb_dist($glb_pal[$j], $rgb);
1396		if($d<$dm) {$dm = $d; $octet_pal[$i] = $j;}
1397		}
1398		# on propage l'erreur
1399		#$qq = &irgb_map(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]]), \@glb_map3);
1400		#print &irgb2hex($octet[$i]),",",&irgb2hex($glb_pal[$octet_pal[$i]])," e=",&irgb2hex(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]])), " " if $qq;
1401		#print "m=",&irgb2hex($qq)," " if $qq;
1402		#print &irgb2hex($octet[$i + 1]), " => " if $qq;
1403		$octet[$i+1] = &irgb_add_cln($octet[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$octet_pal[$i]]), \@glb_map3)) if $i<7;
1404		#print &irgb2hex($octet[$i + 1]), "\n" if $qq;
1405		}
1406
1407		# ensuite on trouve le couple qui conduit au minimum d'erreur
1408		$dm = 1e30; my($t, @line);
1409		for($i=0; $i<$glb_maxcol; ++$i) {
1410		for($j=0; $j<$i; ++$j) {
1411		$d = &couple_dist($i, $j, $octet_pal[0]);
1412		$d += &couple_dist($i, $j, $octet_pal[1]) if $d<$dm;
1413		$d += &couple_dist($i, $j, $octet_pal[2]) if $d<$dm;
1414		$d += &couple_dist($i, $j, $octet_pal[3]) if $d<$dm;
1415		$d += &couple_dist($i, $j, $octet_pal[4]) if $d<$dm;
1416		$d += &couple_dist($i, $j, $octet_pal[5]) if $d<$dm;
1417		$d += &couple_dist($i, $j, $octet_pal[6]) if $d<$dm;
1418		$d += &couple_dist($i, $j, $octet_pal[7]) if $d<$dm;
1419
1420		if($d<$dm) {$dm = $d; $im = $i; $jm = $j;}
1421		}
1422		}
1423
1424		return ($glb_pal[$im], $glb_pal[$jm]);
1425		}
1426
1427		sub couple_dist {
1428		my($forme, $fond, $pixel) = @_;
1429
1430		my($t, $a, $b) = $pixel*$glb_maxcol;
1431		return ($a=$glb_dist[$t + $forme]) < ($b=$glb_dist[$t + $fond]) ? $a : $b;
1432		}
1433
1434		sub couple_dist_sq {
1435		my($t) = &couple_dist(@_);
1436		return $t*$t;
1437		}
1438
1439		sub couple2 {
1440		my(@octet) = @_;
1441		my($d, $dm, $im, $jm); $dm = 1e30;
1442		for($i=0; $i<$glb_maxcol; ++$i) {
1443		for($j=0; $j<$i; ++$j) {
1444		$d = &couple2_dist($i, $j, $octet[0]);
1445		$d += &couple2_dist($i, $j, $octet[1]) if $d<$dm;
1446		$d += &couple2_dist($i, $j, $octet[2]) if $d<$dm;
1447		$d += &couple2_dist($i, $j, $octet[3]) if $d<$dm;
1448		$d += &couple2_dist($i, $j, $octet[4]) if $d<$dm;
1449		$d += &couple2_dist($i, $j, $octet[5]) if $d<$dm;
1450		$d += &couple2_dist($i, $j, $octet[6]) if $d<$dm;
1451		$d += &couple2_dist($i, $j, $octet[7]) if $d<$dm;
1452
1453		if($d<$dm) {$dm = $d; $im = $i; $jm = $j;}
1454		}
1455		}
1456		return ($glb_pal[$im], $glb_pal[$jm]);
1457		}
1458
1459		sub couple2_dist {
1460		my($forme, $fond, $pixel) = @_;
1461		my($a,$b);
1462		return ($a=&irgb_dist($glb_pal[$forme], $pixel)) < ($b=&irgb_dist($glb_pal[$fond], $pixel)) ? $a : $b;
1463		}
1464
1465		sub couple2_dist_sq {
1466		my($t) = &couple2_dist(@_);
1467		return $t * $t;
1468		}
1469
1470		# retourne le couple forme/fond pour un octet donné
1471		sub couple3 {
1472		my(@octet) = @_;
1473
1474		# on commence un dither classique mais horizontal de l'octet
1475		my($i, $im, $j, $jm, $d, $dm, $rgb, @octet_pal);
1476		$#octet_pal = 7;
1477		for($i=0; $i<8; ++$i) {
1478		$rgb = $octet[$i];
1479		# on trouve la coul la plus proche
1480		$dm = 1e30;
1481		for($j=0; $j<$glb_maxcol; ++$j) {
1482		$d = &irgb_dist($glb_pal[$j], $rgb);
1483		if($d<$dm) {$dm = $d; $octet_pal[$i] = $j;}
1484		}
1485		# on propage l'erreur
1486		#$qq = &irgb_map(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]]), \@glb_map3);
1487		#print &irgb2hex($octet[$i]),",",&irgb2hex($glb_pal[$octet_pal[$i]])," e=",&irgb2hex(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]])), " " if $qq;
1488		#print "m=",&irgb2hex($qq)," " if $qq;
1489		#print &irgb2hex($octet[$i + 1]), " => " if $qq;
1490		$octet[$i+1] = &irgb_uadd($octet[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$octet_pal[$i]]), \@glb_map3)) if $i<7;
1491		#print &irgb2hex($octet[$i + 1]), "\n" if $qq;
1492		}
1493
1494		#la couleur fond est la couleur la plus choisie par octet_pal[i]
1495		my(@cpt) = (0) x 8;
1496		$i = -1;
1497		foreach $j (@octet_pal) {if(++$cpt[$j] > $i) {$i = $cpt[$j]; $im = $j;}}
1498
1499		# ensuite on trouve le couple qui conduit au minimum d'erreur
1500		$dm = 1e30; my($t, @line);
1501		for($j=0; $j<$glb_maxcol; ++$j) {
1502		$d = &couple_dist($im, $j, $octet_pal[0]);
1503		$d += &couple_dist($im, $j, $octet_pal[1]) if $d<$dm;
1504		$d += &couple_dist($im, $j, $octet_pal[2]) if $d<$dm;
1505		$d += &couple_dist($im, $j, $octet_pal[3]) if $d<$dm;
1506		$d += &couple_dist($im, $j, $octet_pal[4]) if $d<$dm;
1507		$d += &couple_dist($im, $j, $octet_pal[5]) if $d<$dm;
1508		$d += &couple_dist($im, $j, $octet_pal[6]) if $d<$dm;
1509		$d += &couple_dist($im, $j, $octet_pal[7]) if $d<$dm;
1510
1511		if($d<$dm) {$dm = $d; $jm = $j;}
1512		}
1513
1514		return ($glb_pal[$im], $glb_pal[$jm]);
1515		}
1516
1517		sub couple4 {
1518		return &couple5(@_) if 0;
1519
1520		my(@octet) = @_;
1521
1522		# on commence un dither classique mais horizontal de l'octet
1523		my($i, $im, $j, $jm, $d, $dm, $rgb, @octet_pal);
1524		$#octet_pal = 7;
1525		for($i=0; $i<8; ++$i) {
1526		$rgb = $octet[$i];
1527		# on trouve la coul la plus proche
1528		$dm = 1e30;
1529		for($j=0; $j<$glb_maxcol; ++$j) {
1530		$d = &irgb_dist($glb_pal[$j], $rgb);
1531		if($d<$dm) {$dm = $d; $octet_pal[$i] = $j;}
1532		}
1533		# on propage l'erreur
1534		#$qq = &irgb_map(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]]), \@glb_map3);
1535		#print &irgb2hex($octet[$i]),",",&irgb2hex($glb_pal[$octet_pal[$i]])," e=",&irgb2hex(&irgb_sub($octet[$i], $glb_pal[$octet_pal[$i]])), " " if $qq;
1536		#print "m=",&irgb2hex($qq)," " if $qq;
1537		#print &irgb2hex($octet[$i + 1]), " => " if $qq;
1538		$octet[$i+1] = &irgb_uadd($octet[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$octet_pal[$i]]), \@glb_map3)) if $i<7;
1539		#print &irgb2hex($octet[$i + 1]), "\n" if $qq;
1540		}
1541
1542		# comptage des occurences
1543		$dm = -1; my(@cpt) = (0) x $glb_maxcol; my($filt_cpt) = 0;
1544		foreach $j (@octet_pal) {if(++$cpt[$j] > $dm) {$dm = $cpt[$jm = $j];}}
1545		if($dm >= 8) {
1546		$im = 0;
1547		} elsif($dm >= 4) {
1548		# une couleur domine de loin: on la prend en fond. On cherche
1549		# alors la forme qui minimise l'erreur sur l'octet.
1550		$dm = 1e30; $im = 0;
1551		for($i = 0; $i < $glb_maxcol; ++$i) {
1552		next unless $cpt[$i]>0 \|\| $filt_cpt;
1553		$d = &couple_dist($i, $jm, $octet_pal[0]);
1554		$d += &couple_dist($i, $jm, $octet_pal[1]) if $d<$dm;
1555		$d += &couple_dist($i, $jm, $octet_pal[2]) if $d<$dm;
1556		$d += &couple_dist($i, $jm, $octet_pal[3]) if $d<$dm;
1557		$d += &couple_dist($i, $jm, $octet_pal[4]) if $d<$dm;
1558		$d += &couple_dist($i, $jm, $octet_pal[5]) if $d<$dm;
1559		$d += &couple_dist($i, $jm, $octet_pal[6]) if $d<$dm;
1560		$d += &couple_dist($i, $jm, $octet_pal[7]) if $d<$dm;
1561
1562		if($d<$dm) {$dm = $d; $im = $i;}
1563		}
1564		} else {
1565		# sinon on essaye tous les couples sans dither
1566		return &couple2(@_) if 0;
1567		# avec dither
1568		return &couple2(@octet) if 0;
1569		$dm = 1e30; $im = 0;
1570		for($i=0; $i<$glb_maxcol; ++$i) {
1571		next unless $cpt[$i]>0 \|\| $filt_cpt \|\| 1;
1572		for($j=0; $j<$i; ++$j) {
1573		next unless $cpt[$j]>0 \|\| $filt_cpt;
1574		$d = &couple_dist($i, $j, $octet_pal[0]);
1575		$d += &couple_dist($i, $j, $octet_pal[1]) if $d<$dm;
1576		$d += &couple_dist($i, $j, $octet_pal[2]) if $d<$dm;
1577		$d += &couple_dist($i, $j, $octet_pal[3]) if $d<$dm;
1578		$d += &couple_dist($i, $j, $octet_pal[4]) if $d<$dm;
1579		$d += &couple_dist($i, $j, $octet_pal[5]) if $d<$dm;
1580		$d += &couple_dist($i, $j, $octet_pal[6]) if $d<$dm;
1581		$d += &couple_dist($i, $j, $octet_pal[7]) if $d<$dm;
1582
1583		if($d<$dm) {$dm = $d; $im = $i; $jm = $j;}
1584		}
1585		}
1586		}
1587
1588		return ($glb_pal[$im], $glb_pal[$jm]);
1589		}
1590
1591		sub couple5__ {
1592		my(@octet) = @_;
1593
1594		# calcul de la coul moyenne sur l'octet
1595		my(@moy);
1596		$moy[0] = (($octet[0] + $octet[1])>>1) & 0xff3fcff;
1597		$moy[1] = (($octet[2] + $octet[3])>>1) & 0xff3fcff;
1598		$moy[2] = (($octet[4] + $octet[5])>>1) & 0xff3fcff;
1599		$moy[3] = (($octet[6] + $octet[7])>>1) & 0xff3fcff;
1600
1601		$moy[0] = (($moy[0] + $moy[1])>>1) & 0xff3fcff;
1602		$moy[1] = (($moy[2] + $moy[3])>>1) & 0xff3fcff;
1603
1604		# le fond = le plus proche de la moyenne
1605		my($j, $jm, $d, $dm);
1606		for($dm=1e30, $j=0; $j<$glb_maxcol; ++$j) {
1607		if(($d = &irgb_dist($glb_pal[$j], $moy[0]))<$dm) {$dm =$d; $jm = $j;}
1608		}
1609		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
1610		if(($d = &irgb_dist($glb_pal[$i], $moy[1]))<$dm) {$dm =$d; $im = $i;}
1611		}
1612
1613		return ($glb_pal[$im], $glb_pal[$jm]);
1614		}
1615
1616		sub couple5_ {
1617		my(@octet) = @_;
1618
1619		# on commence un dither classique mais horizontal de l'octet
1620		my($i, $im, $j, $jm, $d, $dm, $rgb, @octet_pal);
1621		my(@dist) = (0) x ($glb_maxcol * 8);
1622
1623		$#octet_pal = 7;
1624		for($i=0; $i<8; ++$i) {
1625		$rgb = $octet[$i];
1626		for($dm=1e30, $j=0; $j<$glb_maxcol; ++$j) {
1627		$d = &irgb_dist($glb_pal[$j], $rgb);
1628		if($d<$dm) {$dm = $d; $octet[$i] = $glb_pal[$octet_pal[$i] = $j];}
1629		}
1630		# $octet[$i+1] = &irgb_uadd($octet[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$octet_pal[$i]]), \@glb_map3)) if $i<7;
1631		}
1632		# comptage des occurences
1633		$dm = -1; my(@cpt) = (0) x $glb_maxcol; my($filt_cpt) = 0;
1634		foreach $j (@octet_pal) {if(++$cpt[$j] > $dm) {$dm = $cpt[$jm = $j];}}
1635		if($dm >= 8) {
1636		$im = 0;
1637		print "*";
1638		} elsif($dm >= 0) {
1639		# une couleur domine de loin: on la prend en fond. On cherche
1640		# alors la forme qui minimise l'erreur sur l'octet d'origine
1641		$dm = 1e30; $im = 0; my($p) = 0;
1642		for($i = 0; $i < $glb_maxcol; ++$i) {
1643		$d = $dist[$p++];
1644		$d += $dist[$p++];
1645		$d += $dist[$p++];
1646		$d += $dist[$p++];
1647		$d += $dist[$p++];
1648		$d += $dist[$p++];
1649		$d += $dist[$p++];
1650		$d += $dist[$p++];
1651		if($d<$dm) {$dm = $d; $im = $i;}
1652		}
1653		print "#";
1654		} else {
1655		# on regroupe les pixels 2 par 2, on trouve le plus proche dans la palette
1656		@octet_pal = (0) x 4;
1657		for($i=0; $i<4; ++$i) {
1658		$rgb = (($octet[$i2] + $octet[$i2+1])>>1) & 0xff3fcff;
1659		for($dm=1e30, $j=0; $j<$glb_maxcol; ++$j) {
1660		$dist[$j*4 + $i] = $d = &irgb_dist($glb_pal[$j], $rgb);
1661		if($d<$dm) {$dm = $d; $octet_pal[$i] = $j;}
1662		}
1663		}
1664		# comptage des occurences
1665		$dm = -1; my(@cpt) = (0) x $glb_maxcol; my($filt_cpt) = 0;
1666		foreach $j (@octet_pal) {if(++$cpt[$j] > $dm) {$dm = $cpt[$jm = $j];}}
1667		if($dm >= 2) {
1668		$dm = 1e30; $im = 0; my($p) = $jm*4;
1669		for($i = 0; $i < $glb_maxcol; ++$i) {
1670		$p = $i * 4;
1671		$d = $dist[$p++];
1672		$d += $dist[$p++] if $d < $dm;
1673		$d += $dist[$p++] if $d < $dm;
1674		$d += $dist[$p ] if $d < $dm;
1675		if($d<$dm) {$dm = $d; $im = $i;}
1676		}
1677		print ":";
1678		} else {
1679		couple2(@octet) if 0;
1680		$dm = 1e30; $im = 0;
1681		for($i=0; $i<$glb_maxcol; ++$i) {
1682		for($j=0; $j<$i; ++$j) {
1683		$d = &couple_dist($i, $j, $octet_pal[0]);
1684		$d += &couple_dist($i, $j, $octet_pal[1]) if $d<$dm;
1685		$d += &couple_dist($i, $j, $octet_pal[2]) if $d<$dm;
1686		$d += &couple_dist($i, $j, $octet_pal[3]) if $d<$dm;
1687
1688		if($d<$dm) {$dm = $d; $im = $i; $jm = $j;}
1689		}
1690		}
1691		print ".";
1692		}
1693		}
1694		print sprintf("%x%x ", $im, $jm);
1695		return ($glb_pal[$im], $glb_pal[$jm]);
1696		}
1697
1698		sub couple5 {
1699		my(@octet) = @_;
1700
1701		my($i, $j, $rgb, $dm, @px);
1702
1703		if(0) {
1704		# horiz dither first
1705		for($i=0; $i<8; ++$i) {
1706		$rgb = $octet[$i];
1707		for($j=0, $dm=1e30; $j<$glb_maxcol; ++$j) {
1708		$d = &irgb_dist($glb_pal[$j], $rgb);
1709		if($d<$dm) {$dm = $d; $octet[$i] = $glb_pal[$j];}
1710		}
1711		$octet[$i+1] = &irgb_uadd($octet[$i+1], &irgb_map(&irgb_sub($rgb, $octet[$i]), \@glb_map3)) if $i<7;
1712		}
1713		}
1714
1715		foreach $j (@octet) {my @t = &irgb2rgb($j); push(@px, $t[0]255, $t[1]255, $t[2]*255);}
1716
1717		my(@mean1) = (
1718		($px[0] + $px[3] + $px[6] + $px[9]) / 4,
1719		($px[1] + $px[4] + $px[7] + $px[10]) / 4,
1720		($px[2] + $px[5] + $px[8] + $px[11]) / 4,
1721		($px[12] + $px[15] + $px[18] + $px[21]) / 4,
1722		($px[13] + $px[16] + $px[19] + $px[22]) / 4,
1723		($px[14] + $px[17] + $px[20] + $px[23]) / 4,
1724		);
1725		my($d1, $d2, @mean2);
1726
1727		# on trouve les deux clusters
1728		while(1) {
1729		#print join(",", @mean1),"\n";
1730		@mean2 = (0,0,0,0,0,0); $d1 = $d2 = 0;
1731		for($i=0; $i<8; ++$i) {
1732		@rgb = @px[($i3)..($i3+2)];
1733		if(&rgbdist(@mean1[0..2], @rgb) < &rgbdist(@mean1[3..5], @rgb)) {
1734		++$d1; $mean2[0] += $rgb[0]; $mean2[1] += $rgb[1]; $mean2[2] += $rgb[2];
1735		} else {
1736		++$d2; $mean2[3] += $rgb[0]; $mean2[4] += $rgb[1]; $mean2[5] += $rgb[2];
1737		}
1738		}
1739		# si un cluster est vide, on repart pour un tour
1740		if($d1 == 0) {
1741		# on trouve le point le plus eloigné de l'autre centre
1742		@mean2 = (127, 127, 127, @mean2[3..5]);
1743		} elsif($d2 == 0) {
1744		@mean2 = (@mean2[0..2], 127, 127, 128);
1745		}
1746
1747		$d1 = 1 unless $d1>0; $d2 = 1 unless $d2>0;
1748		$mean2[0] = int($mean2[0] / $d1); $mean2[1] = int($mean2[1] / $d1); $mean2[2] = int($mean2[2] / $d1);
1749		$mean2[3] = int($mean2[3] / $d2); $mean2[4] = int($mean2[4] / $d2); $mean2[5] = int($mean2[5] / $d2);
1750
1751		last if $mean2[0]==$mean1[0] && $mean2[1]==$mean1[1] && $mean2[2]==$mean1[2] && $mean2[3]==$mean1[3] && $mean2[4]==$mean1[4] && $mean2[5]==$mean1[5];
1752		@mean1 = @mean2;
1753		}
1754
1755		#print join(",", @mean1),"\n";
1756		my($mean) = ((($mean1[0]<<10) + $mean1[1])<<10) + $mean1[2];
1757		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
1758		$d = &irgb_dist($mean, $glb_pal[$i]);
1759		if($d<$dm) {$dm = $d; $im = $i;}
1760		}
1761		$mean = ((($mean1[3]<<10) + $mean1[4])<<10) + $mean1[5];
1762		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
1763		$d = &irgb_dist($mean, $glb_pal[$i]);
1764		if($d<$dm) {$dm = $d; $jm = $i;}
1765		}
1766		#print &irgb2hex($glb_pal[$im]), " ", &irgb2hex($glb_pal[$jm]),"\n";
1767
1768		return ($glb_pal[$im], $glb_pal[$jm]);
1769		}
1770
1771		sub rgbdist {
1772		my($r1, $g1, $b1, $r2, $g2, $b2) = @_;
1773		$r1 -= $r2;
1774		$g1 -= $g2;
1775		$b1 -= $b2;
1776		return sqrt($r1$r1 + $g1$g1 + $b1*$b1);
1777		}
1778
1779		sub cleanup {
1780		return @_ if 0;
1781		my($thr) = $glb_clean;
1782		return @_ unless $thr>0;
1783		my(@r, $i, $t);
1784		my(@t) = @_;
1785
1786		if(1) {
1787		# les composantes bien trop faibles sont eliminées
1788		@r = @t; @t = ();
1789		for $i (@r) {
1790		my($r) = ($i>>00) & 0xFF;
1791		my($g) = ($i>>10) & 0xFF;
1792		my($b) = ($i>>20) & 0xFF;
1793		my($M) = $r;
1794		$M = $g if $g>$M;
1795		$M = $b if $b>$M;
1796		my($m) = $r;
1797		$m = $g if $g<$m;
1798		$m = $b if $b<$m;
1799		my($l) = 0.299$r + 0.587$g + 0.114*$b;
1800		#$m = $m*3 + $r + $g + $b;
1801		#$m /= 16;
1802		if(0) {
1803		$M /= 4.2; #4.2; # pas mal
1804		#$m = 255/8 if $m>255/8;
1805
1806		#while(($r<$m && $g<$m) \|\| ($r<$m && $b<$m) \|\| ($g<$m && $b<$m)) {$m/=1.05; last if $m<1e-3;}
1807		if($l<38 && $m<$M) {
1808		my($t) = ($m + $M)>>1;
1809		$r = 0 if $r<=$t;
1810		$g = 0 if $g<=$t;
1811		$b = 0 if $b<=$t;
1812		#$r = 0 if $r < $m;
1813		#$g = 0 if $g < $m;
1814		#$b = 0 if $b < $m;
1815		#if($g<$m) {$g=0;}
1816		#elsif($r<$m) {$r=0;}
1817		#elsif($b<$m) {$b=0;}
1818		}
1819		} elsif(1) {
1820		$M /= 4.2; #4.2; # pas mal
1821		if($m<$M) {
1822		my($t) = $M;
1823		$r = 0 if $r<=$t;
1824		$g = 0 if $g<=$t;
1825		$b = 0 if $b<=$t;
1826		#$r = 0 if $r < $m;
1827		#$g = 0 if $g < $m;
1828		#$b = 0 if $b < $m;
1829		#if($g<$m) {$g=0;}
1830		#elsif($r<$m) {$r=0;}
1831		#elsif($b<$m) {$b=0;}
1832		}
1833		} elsif(0) {
1834		my($n) = $r;
1835		$n = $g if $g<$n;
1836		$n = $b if $b<$n;
1837		if($n<$m/8) {
1838		$r = 0 if $r <= $n*2;
1839		$g = 0 if $g <= $n*2;
1840		$b = 0 if $b <= $n*2;
1841		}
1842		}
1843		push(@t, ((($b<<10)\|$g)<<10)\|$r);
1844		}
1845		}
1846
1847		if(1) {
1848		# on elimine les composantes plus faibles que 10% du max
1849		@r = @t; @t = ();
1850		for($i=0; $i<=$#r; $i+=8) {
1851		my($maxr, $maxv, $maxb) = (0, 0, 0);
1852		my($minr, $minv, $minb) = (1, 1, 1);
1853		my($rgb, @rgb);
1854		my(@o) = @r[$i..$i+7];
1855		for $rgb (@o) {
1856		@rgb = &irgb2rgb($rgb);
1857		$maxr = $rgb[0] if $rgb[0] > $maxr;
1858		$maxv = $rgb[1] if $rgb[1] > $maxv;
1859		$maxb = $rgb[2] if $rgb[2] > $maxb;
1860		$minr = $rgb[0] if $rgb[0] < $minr;
1861		$minv = $rgb[1] if $rgb[1] < $minv;
1862		$minb = $rgb[2] if $rgb[2] < $minb;
1863		}
1864		$maxr = (1-$thr)$minr + $thr$maxr;
1865		$maxv = (1-$thr)$minv + $thr$maxv;
1866		$maxb = (1-$thr)$minb + $thr$maxb;
1867		for $rgb (@o) {
1868		@rgb = &irgb2rgb($rgb);
1869		$rgb[0] = $minr if $rgb[0] < $maxr;
1870		$rgb[1] = $minv if $rgb[1] < $maxv;
1871		$rgb[2] = $minb if $rgb[2] < $maxb;
1872		#$rgb[0] = $maxr if $rgb[0] > $maxr;
1873		#$rgb[1] = $maxv if $rgb[1] > $maxv;
1874		#$rgb[2] = $maxb if $rgb[2] > $maxb;
1875		$t = int($rgb[0]*255)&0x1ff; $t<<=10;
1876		$t += int($rgb[1]*255)&0x1ff; $t<<=10;
1877		$t += int($rgb[2]*255)&0x1ff;
1878		push(@t, $t);
1879		}
1880		}
1881		}
1882
1883		if(0) {
1884		my($min, $max) = (32,128);
1885		my($mi2) = $min>>1;
1886		my($p, $x, $y);
1887		for($p=$y=0; $y<200; ++$y) {
1888		for($x=0; $x<320; ++$x) {
1889		$p = 320*$y+$x;
1890		my($rvb) = $t[$p];
1891		my($r) = ($rvb>>00) & 0x1FF;
1892		my($g) = ($rvb>>10) & 0x1FF;
1893		my($b) = ($rvb>>20) & 0x1FF;
1894		$r=0 if $r&0x100;
1895		$g=0 if $g&0x100;
1896		$b=0 if $b&0x100;
1897		my($m) = $r; $m = $g if $g>$m; $m = $b if $b>$m; $m=$max+1;
1898		$r = ($r<$mi2 ? 0:$min) if $r<$min && $m>$max;
1899		$g = ($g<$mi2 ? 0:$min) if $g<$min && $m>$max;
1900		$b = ($b<$mi2 ? 0:$min) if $b<$min && $m>$max;
1901		$t[$p] = ((($b<<10)\|$g)<<10)\|$r;
1902		$rvb = &irgb_sub($rvb, $t[$p]);
1903		#print " /_\\ = ", &irgb2hex($rvb), "\n";
1904		$t[$p + 319] = &irgb_add_cln($t[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x>0;
1905		$t[$p + 320] = &irgb_add_cln($t[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
1906		$t[$p + 321] = &irgb_add_cln($t[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x<319;
1907		$t[$p + 001] = &irgb_add_cln($t[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 && $x<319;
1908		}
1909		}
1910		}
1911
1912		&write_image("zzz.png", @t);
1913
1914		return @t;
1915		}
1916
1917		sub couple6 {
1918		my(@octet) = @_;
1919
1920		my($dbg) = 0;
1921
1922		my($i, $im, $j, $jm, $d, $dm, $rgb, %cpt);
1923		my(@px) = (@octet);
1924
1925		# dither de l'octet
1926		for($i=0; $i<8; ++$i) {
1927		$rgb = $px[$i];
1928		for($dm=1e30, $jm=$j=0; $j<$glb_maxcol; ++$j) {
1929		$d = &irgb_dist($glb_pal[$j], $rgb);
1930		#print "$j => $d :: $jm\n";
1931		if($d<$dm) {$dm = $d; $jm = $j;}
1932		}
1933		++$cpt{$jm};
1934		$px[$i+1] = &irgb_add_cln($px[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$jm]), \@glb_map3)) if $i<7;
1935		}
1936
1937		my(@cpt) = (sort { $cpt{$b} - $cpt{$a} } keys %cpt);
1938
1939		if($dbg) {
1940		print "\n\n";
1941		for $t (@octet) {
1942		print &irgb2hex($t), " ";
1943		}
1944		print "\n\n";
1945		for $t (@cpt) {
1946		print &irgb2hex($glb_pal[$t]), " ", $cpt{$t}, "\n";
1947		}
1948		}
1949
1950		# 1 ou 2 couls utilisées: pas de probs
1951		if($#cpt<=1) {
1952		print " ";
1953		# on s'assure qu'on en a au moins 2
1954		$cpt{$cpt[1] = 0} = 0 if $#cpt==0;
1955
1956		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
1957		}
1958
1959		# les 2 couls principales couvrent 7 pixels sur les 8
1960		if($cpt{$cpt[0]} + $cpt{$cpt[1]} >= 6) {
1961		print ".";
1962		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
1963		}
1964
1965		#return (0x0ff3fcff,0);
1966
1967		if(0) {
1968		# on fusionne les couleurs voisines
1969		$rgb = 0x0c0300c0;
1970		for($i=$#cpt; $i>=0; --$i) {
1971		for($j=$i-1; $j>=0; --$j) {
1972		if(($rgb & $glb_pal[$cpt[$i]]) == ($rgb & $glb_pal[$cpt[$j]])) {
1973		$cpt{$cpt[$j]} += $cpt{$cpt[$i]};
1974		delete $cpt{$cpt[$i]}; print "*";
1975		@cpt = (@cpt[0..$i-1], @cpt[$i+1..$#cpt]);
1976		last;
1977		}
1978		}
1979		}
1980
1981		@cpt = (sort { $cpt{$b} - $cpt{$a} } keys %cpt);
1982
1983		# 1 ou 2 couls utilisées: pas de probs
1984		if($#cpt<=1) {
1985		print "_";
1986		# on s'assure qu'on en a au moins 2
1987		$cpt{$cpt[1] = 0} = 0 if $#cpt==0;
1988
1989		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
1990		}
1991
1992		# les 2 couls principales couvrent 7 pixels sur les 8
1993		if($cpt{$cpt[0]} + $cpt{$cpt[1]} >= 7) {
1994		print ":";
1995		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
1996		}
1997		}
1998
1999		# si la 1ere couvre 4 pixels, alors on prends la 2eme qui fait le moins d'err
2000		if($cpt{$cpt[0]} >= 6) {
2001		$jm = $cpt[0];
2002		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
2003		next if $i==$jm;
2004		#next unless defined $cpt{$i};
2005		$delta = 0;
2006		$d = 0; @px = (@octet);
2007		if(0) {
2008		foreach $j (@px) {$d += $glb_dist[$i*$glb_maxcol + $j] if $j!=$jm;}
2009		} elsif(0) {
2010		for($j = 0; $j<8 && $d<$dm; ++$j) {$d += &couple2_dist_sq($i, $jm, $octet[$j]);}
2011		} else {
2012		for($j = 0; $j<8 && $d<$dm; ++$j) {
2013		$d1 = &irgb_dist($glb_pal[$i ], $px[$j]);
2014		$d2 = &irgb_dist($glb_pal[$jm], $px[$j]);
2015		if($d1 < $d2) {$d += &sq($d1); $rgb = $glb_pal[$i];} else {$d += &sq($d2); $rgb = $glb_pal[$jm];}
2016		$px[$j+1] = &irgb_add_cln($px[$j+1], &irgb_map(&irgb_sub($px[$j], $rgb), \@glb_map3)) if $glb_err3 && $j<7;
2017		}
2018		#$d += &irgb_module($delta);
2019		}
2020		if($d < $dm) {$dm = $d; $im = $i;}
2021		}
2022		print "o";
2023		return ($glb_pal[$im], $glb_pal[$jm]);
2024		}
2025
2026		# TODO: prendre les couleurs les moins utilisées.. reduire leur résolution et voir si on peut les mapper
2027		# sur l'une des couleurs plus utilisée
2028
2029		# fusionner les couleurs les plus proches: seuil = 1/16 au début, puis 1/8 après
2030
2031		if(0) {
2032		# reduire la resolution de la palette de 0..255 à 0..7 pour merger les couleurs proches
2033		%cpt = (); @px = @octet; $msk = 0x0e0380e0;
2034		for($i=0; $i<8; ++$i) {
2035		$rgb = $px[$i] & $msk;
2036		for($dm=1e30, $jm=$j=0; $j<$glb_maxcol; ++$j) {
2037		$d = &irgb_dist($glb_pal[$j] & $msk, $rgb);
2038		if($d<$dm) {$dm = $d; $jm = $j;}
2039		}
2040		++$cpt{$px[$i] = $jm};
2041		$px[$i+1] = &irgb_uadd($px[$i+1], &irgb_map(&irgb_sub($rgb, $glb_pal[$jm] & $msk), \@glb_map3)) if $glb_err3 && $i<7;
2042		}
2043		@cpt = (sort { $cpt{$b} - $cpt{$a} } keys %cpt);
2044
2045		if($#cpt<=1) {
2046		# on s'assure qu'on en a au moins 2
2047		$cpt{$cpt[1] = 0} = 0 if $#cpt==0;
2048		print "_";
2049		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
2050		}
2051
2052		# les 2 couls principales couvrent 7 pixels sur les 8 (plus strict)
2053		if($cpt{$cpt[0]} + $cpt{$cpt[1]} >= 7) {
2054		print ":";
2055		return ($glb_pal[$cpt[1]], $glb_pal[$cpt[0]]);
2056		}
2057		}
2058
2059		if(0) {
2060		# utilisation de rayons
2061		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
2062		for($j=0; $j<$glb_maxcol; ++$j) {
2063		@px = @octet; $d = 0; $ir = $jr = 0;
2064		for($k = 0; $k<8 && $d<$dm; ++$k) {
2065
2066		$di = &irgb_dist($glb_pal[$i], $px[$k]);
2067		$dj = &irgb_dist($glb_pal[$j], $px[$k]);
2068		if($di <= $dj) {
2069		$ir = $di if $di>$ir;
2070		$rgb = $glb_pal[$i];
2071		} else {
2072		$jr = $dj if $dj>$jr;
2073		$rgb = $glb_pal[$j];
2074		}
2075		$d = $ir + $jr;
2076		$px[$i+1] = &irgb_uadd($px[$i+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $i<7;
2077		}
2078		if($d < $dm) {$dm = $d; $im = $i; $jm = $j}
2079		}
2080		}
2081		print "#";
2082		return ($glb_pal[$im], $glb_pal[$jm]);
2083		}
2084
2085		# sinon tester tous les couple avec dither
2086		my($r, $rm);
2087		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
2088		#next unless defined $cpt{$i};
2089		for($j=0; $j<$i; ++$j) {
2090		next unless defined $cpt{$j};
2091		@px = (@octet);
2092		#print $i,",",$j, "##", &irgb2hex($glb_pal[$i])," ",&irgb2hex($glb_pal[$j]),"\n";
2093		#for($k=0; $k<8; ++$k) {print " ", &irgb2hex($px[$k]);} print "\n";
2094		for($r = $d = $k = 0; $k<8 && $d<$dm; ++$k) {
2095		$di = &irgb_dist($glb_pal[$i], $px[$k]);
2096		$dj = &irgb_dist($glb_pal[$j], $px[$k]);
2097		if($di <= $dj) {
2098		$r \|= 1;
2099		$rgb = $glb_pal[$i];
2100		$d += &sq($di);
2101		} else {
2102		$r \|= 2;
2103		$rgb = $glb_pal[$j];
2104		$d += &sq($dj);
2105		}
2106		#print $k,"->", &irgb2hex($octet[$k]), ":", &irgb2hex($rgb),"=",$d,"\n";
2107		$px[$k+1] = &irgb_add_cln($px[$k+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $k<7;
2108		}
2109		#print "DDDDD ",irgb2hex($delta),"\n";
2110		#$d += &irgb_module($delta);
2111		#print $i,",",$j, "==", &irgb2hex($glb_pal[$i])," ",&irgb2hex($glb_pal[$j])," == ",$d," (",$dm,")\n";
2112		if($d < $dm) {$rm = $r; $dm = $d; $im = $i; $jm = $j}
2113		}
2114		}
2115
2116		if($rm == 3) {
2117		print "#";
2118		#print "==> ", $im, ",", $jm, " ",&irgb2hex($glb_pal[$im])," ",&irgb2hex($glb_pal[$jm]),"\n";
2119		return ($glb_pal[$im], $glb_pal[$jm]);
2120		}
2121
2122		# si en fait on a qu'une seule couleur reele (parce que la palette
2123		# n'est pas assez discriminante par exemple), alors on prend la couleur
2124		# la plus frequente, et on cherche la coul realisant la plus petite erreur
2125		if($rm != 3) {
2126		$jm = $cpt[0];
2127		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
2128		next if $i==$jm;
2129		@px = (@octet);
2130		for($d = $j = 0; $j<8 && $d<$dm; ++$j) {
2131		$d1 = &irgb_dist($glb_pal[$i ], $px[$j]);
2132		$d2 = &irgb_dist($glb_pal[$jm], $px[$j]);
2133		if($d1<$d2) {$rgb = $glb_pal[$i]; $d += &sq($d1);} else {$rgb = $glb_pal[$jm]; $d += &sq($d2);}
2134		$px[$j+1] = &irgb_add_cln($px[$j+1], &irgb_map(&irgb_sub($px[$j], $rgb), \@glb_map3)) if $glb_err3 && $j<7;
2135		}
2136		if($d < $dm) {$dm = $d; $im = $i;}
2137		}
2138		#print $cpt{$cpt[0]}," $dm\n";
2139		return ($glb_pal[$im], $glb_pal[$jm]);
2140		}
2141
2142
2143		if(0) {
2144		print "#$dm\n";
2145
2146		### on vérifie que le couple est bien utilisé
2147		@px = (@octet); $r = 0;
2148		for($k = 0; $k<8; ++$k) {
2149		$di = &irgb_dist($glb_pal[$im], $px[$k]);
2150		$dj = &irgb_dist($glb_pal[$jm], $px[$k]);
2151		if($di <= $dj) {
2152		$rgb = $glb_pal[$im];
2153		$r \|= 1;
2154		} else {
2155		$rgb = $glb_pal[$jm];
2156		$r \|= 2;
2157		}
2158		$px[$k+1] = &irgb_add_cln($px[$k+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $k<7;
2159		}
2160
2161		if($r!=3) {
2162		print "\n\n";
2163		for($dm=1e30, $i=0; $i<$glb_maxcol; ++$i) {
2164		for($j=0; $j<=$i; ++$j) {
2165		@px = (@octet);
2166		for($d = $k = 0; $k<8 && $d<$dm; ++$k) {
2167		$di = &irgb_dist($glb_pal[$i], $px[$k]);
2168		$dj = &irgb_dist($glb_pal[$j], $px[$k]);
2169		if($di <= $dj) {
2170		$d += &sq($di);
2171		$rgb = $glb_pal[$i];
2172		} else {
2173		$d += &sq($dj);
2174		$rgb = $glb_pal[$j];
2175		}
2176		$px[$k+1] = &irgb_add_cln($px[$k+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $k<7;
2177		}
2178		print "$i,$j ==> $d\n";
2179		if($d < $dm) {print "^^^\n"; $dm = $d; $im = $i; $jm = $j}
2180		}
2181		}
2182		print "\n\n";
2183		@px = (@octet); $r = 0;
2184		for($d = $k = 0; $k<8; ++$k) {
2185		$di = &irgb_dist($glb_pal[$im], $px[$k]);
2186		$dj = &irgb_dist($glb_pal[$jm], $px[$k]);
2187		if($di <= $dj) {
2188		$d += $di;
2189		$rgb = $glb_pal[$im];
2190		$r \|= 1;
2191		} else {
2192		$rgb = $glb_pal[$jm];
2193		$r \|= 2;
2194		}
2195		print &irgb2hex($px[$k]),"=>$di,$dj=>",&irgb2hex($rgb),"\n";
2196		$px[$k+1] = &irgb_add_cln($px[$k+1], &irgb_map(&irgb_sub($px[$k], $rgb), \@glb_map3)) if $glb_err3 && $k<7;
2197		}
2198		die;
2199		}
2200		}
2201
2202		print "#";
2203		return ($glb_pal[$im], $glb_pal[$jm]);
2204		}
2205
2206		sub sq {
2207		return $_[0]*$_[0];
2208		}
2209
2210		sub xint {
2211		if(0) {
2212		# round to even?
2213		my($t) = @_;
2214		# round to even
2215		my($halfway) = int($t2)==$t2;
2216		if($t>=0) {$t = int($t + 0.5);} else {$t = int($t - 0.5);}
2217		if($halfway) {$t = int($t/2)*2;}
2218		return $t;
2219		}
2220
2221		return int($_[0]);
2222		return int(0.5 + $_[0]) if $_[0]>=0;
2223		return - int(0.5 - $_[0]);
2224		}
2225
2226		sub write_map {
2227		my($name, $ram_ab, @px) = @_;
2228
2229		my($i, $t);
2230
2231		# récupération de la palette RGB
2232		my(%pal);
2233		foreach $i (@px) {++$pal{$i};}
2234		#my(@t) = (sort { $pal{$b} - $pal{$a} } keys %pal);
2235		my(@t) = (sort { &irgb_module($a) - &irgb_module($b) } keys %pal);
2236		die "trop de couleurs" if $#t>15;
2237		@t = (@t, (0) x 15)[0..15];
2238
2239		# pour le tour on utilise la couleur la plus sombre
2240		@t = ($t[0], $t[15], @t[1..14]);
2241		my($tour) = 0;
2242		for($i=0; $i<15; ++$i) {
2243		$tour = $i if &irgb_module($t[$i])<&irgb_module($t[$tour]);
2244		}
2245
2246		# pour que l'afficheur de préhisto marche, il faut que le tour soit
2247		# d'indexe fixe. On fait en sorte que ce soit toujours 0
2248		if($tour != 0) {
2249		my($t) = $t[$tour];
2250		$t[$tour] = $t[0];
2251		$t[0] = $t;
2252		$tour = 0;
2253		}
2254
2255		# conversion de la palette vers les intensités thomson
2256		my(@pal, %rgb2pal);
2257		if($glb_to7pal) {
2258		@t = &to770_palette;
2259		for($i=0; $i<=$#t; ++$i) {$rgb2pal{$t[$i]} = $i;}
2260		} elsif($#map_ef>=0) {
2261		foreach $i (@t) {
2262		$rgb2pal{$i} = ($#pal + 1)>>1;
2263
2264		#print &irgb2hex($i),":";
2265		my($v, $j, $d, $m, $p);
2266
2267		$v = $i & 255; $i>>=10; #print "$v ";
2268		for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
2269		$d = $ef_vals[$j] - $v; $d = -$d if $d<0;
2270		if($d<$m) {$m = $d; $p = $j;}
2271		}
2272		my($b) = $p;
2273		$v = $i & 255; $i>>=10; #print "$v ";
2274		for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
2275		$d = $ef_vals[$j] - $v; $d = -$d if $d<0;
2276		if($d<$m) {$m = $d; $p = $j;}
2277		}
2278		my($g) = $p;
2279		$v = $i & 255; $i>>=10; #print "$v ";
2280		for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
2281		$d = $ef_vals[$j] - $v; $d = -$d if $d<0;
2282		if($d<$m) {$m = $d; $p = $j;}
2283		}
2284		my($r) = $p;
2285
2286		push(@pal, $b, $g*16 + $r);
2287		#print sprintf("%x%x%x,", $b,$g,$r);
2288		}
2289		} else {
2290		foreach $i (@t) {
2291		$rgb2pal{$i} = ($#pal + 1)>>1;
2292
2293		my($r, $g, $b) = &irgb2rgb($i);
2294		push(@pal, int($b15), int($g15)16 + int($r15));
2295		}
2296		}
2297		@t = ();
2298
2299		# construction rama / ramb
2300		my(@rama, @ramb); $white = &rgb2irgb(1,1,1);
2301		my($idx, @cols) = (0) x 81;
2302		for($i=0; $i<$#px; $i += 8) {
2303		my(@octet) = @px[$i..($i+7)];
2304		# on trouve les deux couleurs
2305		my(%col) = ();
2306		foreach $t (@octet) {$col{$t} = 1;}
2307		@t = keys %col;
2308		die "trop de couleur pour l'octet" if $#t>1;
2309
2310		# cas special pour la neige
2311		@t = ($white,0) if $#t==0 && $t[0]==$white;
2312		@t = ($white,$t[0]) if $#t==0;
2313
2314		# 1 seule couleur.. on essaye de récuperer les couleurs de la ligne d'avant si possible
2315		if($#t==0) {
2316		if($t[0] == $cols[$idx]) {
2317		$t[1] = $cols[$idx+1];
2318		} elsif($t[0] == $cols[$idx+1]) {
2319		$t[1] = $cols[$idx];
2320		} else {
2321		$t[1] = 7;
2322		}
2323		}
2324
2325		@cols[$idx..$idx+1] = @t;
2326		$idx=0 if ($idx+=2)==80;
2327
2328		my($forme, $fond) = ($t[0], $t[1]);
2329
2330		%col = ();
2331		# pour l'instant
2332		$t = 0;
2333		for($j=0; $j<8; ++$j) {
2334		$t += (128>>$j) if $octet[$j]!=$fond;
2335		}
2336
2337		$forme = $rgb2pal{$forme};
2338		$fond = $rgb2pal{$fond};
2339		# pour favoriser les répétitions en ramb, on fait $forme>=$fond
2340		if($forme >= $fond) {
2341		push(@rama, $t);
2342		push(@ramb, ($forme * 8 + ($fond&7) + ($fond & 8)*16) ^ (128+64));
2343		} else {
2344		push(@rama, $t^255);
2345		push(@ramb, ($fond * 8 + ($forme&7) + ($forme & 8)*16) ^ (128+64));
2346		}
2347		}
2348
2349		# compression à proprement parler
2350		my(@data);
2351		push(@data,
2352		# bm 40
2353		0,
2354		# ncols-1
2355		39,
2356		# nlines-1
2357		24);
2358		push(@data,
2359		# ram a
2360		&to7_comp(@rama),
2361		0, 0) if $ram_ab & 1;
2362		push(@data,
2363		# ram b
2364		&to7_comp(@ramb),
2365		0, 0) if $ram_ab & 2;
2366
2367		# if faut aligner l'extension sur une addr paire
2368		push(@data, 0) unless $#data & 1;
2369
2370		push(@data,
2371		# to-snap
2372		0, 0, 0, $tour, 0, 0, @pal, 0xa5, 0x5a) unless $glb_to7pal;
2373
2374		# ecriture fichier binaire
2375		open(OUT, ">$name");
2376		print OUT pack('C*', 0, int((1+$#data)/256), (1+$#data)&255, 0, 0);
2377		print OUT pack('C*', @data);
2378		print OUT pack('C*', 255, 0, 0, 0, 0);
2379		close(OUT);
2380		}
2381
2382		sub to7_comp {
2383		my(@data) = @_;
2384		my(@result, @partial);
2385
2386		for(my $p=0; $p<8000; ++$p) {
2387		# on lit car num fois
2388		my($num, $car) = (1, $data[($p % 200)*40 + int($p/200)]);
2389		while($num<255 && $p+1<8000 && $data[(($p+1) % 200)*40 + int(($p+1)/200)]==$car) {++$p; ++$num;}
2390		my($default) = 1;
2391		if($#partial>$[) {
2392		# 01 aa 01 bb ==> 00 02 aa bb
2393		if($default && $num==1 && $partial[0]==1) {@partial = (00, 02, $partial[1], $car); $default = 0;}
2394		# 00 n xx xx xx 01 bb ==> 00 n+1 xx xx xx bb
2395		if($default && $num==1 && $partial[0]==0 && $partial[1]<255) {push(@partial, $car); $partial[1]++; $default = 0;}
2396		# 00 n xx xx xx 02 bb ==> 00 n+2 xx xx xx bb bb (pas utile mais sert quand combiné à la regle ci-dessus)
2397		if($default && $num==2 && $partial[0]==0 && $partial[1]<254) {push(@partial, $car, $car); $partial[1]+=2; $default = 0;}
2398		# 01 aa 02 bb ==> 00 03 aa bb bb
2399		}
2400		if($default) {push(@result, @partial); @partial = ($num, $car);}
2401		}
2402		push(@result, @partial);
2403
2404		return @result;
2405		}
2406
2407		sub wd_file {
2408		return ".watchdog";
2409		}
2410
2411		sub reset_wd {
2412		unlink &wd_file;
2413		}
2414
2415		sub start_wd {
2416		my($pause) = 300;
2417		my($child) = fork;
2418		die "fork failed" unless defined $child;
2419		return unless $child;
2420		while(1) {
2421		sleep($pause);
2422		my($f) = &wd_file;
2423		if(-f $f) {
2424		&reset_wd;
2425		kill 9, $child;
2426		die "Watch dog detected inactivity for $pause sec, exiting";
2427		} else {
2428		open(WDFILE,">$f");close(WDFILE);
2429		}
2430		}
2431		}

Public Pastes

🤑 G2A.com Free Gift Card Guide May 2024 FIX 🤑
GetText | 2 min ago | 0.39 KB
Assignment 3 Coding Form 2
C# | 2 min ago | 2.01 KB
Assignment 3 Coding Form 1
C# | 3 min ago | 5.62 KB
Untitled
JavaScript | 15 min ago | 1.17 KB
gg
C++ | 17 min ago | 6.45 KB
MC Plus installer
Lua | 44 min ago | 24.41 KB
_parse_scene.py as of 2024-05-16
Python | 1 hour ago | 13.75 KB
_compile_scene.py as of 2024-05-16
Python | 1 hour ago | 14.51 KB