Guest User

Conversion d'image TrueColor en mode 4 couleurs

a guest
Mar 17th, 2014
202
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #/bin/perl
  2. # Reduction d'image true color à 4 couleurs spécialement adaptées
  3. # au format BM4 Thomson.
  4. #
  5. # Usage: perl convBM4.pl [-h] [<option>] [<fichiers>]
  6. #
  7. # -h affiche l'aide. Si aucun fichier n'est présent, ils seront
  8. # lus depuis l'entrée standard.
  9. #
  10. # (c) Samuel DEVULDER, Mars 2014
  11. #
  12.  
  13. #use Graphics::Magick;
  14. use Image::Magick;
  15.  
  16. $SIG{'INT'} = 'DEFAULT';
  17. $SIG{'CHLD'} = 'IGNORE';
  18.  
  19. # suppression du buffer pour l'affichage en sortie
  20. #$| = 1;
  21.  
  22. # vars globales
  23. $glb_width  = 320;
  24. $glb_height = 200;
  25. $glb_resize = 0;  # resize toujours ?
  26. $glb_gamma  = 2.2;
  27. $glb_outdir = "rgb";
  28. $glb_num    = 8;
  29. $glb_black  = 0;
  30. $glb_blur   = 1;
  31. $glb_ext    = "gif";
  32. $glb_overw  = 0;
  33. $glb_satur  = 130;
  34. $glb_dither = undef;
  35. @glb_pal    = (0x000000, 0x0000FF, 0x00FF00, 0x00FFFF,
  36.                0xFF0000, 0xFF00FF, 0xFFFF00, 0xFFFFFF,
  37.            0x777777, 0x3333AA, 0x33AA33, 0x33AAAA,
  38.            0xAA3333, 0xAA33AA, 0xEEEE77, 0x0077BB);
  39. @glb_files  =();
  40.  
  41. # parsing des arguments
  42. &parse_args(@ARGV);
  43.  
  44. # si aucun fichier, alors on les prends depuis l'entrée standard
  45. if(!@glb_files) {
  46.     print "No file found, reading from STDIN...";
  47.     while(<STDIN>) {
  48.         chomp;
  49.         y%\\%/%;
  50.         s%^([\S]):%/cygdrive/$1%;
  51.         push(@glb_files, $_);
  52.     }
  53.     print "done\n";
  54. }
  55.  
  56. # creation dossier de sortie
  57. mkdir($glb_outdir) || die "$glb_outdir: $!" unless -d $glb_outdir;
  58.  
  59. # generation de toutes les combinaisons de couleurs
  60. @glb_pals = &generate_pals($glb_num);
  61.  
  62. # traitement
  63. $pause_durat = 10;    # duree des pauses
  64. $pause_delay = int(100*$pause_durat/10);  # une pause de 10% du temps
  65. $next_pause  = time + $pause_delay;
  66. for my $i (0..$#glb_files) {
  67.     my $file = $glb_files[$i];
  68.     print 1+$i,"/",1+$#glb_files," ",$file,"\n";
  69.  
  70.     my $out = $file;
  71.     $out =~ s/.*[\\\/]//;
  72.     $out =~ s/[\.][^\.]*//;
  73.     $out = "$glb_outdir/$out.$glb_ext";
  74.     next if !$glb_overw && -f $out;
  75.    
  76.     my $conv = &convert($file);
  77.     next unless $conv;
  78.    
  79.     $conv->Write($out);
  80.     undef $conv;
  81.    
  82.     # on laisse du temps au processeur pour se refroidir
  83.     my($t) = time;
  84.     if($t > $next_pause) {
  85.         $next_pause = $t + $pause_delay;
  86.         sleep($pause_durat);
  87.     }
  88. }
  89.  
  90. exit 0;
  91.  
  92. sub convert_ordered {
  93.     my($file) = @_;
  94.    
  95.     my $src = &read_image($file); return unless $src;
  96.     my $blr = $src->Clone();
  97.     $blr->Blur(size=>$glb_blur);
  98.    
  99.     $src->OrderedDither($glb_dither);
  100.    
  101.     my ($best, $best_err) = (0, 1e38);
  102.     &perc(-1);
  103.     for my $ip (0..$#glb_pals) {
  104.         &perc((1+$ip)/(1+$#glb_pals));
  105.        
  106.         # construction palette
  107.         my $map = Image::Magick->new(size=>"4x1");
  108.         $map->ReadImage('canvas:white');
  109.         my @pal = ($glb_pals[$ip]>>12, ($glb_pals[$ip]>>8)&15, ($glb_pals[$ip]>>4)&15, $glb_pals[$ip]&15);
  110.         for my $j (0..3) {
  111.             my($t) = $glb_pal[$pal[$j]];
  112.             my(@px) = (($t>>16)&255, ($t>>8)&255, ($t>>0)&255);
  113.             $map->SetPixel(x=>$j,y=>0,color=>\@px);
  114.         }
  115.         $map->Gamma(gamma=>1/$glb_gamma);
  116.        
  117.         # dithering avec la palette courante
  118.         my $img = $src->Clone();
  119.         $img->Remap(image=>$map, 'dither-method'=>'none'); 
  120.         undef $map;
  121.        
  122.         # floutage
  123.         $map = $img->Clone();
  124.         $map->Blur(sigma=>$glb_blur);
  125.        
  126.         # calcul d'erreur
  127.         my $diff = $map->Compare(image=>$blr, metric=>"rmse");
  128.         my($err) = $diff->Get('error');
  129.         undef $diff; undef $map;
  130.        
  131.         # meilleur?
  132.         if($err < $best_err) {
  133.             $best_err = $err;
  134.             $best = $img->Clone();
  135.         }
  136.        
  137.         # nettoyage
  138.         undef $img;
  139.     }
  140.     undef $src;
  141.     undef $blr;
  142.  
  143.     # retour au gamma PC
  144.     $best->Gamma(gamma=>$glb_gamma) if $best;
  145.    
  146.     &perc(2);
  147.    
  148.     return $best;
  149. }
  150.  
  151.  
  152. sub convert {
  153.     my($file) = @_;
  154.    
  155.     return &convert_ordered($file) if $glb_dither;
  156.    
  157.     my $src = &read_image($file); return unless $src;
  158.     my $blr = $src->Clone();
  159.     $blr->Blur(size=>$glb_blur);
  160.    
  161.     my ($best, $best_err) = (0, 1e38);
  162.     &perc(-1);
  163.     for my $ip (0..$#glb_pals) {
  164.         &perc((1+$ip)/(1+$#glb_pals));
  165.        
  166.         # construction palette
  167.         my $map = Image::Magick->new(size=>"4x1");
  168.         $map->ReadImage('canvas:white');
  169.         my @pal = ($glb_pals[$ip]>>12, ($glb_pals[$ip]>>8)&15, ($glb_pals[$ip]>>4)&15, $glb_pals[$ip]&15);
  170.         for my $j (0..3) {
  171.             my($t) = $glb_pal[$pal[$j]];
  172.             my(@px) = (($t>>16)&255, ($t>>8)&255, ($t>>0)&255);
  173.             $map->SetPixel(x=>$j,y=>0,color=>\@px);
  174.         }
  175.         $map->Gamma(gamma=>1/$glb_gamma);
  176.        
  177.         # dithering avec la palette courante
  178.         my $img = $src->Clone();
  179.         $img->Remap(image=>$map, 'dither-method'=>'Floyd-Steinberg');  
  180.         undef $map;
  181.        
  182.         # floutage
  183.         $map = $img->Clone();
  184.         $map->Blur(sigma=>$glb_blur);
  185.        
  186.         # calcul d'erreur
  187.         my $diff = $map->Compare(image=>$blr, metric=>"rmse");
  188.         my($err) = $diff->Get('error');
  189.         undef $diff; undef $map;
  190.        
  191.         # meilleur?
  192.         if($err < $best_err) {
  193.             $best_err = $err;
  194.             $best = $img->Clone();
  195.         }
  196.        
  197.         # nettoyage
  198.         undef $img;
  199.     }
  200.     undef $src;
  201.     undef $blr;
  202.  
  203.     # retour au gamma PC
  204.     $best->Gamma(gamma=>$glb_gamma) if $best;
  205.    
  206.     &perc(2);
  207.    
  208.     return $best;
  209. }
  210.  
  211. # lit une image
  212. sub read_image {
  213.     my($file) = @_;
  214.    
  215.     return 0 if $file=~ /\.txt/i;
  216.    
  217.     my $img = Image::Magick->new();
  218.     if($img->Read($file)) {undef $img; return 0;}
  219.    
  220.     if($#{$img}>=0) {
  221.         my($z) = $img->[0]->Clone();
  222.         for(my($i,$l) = (1,$#{$img}); $i<=$l; ++$i) {
  223.             my($d) = $img->[$i]->Get("delay");
  224.             $z->Composite(image=>$img->[$i], compose=>"Over",
  225.                       x=>$img->[$i]->Get("page.x"),
  226.                           y=>$img->[$i]->Get("page.y"));
  227.             $img->[$i] = $z->Clone();
  228.             $img->[$i]->Set(delay=>$d);
  229.         }
  230.         #$img->Write("toto.png");
  231.     }
  232.    
  233.     # conversion en gamma uniforme
  234.     $img->Set(depth=>16);
  235.     $img->Gamma(gamma=>1/$glb_gamma);
  236.    
  237.     $img->Enhance();
  238.     $img->Normalize(); #"0.1%,0.1%"); #
  239.     $img->Modulate(saturation=>$glb_satur);
  240.     $img->SigmoidalContrast(contrast=>2);
  241.    
  242.     my $width  = $img->Get('width');
  243.     my $height = $img->Get('height');
  244.    
  245.     # resize ?
  246.     $img->AdaptiveResize(geometry=>"${glb_width}x${glb_height}", filter=>"lanczos", blur=>1)
  247.         if($glb_resize || $width>$glb_width || $height>$glb_height);
  248.        
  249.     # on centre l'image autour d'un cadre noir
  250.     $img->Border(width=>$glb_width,height=>$glb_height,color=>"black");
  251.     $img->Set(gravity=>"Center");
  252.     $img->Crop(geometry=>"${glb_width}x${glb_height}!");
  253.     $img->Set(page=>"${glb_width}x${glb_height}+0+0");
  254.     $img->Resize(geometry=>"${glb_width}x${glb_height}!");
  255.    
  256.     #for(my $i=$#{$img}; --$i>=0;) {
  257.     #   my(@px) = ($i&1?0:255, $i&2?0:255, $i&4?0:255);
  258.     #   $img->[$i]->SetPixel(x=>0,y=>0,color=>\@px);
  259.     #}
  260.    
  261.     return $img;
  262. }
  263.  
  264. # genere toutes les combinaisons de palette
  265. sub generate_pals {
  266.     my($max) = @_;
  267.     my @pals = ();
  268.    
  269.     my $max2 = --$max;
  270.     $max2 = 7 if $max2>7;
  271.     for my $a (0..($glb_black?$max2:0)) {
  272.         for my $b ($a+1..$max2) {
  273.             for my $c ($b+1..$max2) {
  274.                 for my $d ($c+1..$max) {
  275.                     push(@pals, ($a<<12)|($b<<8)|($c<<4)|$d);
  276.                 }
  277.             }
  278.         }
  279.     }
  280.    
  281.     print 1+$#pals, " possible palettes\n";
  282.    
  283.     return @pals;
  284. }
  285.  
  286. # affiche une barre de progression
  287. sub perc {
  288.     my($perc) = @_;
  289.    
  290.     if($perc>0) {
  291.         my($z) = int($perc*100);
  292.         return if $z == $glb_perc_last;
  293.         $glb_perc_last = $z;
  294.     }
  295.    
  296.     my($t) = time;
  297.     if($perc<=0) {
  298.         $glb_perc_time = $t;
  299.     } elsif($perc>=1) {
  300.         $|=1;
  301.             print " " x length($glb_perc_txt), "\b" x length($glb_perc_txt);
  302.         $|=0;
  303.         undef $glb_perc_last;
  304.         undef $glb_perc_time;
  305.         undef $glb_perc_txt;
  306.     } elsif($t>$glb_perc_time+15) {
  307.         my($old) = length($glb_perc_txt);
  308.         $glb_perc_txt = sprintf("%3d%% (%ds rem)", $perc*100, int(($t-$glb_perc_time)*(1/$perc-1)));
  309.         my($end) = " " x ($old-length($glb_perc_txt));
  310.         $|=1;
  311.         print $glb_perc_txt, $end, "\b" x (length($glb_perc_txt) + length($end));
  312.         $|=0;
  313.     }
  314. }
  315.  
  316. # affiche l'usage
  317. sub usage {
  318.     print "Usage:\n";
  319.     print "   perl ",__FILE__;
  320.     print " [-o <outdir>] [-W <width>] [-H <height>] [-g <gamma>]";
  321.     print "\n\t"," " x length(__FILE__);
  322.     print " [-n <num cols>] [-blur <size>] [-resize] [-black]";
  323.     print "\n\t"," " x length(__FILE__);
  324.     print " [-overwrite] [-ext <bmp|png|...>] [-sat <saturation>]";
  325.     print "\n\t"," " x length(__FILE__);
  326.     print " [-dither <mode>] <file 1> <file 2> ...";
  327.     print "\n";
  328.     exit 0;
  329. }
  330.  
  331. # lit la ligne de commande
  332. sub parse_args {
  333.     my(@ARGS) = @_;
  334.    
  335.     my $prev = "";
  336.     foreach my $curr (@ARGS) {
  337.         push(@glb_files, $curr) if -f $curr;
  338.         &usage              if $curr eq "-h" || $curr eq "?";
  339.         $glb_resize = 1     if $curr eq "-resize";
  340.         $glb_black  = 1     if $curr eq "-black";
  341.         $glb_overw  = 1     if $curr eq "-overwrite";
  342.         @glb_pal    = eval("($curr)")
  343.                             if $prev eq "-p";
  344.         $glb_dither = $curr if $prev eq "-dither";
  345.         $glb_outdir = $curr if $prev eq "-o";
  346.         $glb_width  = $curr if $prev eq "-W";
  347.         $glb_height = $curr if $prev eq "-H";
  348.         $glb_gamma  = $curr if $prev eq "-g";
  349.         $glb_num    = $curr if $prev eq "-n";
  350.         $glb_satur  = $curr if $prev eq "-sat";
  351.         $glb_blur   = $curr if $prev eq "-blur";
  352.         $glb_ext    = $curr if $prev eq "-ext";
  353.         $prev = $curr;
  354.     }    
  355.    
  356.     $glb_dither = undef if $glb_dither eq "fs";
  357.  
  358.     print "Out directory : ",$glb_outdir,"\n";
  359.     print "Out extension : ",$glb_ext,"\n";
  360.     print "Width         : ",$glb_width,"\n";
  361.     print "Height        : ",$glb_height,"\n";
  362.     print "Gamma         : ",$glb_gamma,"\n";
  363.     print "Palette size  : ",$glb_num,"\n";
  364.     print "Resize        : ",$glb_resize?"yes":"no","\n";
  365.     print "Force black   : ",$glb_black?"no":"yes","\n";
  366.     print "Blur size     : ",$glb_blur,"\n";
  367.     print "Saturation    : ",$glb_satur,"\n";
  368.     print "Dither        : ",$glb_dither,"\n" if $glb_dither;
  369. }
RAW Paste Data