View difference between Paste ID: ZAuknzYw and bP4ftG4x

 #/bin/perl
 #
 # tst_bm16.pl - Pbairefvba ivqrb ra tvs 15 pbhyf 160k200. [ROT13]
 #
 # par Samuel DEVULDER, Sept 2015.
 #
 
 if(0) {
 	# pour trouver les niveaux equi-repartis
 	&init_magick;
 
 	my(@px);
 	for my $c (0, 100, 127, 142, 163, 179, 191, 203, 215, 223, 231, 239, 243, 247, 251, 255) {push(@px,$c,$c,$c);}
 	my $img=&px2img(16,1, @px);
 	my @p1 = $img->GetPixels(height=>1,normalize=>"True");
 	$img->Set(colorspace=>$LINEAR_SPACE);
 	my @p2 = $img->GetPixels(height=>1,normalize=>"True");
 	for my $i (0..15) {
 		print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",2*$p2[$i*3]," ",255*$p2[$i*3]," ", 2*$p2[$i*3],"\n";
 	}
 	for my $i (0..15) {
 		print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",3*$p2[$i*3]," ",255*$p2[$i*3]," ", 3*$p2[$i*3],"\n";
 	}
 
 	# 0 163 215 255
 	# 0 191 255
 
 	exit;
 }
 
 # parametres
 ($w, $h) = (160, 100);
 $fps     = 10;
-$dither  = "vac8"; #"bayer4";
+$dither  = "vac4"; #"bayer4";
-$zigzag  = 0;
+$zigzag  = 1;
 $satur   = 140;
 $max     = 245;
 
 # fichier entree
 $file    = $ARGV[0];
 $name    = $file;
 $file =~ s/\.[^\.]*$/.gif/;
 mkdir "out";
 $file =~ s/^.*[\/]/out\//;
 exit if -e $file;
-print "$name\n";
+print "\n$name\n";
 
 # dossier temporaire
 mkdir "tmp";
 unlink(<tmp/img*.bmp>);
 
 open(OUT,"| ./ffmpeg -i - -v 0 -r $fps -s ${w}x${h} -an tmp/img%05d.bmp");
 open(IN, "<$name");
 binmode(OUT);
 binmode(IN);
 
 open(OUT2,"| ./ffmpeg -i - -v 0 -r 1 -s ${w}x${h} -an tmp/img%05d.bmp");
 open(IN2, "<$name");
 binmode(OUT2);
 binmode(IN2);
 
 &init_magick;
 
 $gif = Image::Magick->new(size=>($w*2)."x".($h*2));
 
 @mat = ([1]) if $dither eq "checker";
 @mat = ([1,3],
         [4,2]) if $dither eq "bayer2";
 @mat = ([7,8,2],
         [6,9,4],
-	[3,5,1]) if $dither eq "sam3";
+        [3,5,1]) if $dither eq "sam3";
 @mat = ([3,7,4],
         [6,1,9],
-	[2,8,5]) if $dither eq "3x3";
+        [2,8,5]) if $dither eq "3x3";
 @mat = ([6, 9, 7, 12],
         [14, 3, 15, 1],
-	[4,12,2,10],
+        [8, 11, 5, 10],
-	[16,8,14,6]) if $dither eq "bayer4";
+        [16, 2, 13, 4]) if $dither eq "vac4";
 @mat = ([1,9,3,11],
-	[9,23,5,18,14],
+
         [4,12,2,10],
         [16,8,14,6]) if $dither eq "bayer4";
 @mat = ([21,2,16,11,6],
         [9,23,5,18,14],
-	[29,6,41,27,37,17,59,45],
+
-	[61,15,53,12,62,25,33,9],
+
-	[23,39,31,49,2,47,13,43],
+
-	[3,52,8,22,36,58,20,56],
+
-	[38,18,60,46,30,5,42,28],
+        [29,6,41,27,37,17,59,45],
-	[63,26,34,11,64,16,54,10],
+        [61,15,53,12,62,25,33,9],
-	[14,48,1,44,24,40,32,50]) if $dither eq "vac8";
+        [23,39,31,49,2,47,13,43],
         [3,52,8,22,36,58,20,56],
         [38,18,60,46,30,5,42,28],
         [63,26,34,11,64,16,54,10],
         [14,48,1,44,24,40,32,50]) if $dither eq "vac8";
 
 $mat_x = 1+$#mat;
 $mat_y = 1+$#{$mat[0]};
 for my $a (@mat) {for my $b (@$a) {$b /= $mat_x*$mat_y+1.0;}}
 
-($MID31, $MID21, $MID32) = (1,3,5);
+
 @lin_pal = (0, 33, 54, 69, 93,115,133,152,173,188,204,220,229,237,246,255);
 #($MID31, $MID21, $MID32) = (4,6,8);
 #($MID31, $MID21, $MID32) = (2,4,8);
 #($MID31, $MID21, $MID32) = (1,3,5);
 
 if(1) {
 	my @pc2teo = ();
 	for my $i (1..$#teo_pal) {
 		my($a,$b,$c) = ($teo_pal[$i-1],($teo_pal[$i-1]+$teo_pal[$i])>>1,$teo_pal[$i]);
-	my @tab1 = (0)x16;
+
-	my @tab2 = (0)x16;
+
 	}
 
 	my @tabR = (0)x16;
 	my @tabG = (0)x16;
 	my @tabB = (0)x16;
 	$time = 1;
 	my $run = 1;
 	while(1) {
 		my $name = sprintf("tmp/img%05d.bmp", $time);
 		$expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
 		if($expected_size != -s $name) {
 			last unless $run;
 			my $buf;
 			my $read = read(IN2,$buf,4096);
 			if($read) {
 				syswrite OUT2, $buf, $read;
 			} else {
 				$run = 0;
 				close(OUT2);
 			}
 		} else  {
-			$img->Read($name);
+
 			print STDERR $time++,"s\r";
-
+
 			# lecture de l'image
 			my $img = Image::Magick->new();
 			my $x = $img->Read($name); die "$x, stopped $!" if $x;
 			unlink $name;
 
 			# on force la saturation (140%) pour avoir des couleurs plus franches
 			$img->Modulate(saturation=>$satur);
 			$img->Evaluate(operator=>'Multiply', value=>255/$max);
-				++$tab1[$pc2teo[int($px[$i]*255)]];
+
-				++$tab1[$pc2teo[int($px[$i+1]*255)]];
+
-				++$tab2[$pc2teo[int($px[$i+2]*255)]];
+			if(!defined $pal4096) {
 				my @px;
 				for my $r (0..15) {
 					for my $g (0..15) {
 						for my $b (0..15) {
 							push(@px, $teo_pal[$r], $teo_pal[$g], $teo_pal[$b]);
 						}
 					}
 				}
 				$pal4096 = &px2img(256,16, @px);
 			}
 			$img->Remap(image=>$pal4096, dither=>"true", "dither-method"=>"Floyd-Steinberg");
-	$tot = -$tab1[0]-$tab1[15];
+
-	$acc = 0;
+
-	for my $t (@tab1) {$tot += $t;}
+
-	for(my $i=1; $i<16; ++$i) {
+
-		$acc += $tab1[$i];
+
-		if($acc*3>=$tot) {
+				++$tabR[$pc2teo[int($px[$i+0]*255)]];
-			$MID31 = $i;
+				++$tabG[$pc2teo[int($px[$i+1]*255)]];
 				++$tabB[$pc2teo[int($px[$i+2]*255)]];
 			}
 		}
-	for(my $i=$MID31+1; $i<16; ++$i) {
+
-		$acc += $tab1[$i];
+
-		if($acc*3>=$tot*2) {
+
-			$MID32 = $i;
+
 	# for my $i (0..15) {
 		# print $tab1[$i],"  ",$tab2[$i],"\n";
 	# }
-	$tot = -$tab2[0]-$tab2[15];
+
-	$acc = 0;
+
-	for my $t (@tab2) {$tot += $t;}
+
-	for(my $i=1; $i<16; ++$i) {
+
-		$acc += $tab2[$i];
+	$tot = $acc = 0;
-		if($acc*2>=$tot) {
+	for my $t (@tabR) {$tot += $t;}
-			$MID21 = $i;
+	for(my $i=0; $i<16; ++$i) {
 		$acc += $tabR[$i];
 		if($acc>=$tot*.02) {
 			$RED0 = $i;
-	print "$MID31 $MID21 $MID32\n";
+
 		}
 	}
 	for(my $i=$RED0+1; $i<16; ++$i) {
 		$acc += $tabR[$i];
 		if($acc>=$tot*.33) {
-$d4 = sub {
+			$RED1 = $i;
-	my($v, $d) = @_;
+
-	my($a) = $lin_pal[$MID32];
+
-	return ($v-$a)/(255-$a)>=$d ? 255 : $teo_pal[$MID32] if $v>=$a;
+
-	my($b) = $lin_pal[$MID31];
+	for(my $i=$RED1+1; $i<16; ++$i) {
-	return ($v-$b)/($a-$b)>=$d ? $teo_pal[$MID32] : $teo_pal[$MID31] if $v>=$b;
+		$acc += $tabR[$i];
-	return $v/$b>=$d ? $teo_pal[$MID31] : 0;
+		if($acc>=$tot*.66) {
 			$RED2 = $i;
-$d3 = sub {
+
-	my($v, $d) = @_;
+
-	my($a) = $lin_pal[$MID21];
+
-	return ($v-$a)/(255-$a)>=$d ? 255 : $teo_pal[$MID21] if $v>=$a;
+	for(my $i=$RED2+1; $i<16; ++$i) {
-	return $v/$a>=$d ? $teo_pal[$MID21] : 0;
+		$acc += $tabR[$i];
-};
+		if($acc>=$tot*.98) {
 			$RED3 = $i;
 			last;
 		}
 	}
 
 	$tot = $acc = 0;
 	for my $t (@tabG) {$tot += $t;}
 	for(my $i=0; $i<16; ++$i) {
 		$acc += $tabG[$i];
-		my $read = read(IN,$buf,4096);
+		if($acc>=$tot*.02) {
 			$GRN0 = $i;
 			last;
 		}
 	}
 	for(my $i=$GRN0+1; $i<16; ++$i) {
 		$acc += $tabG[$i];
 		if($acc>=$tot*.33) {
 			$GRN1 = $i;
 			last;
 		}
-		sleep(5) if ($cpt%100)==0; # on fait une pause régulière pour ne pas surchauffer le processeur
+
 	for(my $i=$GRN1+1; $i<16; ++$i) {
 		$acc += $tabG[$i];
 		if($acc>=$tot*.66) {
 			$GRN2 = $i;
 			last;
 		}
 	}
 	for(my $i=$GRN2+1; $i<16; ++$i) {
 		$acc += $tabG[$i];
 		if($acc>=$tot*.98) {
 			$GRN3 = $i;
 			last;
 		}
 	}
 
 	$tot = $acc = 0;
 	for my $t (@tabB) {$tot += $t;}
 	for(my $i=0; $i<16; ++$i) {
 		$acc += $tabB[$i];
 		if($acc>=$tot*.02) {
 			$BLU0 = $i;
 			last;
 		}
 	}
-				@p = ($d4->($p[0],$d),$d4->($p[1],$d),$d3->($p[2],$d));
+	for(my $i=$BLU0+1; $i<16; ++$i) {
 		$acc += $tabB[$i];
 		if($acc>=$tot*.5) {
 			$BLU1 = $i;
 			last;
 		}
 	}
 	for(my $i=$BLU1+1; $i<16; ++$i) {
 		$acc += $tabB[$i];
 		if($acc>=$tot*.98) {
 			$BLU2 = $i;
 			last;
 		}
 	}
 
 	my $print = sub {
 		my($pfx, @t) = @_;
 		my($max, $tot) = (0,0);
 		for my $v (@t) {$max = $v if $v>$max;$tot += $v;}
 		for my $i (0..$#t) {print sprintf("%s%2d:%3d%% %s\n", $pfx, $i, int(100*$t[$i]/$tot), "X"x(int(50*$t[$i]/$max)));}
 	};
 	$print->("RED", @tabR);
 	print "$RED0 $RED1 $RED2 $RED3\n";
 
 	$print->("GRN", @tabG);
 	print "$GRN0 $GRN1 $GRN2 $GRN3\n";
 
 	$print->("BLU", @tabB);
 	print "$BLU0 $BLU1 $BLU2\n";
 
 	unlink(<tmp/img*.bmp>);
 }
 
 
 $dR = sub {
 	my($v, $d,$a,$b) = @_;
 
 	($a,$b) = ($lin_pal[$RED2],$lin_pal[$RED3]);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED3] : $teo_pal[$RED2] if $v>=$a;
 
 	($a,$b) = ($lin_pal[$RED1],$a);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED2] : $teo_pal[$RED1] if $v>=$a;
 
 	($a,$b) = ($lin_pal[$RED0],$a);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED1] : $teo_pal[$RED0];
 };
 $dG = sub {
 	my($v, $d,$a,$b) = @_;
 
 	($a,$b) = ($lin_pal[$GRN2],$lin_pal[$GRN3]);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN3] : $teo_pal[$GRN2] if $v>=$a;
 
 	($a,$b) = ($lin_pal[$GRN1],$a);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN2] : $teo_pal[$GRN1] if $v>=$a;
 
 	($a,$b) = ($lin_pal[$GRN0],$a);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN1] : $teo_pal[$GRN0];
-	open(OUT2,">/tmp/.toto2.pnm");
+
-	print OUT2 "P6\n$width $height\n255\n",pack('C*', @px),"\n";
+$dB = sub {
-	close(OUT2);
+	my($v, $d,$a,$b) = @_;
 
 	($a,$b) = ($lin_pal[$BLU1],$lin_pal[$BLU2]);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$BLU2] : $teo_pal[$BLU1] if $v>=$a;
 
 	($a,$b) = ($lin_pal[$BLU0],$a);
 	return ($v-$a)/($b-$a)>=$d ? $teo_pal[$BLU1] : $teo_pal[$BLU0];
 };
 
 $cpt = 1;$run = 1;
 while(1) {
 	$name = sprintf("tmp/img%05d.bmp", $cpt);
 
 	$expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
 	if($expected_size != -s $name) {
 		last unless $run;
 		my $buf;
 		my $read = read(IN,$buf,65536);
 		if($read) {
 			syswrite OUT, $buf, $read;
 		} else {
 			$run = 0;
 			close(OUT);
 		}
 
 	} else  {
 		# image complete!
 		print STDERR int($cpt++/$fps),"s (",int(100*($cpt-2)/($fps*$time)),"%)\r";
 		sleep(5) if ($cpt%500)==0; # on fait une pause régulière pour ne pas surchauffer le processeur
 
 		# lecture de l'image
 		my $img = Image::Magick->new();
 		$img->Read($name);
 		unlink $name;
 		$img->Set(colorspace=>$LINEAR_SPACE);
 
 		# on force la saturation (140%) pour avoir des couleurs plus franches
 		$img->Modulate(saturation=>$satur);
 		$img->Evaluate(operator=>'Multiply', value=>255/$max);
 
 		# trammage
 		my @px = $img->GetPixels(height=>$h, normalize=>"True");
 		undef $img;
 		for my $c (@px) {$c = int($c*255);}
 
 		# dither
 		my @im = (0,0,0)x($w*$h*4);
 		for my $y (0..$h-1) {
 			for my $x (0..$w-1) {
 				my(@p) = splice(@px, 0, 3);
 				my($d) = $mat[$x%$mat_x][$y%$mat_y];
 				my($p) = ($y*$w*2 + $x)*6;
 
 				@p = ($dR->($p[0],$d),$dG->($p[1],$d),$dB->($p[2],$d));
 
 				if($zigzag & $x) {
 					@im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
 					$p += $w*6;
 					@im[($p+1,$p+4)]   = @p[(1,1)];
 				} else {
 					@im[($p+1,$p+4)]   = @p[(1,1)];
 					$p += $w*6;
 					@im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
 				}
 			}
 		}
 		$img = &px2img($w*2,$h*2, @im);
 		$img->Write("tmp/toto.png");
 
 		# ajout de l'image au gif animé
 		$img->Set(dispose=>"None");
 		$img->Set(delay=>int(100/$fps));
 		push(@$gif, $img);
 		undef $img;
 
 		# pas plus de 3000 imgs (5mins)
 		last if $cpt==3000 || !$run;
 	}
 }
 close(IN);
 close(OUT);
 
 # ecriture du fichier gif
 $gif->Set(dispose=>"None");
 $gif->Set(Layers=>"optimize-trans");
 $gif->Set(delay=>int(100/$fps));
 $gif->Write($file);
 
 sub init_magick {
 	eval 'use Image::Magick;';
 
 	# determination de l'espace RGB lineaire
 	my $img = Image::Magick->new(size=>"256x1", depth=>16);
 	$img->Read('gradient:black-white');
 	$img->Set(colorspace=>'RGB');
 	#$img->Set(colorspace=>"Gray") unless $coul;
 	my @px1 = $img->GetPixel(x=>128, y=>0);
 	$img->Read('gradient:black-white');
 	$img->Set(colorspace=>'sRGB');
 	#$img->Set(colorspace=>"Gray") unless $coul;
 	my @px2 = $img->GetPixel(x=>128, y=>0);
 	my $d1 = $px1[0]-0.5; $d1=-$d1 if $d1<0;
 	my $d2 = $px2[0]-0.5; $d2=-$d2 if $d2<0;
 	$LINEAR_SPACE = $d1>=$d2 ? "RGB" : "sRGB";
 	#print $px1[0], "   ",$px2[0],"    $LINEAR_SPACE\n";
 }
 
 sub px2img {
 	my($width,$height,@px) = @_;
 
 	open(OUT_2,">/tmp/.toto2.pnm");
 	print OUT_2 "P6\n$width $height\n255\n",pack('C*', @px),"\n";
 	close(OUT_2);
 	my $img2 = Image::Magick->new();
 	$img2->ReadImage("/tmp/.toto2.pnm");
 	unlink "/tmp/.toto2.pnm";
 
 	return $img2;
 }