Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #/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 = "vac4"; #"bayer4";
- $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 "\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";
- @mat = ([3,7,4],
- [6,1,9],
- [2,8,5]) if $dither eq "3x3";
- @mat = ([6, 9, 7, 12],
- [14, 3, 15, 1],
- [8, 11, 5, 10],
- [16, 2, 13, 4]) if $dither eq "vac4";
- @mat = ([1,9,3,11],
- [13,5,15,7],
- [4,12,2,10],
- [16,8,14,6]) if $dither eq "bayer4";
- @mat = ([21,2,16,11,6],
- [9,23,5,18,14],
- [19,12,7,24,1],
- [22,3,17,13,8],
- [15,10,25,4,20]) if $dither eq "vac5";
- @mat = ([35,57,19,55,7,51,4,21],
- [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],
- [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;}}
- @teo_pal = (0,100,127,142,163,179,191,203,215,223,231,239,243,247,251,255);
- @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]);
- for my $j ($a..$b) {$pc2teo[$j] = $i-1;}
- for my $j ($b+1..$c) {$pc2teo[$j] = $i;}
- }
- 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 {
- # image complete!
- 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);
- 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");
- # trammage
- my @px = $img->GetPixels(height=>$h, normalize=>"True");
- undef $img;
- for(my $i=0; $i<$#px; $i+=3) {
- ++$tabR[$pc2teo[int($px[$i+0]*255)]];
- ++$tabG[$pc2teo[int($px[$i+1]*255)]];
- ++$tabB[$pc2teo[int($px[$i+2]*255)]];
- }
- }
- }
- close(IN2);close(OUT2);
- # for my $i (0..15) {
- # print $tab1[$i]," ",$tab2[$i],"\n";
- # }
- # 0 a b 15
- # 0 c 15
- my($tot,$acc);
- $tot = $acc = 0;
- for my $t (@tabR) {$tot += $t;}
- for(my $i=0; $i<16; ++$i) {
- $acc += $tabR[$i];
- if($acc>=$tot*.02) {
- $RED0 = $i;
- last;
- }
- }
- for(my $i=$RED0+1; $i<16; ++$i) {
- $acc += $tabR[$i];
- if($acc>=$tot*.33) {
- $RED1 = $i;
- last;
- }
- }
- for(my $i=$RED1+1; $i<16; ++$i) {
- $acc += $tabR[$i];
- if($acc>=$tot*.66) {
- $RED2 = $i;
- last;
- }
- }
- for(my $i=$RED2+1; $i<16; ++$i) {
- $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];
- 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;
- }
- }
- 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;
- }
- }
- 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];
- };
- $dB = sub {
- 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;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement