API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 17th, 2015
129
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 10.28 KB | None | 0 0
raw download clone embed print report diff
  1. #/bin/perl
  2. #
  3. # tst_bm16.pl - Pbairefvba ivqrb ra tvs 15 pbhyf 160k200. [ROT13]
  4. #
  5. # par Samuel DEVULDER, Sept 2015.
  6. #
  7.  
  8. if(0) {
  9.     # pour trouver les niveaux equi-repartis
  10.     &init_magick;
  11.  
  12.     my(@px);
  13.     for my $c (0, 100, 127, 142, 163, 179, 191, 203, 215, 223, 231, 239, 243, 247, 251, 255) {push(@px,$c,$c,$c);}
  14.     my $img=&px2img(16,1, @px);
  15.     my @p1 = $img->GetPixels(height=>1,normalize=>"True");
  16.     $img->Set(colorspace=>$LINEAR_SPACE);
  17.     my @p2 = $img->GetPixels(height=>1,normalize=>"True");
  18.     for my $i (0..15) {
  19.         print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",2*$p2[$i*3]," ",255*$p2[$i*3]," ", 2*$p2[$i*3],"\n";
  20.     }
  21.     for my $i (0..15) {
  22.         print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",3*$p2[$i*3]," ",255*$p2[$i*3]," ", 3*$p2[$i*3],"\n";
  23.     }
  24.    
  25.     # 0 163 215 255
  26.     # 0 191 255
  27.  
  28.     exit;
  29. }
  30.  
  31. # parametres
  32. ($w, $h) = (160, 100);
  33. $fps     = 10;
  34. $dither  = "vac4"; #"bayer4";
  35. $zigzag  = 1;
  36. $satur   = 140;
  37. $max     = 245;
  38.  
  39. # fichier entree
  40. $file    = $ARGV[0];
  41. $name    = $file;
  42. $file =~ s/\.[^\.]*$/.gif/;
  43. mkdir "out";
  44. $file =~ s/^.*[\/]/out\//;
  45. exit if -e $file;
  46. print "\n$name\n";
  47.  
  48. # dossier temporaire
  49. mkdir "tmp";
  50. unlink(<tmp/img*.bmp>);
  51.  
  52. open(OUT,"| ./ffmpeg -i - -v 0 -r $fps -s ${w}x${h} -an tmp/img%05d.bmp");
  53. open(IN, "<$name");
  54. binmode(OUT);
  55. binmode(IN);
  56.  
  57. open(OUT2,"| ./ffmpeg -i - -v 0 -r 1 -s ${w}x${h} -an tmp/img%05d.bmp");
  58. open(IN2, "<$name");
  59. binmode(OUT2);
  60. binmode(IN2);
  61.  
  62. &init_magick;
  63.  
  64. $gif = Image::Magick->new(size=>($w*2)."x".($h*2));
  65.  
  66. @mat = ([1]) if $dither eq "checker";
  67. @mat = ([1,3],
  68.         [4,2]) if $dither eq "bayer2";
  69. @mat = ([7,8,2],
  70.         [6,9,4],
  71.         [3,5,1]) if $dither eq "sam3";
  72. @mat = ([3,7,4],
  73.         [6,1,9],
  74.         [2,8,5]) if $dither eq "3x3";
  75. @mat = ([6, 9, 7, 12],
  76.         [14, 3, 15, 1],
  77.         [8, 11, 5, 10],
  78.         [16, 2, 13, 4]) if $dither eq "vac4";
  79. @mat = ([1,9,3,11],
  80.         [13,5,15,7],
  81.         [4,12,2,10],
  82.         [16,8,14,6]) if $dither eq "bayer4";
  83. @mat = ([21,2,16,11,6],
  84.         [9,23,5,18,14],
  85.         [19,12,7,24,1],
  86.         [22,3,17,13,8],
  87.         [15,10,25,4,20]) if $dither eq "vac5";
  88. @mat = ([35,57,19,55,7,51,4,21],
  89.         [29,6,41,27,37,17,59,45],
  90.         [61,15,53,12,62,25,33,9],
  91.         [23,39,31,49,2,47,13,43],
  92.         [3,52,8,22,36,58,20,56],
  93.         [38,18,60,46,30,5,42,28],
  94.         [63,26,34,11,64,16,54,10],
  95.         [14,48,1,44,24,40,32,50]) if $dither eq "vac8";
  96.  
  97. $mat_x = 1+$#mat;
  98. $mat_y = 1+$#{$mat[0]};
  99. for my $a (@mat) {for my $b (@$a) {$b /= $mat_x*$mat_y+1.0;}}
  100.  
  101. @teo_pal = (0,100,127,142,163,179,191,203,215,223,231,239,243,247,251,255);
  102. @lin_pal = (0, 33, 54, 69, 93,115,133,152,173,188,204,220,229,237,246,255);
  103. #($MID31, $MID21, $MID32) = (4,6,8);
  104. #($MID31, $MID21, $MID32) = (2,4,8);
  105. #($MID31, $MID21, $MID32) = (1,3,5);
  106.  
  107. if(1) {
  108.     my @pc2teo = ();
  109.     for my $i (1..$#teo_pal) {
  110.         my($a,$b,$c) = ($teo_pal[$i-1],($teo_pal[$i-1]+$teo_pal[$i])>>1,$teo_pal[$i]);
  111.         for my $j ($a..$b)   {$pc2teo[$j] = $i-1;}
  112.         for my $j ($b+1..$c) {$pc2teo[$j] = $i;}
  113.     }
  114.    
  115.     my @tabR = (0)x16;
  116.     my @tabG = (0)x16;
  117.     my @tabB = (0)x16;
  118.     $time = 1;
  119.     my $run = 1;
  120.     while(1) {
  121.         my $name = sprintf("tmp/img%05d.bmp", $time);
  122.         $expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
  123.         if($expected_size != -s $name) {
  124.             last unless $run;
  125.             my $buf;
  126.             my $read = read(IN2,$buf,4096);
  127.             if($read) {
  128.                 syswrite OUT2, $buf, $read;
  129.             } else {
  130.                 $run = 0;
  131.                 close(OUT2);
  132.             }
  133.         } else  {
  134.             # image complete!
  135.             print STDERR $time++,"s\r";
  136.        
  137.             # lecture de l'image
  138.             my $img = Image::Magick->new();
  139.             my $x = $img->Read($name); die "$x, stopped $!" if $x;
  140.             unlink $name;
  141.  
  142.             # on force la saturation (140%) pour avoir des couleurs plus franches
  143.             $img->Modulate(saturation=>$satur);
  144.             $img->Evaluate(operator=>'Multiply', value=>255/$max);
  145.  
  146.                
  147.             if(!defined $pal4096) {
  148.                 my @px;
  149.                 for my $r (0..15) {
  150.                     for my $g (0..15) {
  151.                         for my $b (0..15) {
  152.                             push(@px, $teo_pal[$r], $teo_pal[$g], $teo_pal[$b]);
  153.                         }
  154.                     }
  155.                 }
  156.                 $pal4096 = &px2img(256,16, @px);   
  157.             }
  158.             $img->Remap(image=>$pal4096, dither=>"true", "dither-method"=>"Floyd-Steinberg");
  159.        
  160.             # trammage
  161.             my @px = $img->GetPixels(height=>$h, normalize=>"True");
  162.             undef $img;
  163.             for(my $i=0; $i<$#px; $i+=3) {
  164.                 ++$tabR[$pc2teo[int($px[$i+0]*255)]];
  165.                 ++$tabG[$pc2teo[int($px[$i+1]*255)]];
  166.                 ++$tabB[$pc2teo[int($px[$i+2]*255)]];
  167.             }  
  168.         }
  169.     }
  170.     close(IN2);close(OUT2);
  171.    
  172.    
  173.     # for my $i (0..15) {
  174.         # print $tab1[$i],"  ",$tab2[$i],"\n";
  175.     # }
  176.     # 0 a b 15
  177.     # 0  c  15
  178.     my($tot,$acc);
  179.    
  180.     $tot = $acc = 0;
  181.     for my $t (@tabR) {$tot += $t;}
  182.     for(my $i=0; $i<16; ++$i) {
  183.         $acc += $tabR[$i];
  184.         if($acc>=$tot*.02) {
  185.             $RED0 = $i;
  186.             last;
  187.         }
  188.     }
  189.     for(my $i=$RED0+1; $i<16; ++$i) {
  190.         $acc += $tabR[$i];
  191.         if($acc>=$tot*.33) {
  192.             $RED1 = $i;
  193.             last;
  194.         }
  195.     }
  196.     for(my $i=$RED1+1; $i<16; ++$i) {
  197.         $acc += $tabR[$i];
  198.         if($acc>=$tot*.66) {
  199.             $RED2 = $i;
  200.             last;
  201.         }
  202.     }
  203.     for(my $i=$RED2+1; $i<16; ++$i) {
  204.         $acc += $tabR[$i];
  205.         if($acc>=$tot*.98) {
  206.             $RED3 = $i;
  207.             last;
  208.         }
  209.     }
  210.  
  211.     $tot = $acc = 0;
  212.     for my $t (@tabG) {$tot += $t;}
  213.     for(my $i=0; $i<16; ++$i) {
  214.         $acc += $tabG[$i];
  215.         if($acc>=$tot*.02) {
  216.             $GRN0 = $i;
  217.             last;
  218.         }
  219.     }
  220.     for(my $i=$GRN0+1; $i<16; ++$i) {
  221.         $acc += $tabG[$i];
  222.         if($acc>=$tot*.33) {
  223.             $GRN1 = $i;
  224.             last;
  225.         }
  226.     }
  227.     for(my $i=$GRN1+1; $i<16; ++$i) {
  228.         $acc += $tabG[$i];
  229.         if($acc>=$tot*.66) {
  230.             $GRN2 = $i;
  231.             last;
  232.         }
  233.     }
  234.     for(my $i=$GRN2+1; $i<16; ++$i) {
  235.         $acc += $tabG[$i];
  236.         if($acc>=$tot*.98) {
  237.             $GRN3 = $i;
  238.             last;
  239.         }
  240.     }
  241.    
  242.     $tot = $acc = 0;
  243.     for my $t (@tabB) {$tot += $t;}
  244.     for(my $i=0; $i<16; ++$i) {
  245.         $acc += $tabB[$i];
  246.         if($acc>=$tot*.02) {
  247.             $BLU0 = $i;
  248.             last;
  249.         }
  250.     }
  251.     for(my $i=$BLU0+1; $i<16; ++$i) {
  252.         $acc += $tabB[$i];
  253.         if($acc>=$tot*.5) {
  254.             $BLU1 = $i;
  255.             last;
  256.         }
  257.     }
  258.     for(my $i=$BLU1+1; $i<16; ++$i) {
  259.         $acc += $tabB[$i];
  260.         if($acc>=$tot*.98) {
  261.             $BLU2 = $i;
  262.             last;
  263.         }
  264.     }
  265.    
  266.     my $print = sub {
  267.         my($pfx, @t) = @_;
  268.         my($max, $tot) = (0,0);
  269.         for my $v (@t) {$max = $v if $v>$max;$tot += $v;}
  270.         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)));}
  271.     };
  272.     $print->("RED", @tabR);
  273.     print "$RED0 $RED1 $RED2 $RED3\n"; 
  274.  
  275.     $print->("GRN", @tabG);
  276.     print "$GRN0 $GRN1 $GRN2 $GRN3\n"; 
  277.  
  278.     $print->("BLU", @tabB);
  279.     print "$BLU0 $BLU1 $BLU2\n";   
  280.  
  281.     unlink(<tmp/img*.bmp>);
  282. }
  283.  
  284.  
  285. $dR = sub {
  286.     my($v, $d,$a,$b) = @_;
  287.    
  288.     ($a,$b) = ($lin_pal[$RED2],$lin_pal[$RED3]);
  289.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED3] : $teo_pal[$RED2] if $v>=$a;
  290.    
  291.     ($a,$b) = ($lin_pal[$RED1],$a);
  292.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED2] : $teo_pal[$RED1] if $v>=$a;
  293.    
  294.     ($a,$b) = ($lin_pal[$RED0],$a);
  295.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$RED1] : $teo_pal[$RED0];
  296. };
  297. $dG = sub {
  298.     my($v, $d,$a,$b) = @_;
  299.    
  300.     ($a,$b) = ($lin_pal[$GRN2],$lin_pal[$GRN3]);
  301.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN3] : $teo_pal[$GRN2] if $v>=$a;
  302.    
  303.     ($a,$b) = ($lin_pal[$GRN1],$a);
  304.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN2] : $teo_pal[$GRN1] if $v>=$a;
  305.    
  306.     ($a,$b) = ($lin_pal[$GRN0],$a);
  307.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$GRN1] : $teo_pal[$GRN0];
  308. };
  309. $dB = sub {
  310.     my($v, $d,$a,$b) = @_;
  311.    
  312.     ($a,$b) = ($lin_pal[$BLU1],$lin_pal[$BLU2]);
  313.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$BLU2] : $teo_pal[$BLU1] if $v>=$a;
  314.    
  315.     ($a,$b) = ($lin_pal[$BLU0],$a);
  316.     return ($v-$a)/($b-$a)>=$d ? $teo_pal[$BLU1] : $teo_pal[$BLU0];
  317. };
  318.  
  319. $cpt = 1;$run = 1;
  320. while(1) {
  321.     $name = sprintf("tmp/img%05d.bmp", $cpt);
  322.    
  323.     $expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
  324.     if($expected_size != -s $name) {
  325.         last unless $run;
  326.         my $buf;
  327.         my $read = read(IN,$buf,65536);
  328.         if($read) {
  329.             syswrite OUT, $buf, $read;
  330.         } else {
  331.             $run = 0;
  332.             close(OUT);
  333.         }
  334.        
  335.     } else  {
  336.         # image complete!
  337.         print STDERR int($cpt++/$fps),"s (",int(100*($cpt-2)/($fps*$time)),"%)\r";
  338.         sleep(5) if ($cpt%500)==0; # on fait une pause régulière pour ne pas surchauffer le processeur
  339.        
  340.         # lecture de l'image
  341.         my $img = Image::Magick->new();
  342.         $img->Read($name);
  343.         unlink $name;
  344.         $img->Set(colorspace=>$LINEAR_SPACE);
  345.        
  346.         # on force la saturation (140%) pour avoir des couleurs plus franches
  347.         $img->Modulate(saturation=>$satur);
  348.         $img->Evaluate(operator=>'Multiply', value=>255/$max);
  349.        
  350.         # trammage
  351.         my @px = $img->GetPixels(height=>$h, normalize=>"True");
  352.         undef $img;
  353.         for my $c (@px) {$c = int($c*255);}
  354.        
  355.         # dither
  356.         my @im = (0,0,0)x($w*$h*4);
  357.         for my $y (0..$h-1) {
  358.             for my $x (0..$w-1) {
  359.                 my(@p) = splice(@px, 0, 3);
  360.                 my($d) = $mat[$x%$mat_x][$y%$mat_y];
  361.                 my($p) = ($y*$w*2 + $x)*6;
  362.                
  363.                 @p = ($dR->($p[0],$d),$dG->($p[1],$d),$dB->($p[2],$d));
  364.                
  365.                 if($zigzag & $x) {
  366.                     @im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
  367.                     $p += $w*6;
  368.                     @im[($p+1,$p+4)]   = @p[(1,1)];
  369.                 } else {
  370.                     @im[($p+1,$p+4)]   = @p[(1,1)];
  371.                     $p += $w*6;
  372.                     @im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
  373.                 }
  374.             }
  375.         }
  376.         $img = &px2img($w*2,$h*2, @im);
  377.         $img->Write("tmp/toto.png");
  378.        
  379.         # ajout de l'image au gif animé
  380.         $img->Set(dispose=>"None");
  381.         $img->Set(delay=>int(100/$fps));
  382.         push(@$gif, $img);
  383.         undef $img;
  384.        
  385.         # pas plus de 3000 imgs (5mins)
  386.         last if $cpt==3000 || !$run;
  387.     }
  388. }
  389. close(IN);
  390. close(OUT);
  391.  
  392. # ecriture du fichier gif
  393. $gif->Set(dispose=>"None");
  394. $gif->Set(Layers=>"optimize-trans");
  395. $gif->Set(delay=>int(100/$fps));
  396. $gif->Write($file);
  397.  
  398. sub init_magick {
  399.     eval 'use Image::Magick;';
  400.    
  401.     # determination de l'espace RGB lineaire
  402.     my $img = Image::Magick->new(size=>"256x1", depth=>16);
  403.     $img->Read('gradient:black-white');
  404.     $img->Set(colorspace=>'RGB');
  405.     #$img->Set(colorspace=>"Gray") unless $coul;
  406.     my @px1 = $img->GetPixel(x=>128, y=>0);
  407.     $img->Read('gradient:black-white');
  408.     $img->Set(colorspace=>'sRGB');
  409.     #$img->Set(colorspace=>"Gray") unless $coul;
  410.     my @px2 = $img->GetPixel(x=>128, y=>0);
  411.     my $d1 = $px1[0]-0.5; $d1=-$d1 if $d1<0;
  412.     my $d2 = $px2[0]-0.5; $d2=-$d2 if $d2<0;
  413.     $LINEAR_SPACE = $d1>=$d2 ? "RGB" : "sRGB";
  414.     #print $px1[0], "   ",$px2[0],"    $LINEAR_SPACE\n";
  415. }
  416.  
  417. sub px2img {
  418.     my($width,$height,@px) = @_;
  419.  
  420.     open(OUT_2,">/tmp/.toto2.pnm");
  421.     print OUT_2 "P6\n$width $height\n255\n",pack('C*', @px),"\n";
  422.     close(OUT_2);
  423.     my $img2 = Image::Magick->new();
  424.     $img2->ReadImage("/tmp/.toto2.pnm");
  425.     unlink "/tmp/.toto2.pnm";
  426.  
  427.     return $img2;
  428. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!