SHARE
TWEET

Conversion d'image TrueColor en mode 4 couleurs

a guest Mar 17th, 2014 194 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
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!
 
Top