API tools faq
paste
Advertisement
Guest User

Conversion image vers le format thomson 160x200

a guest
Aug 10th, 2014
363
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 56.46 KB | None | 0 0
raw download clone embed print report
  1. #/bin/perl
  2.  
  3. #use Graphics::Magick;
  4. use Image::Magick;
  5.  
  6. $SIG{'INT'} = 'DEFAULT';
  7. $SIG{'CHLD'} = 'IGNORE';
  8.  
  9. # suppression du buffer pour l'affichage en sortie
  10. #$| = 1;
  11.  
  12. # variables globale
  13. $glb_magick = Image::Magick->new;
  14. $glb_maxcol = 16;      # nb total de couls
  15. $glb_lab    = 0;       # distance couleur cielab
  16. $glb_dith   = 0;       # avec 3 ca donne des images pas mal colorées!
  17. $glb_gamma  = 2.20; #1/0.45;
  18. $glb_clean  = 0.2;
  19. $glb_extin  = 0.9;
  20. $glb_pause  = 15;
  21.    
  22. # error dispersion matrix. Index represents:
  23. #       X 0
  24. #     1 2    
  25. # 3 = 0 + 1 + 2
  26. @glb_ostro = (
  27.     13,     0,     5,    18,     # /*    0 */
  28.     13,     0,     5,    18,     # /*    1 */
  29.     21,     0,    10,    31,     # /*    2 */
  30.      7,     0,     4,    11,     # /*    3 */
  31.      8,     0,     5,    13,     # /*    4 */
  32.     47,     3,    28,    78,     # /*    5 */
  33.     23,     3,    13,    39,     # /*    6 */
  34.     15,     3,     8,    26,     # /*    7 */
  35.     22,     6,    11,    39,     # /*    8 */
  36.     43,    15,    20,    78,     # /*    9 */
  37.      7,     3,     3,    13,     # /*   10 */
  38.    501,   224,   211,   936,     # /*   11 */
  39.    249,   116,   103,   468,     # /*   12 */
  40.    165,    80,    67,   312,     # /*   13 */
  41.    123,    62,    49,   234,     # /*   14 */
  42.    489,   256,   191,   936,     # /*   15 */
  43.     81,    44,    31,   156,     # /*   16 */
  44.    483,   272,   181,   936,     # /*   17 */
  45.     60,    35,    22,   117,     # /*   18 */
  46.     53,    32,    19,   104,     # /*   19 */
  47.    237,   148,    83,   468,     # /*   20 */
  48.    471,   304,   161,   936,     # /*   21 */
  49.      3,     2,     1,     6,     # /*   22 */
  50.    459,   304,   161,   924,     # /*   23 */
  51.     38,    25,    14,    77,     # /*   24 */
  52.    453,   296,   175,   924,     # /*   25 */
  53.    225,   146,    91,   462,     # /*   26 */
  54.    149,    96,    63,   308,     # /*   27 */
  55.    111,    71,    49,   231,     # /*   28 */
  56.     63,    40,    29,   132,     # /*   29 */
  57.     73,    46,    35,   154,     # /*   30 */
  58.    435,   272,   217,   924,     # /*   31 */
  59.    108,    67,    56,   231,     # /*   32 */
  60.     13,     8,     7,    28,     # /*   33 */
  61.    213,   130,   119,   462,     # /*   34 */
  62.    423,   256,   245,   924,     # /*   35 */
  63.      5,     3,     3,    11,     # /*   36 */
  64.    281,   173,   162,   616,     # /*   37 */
  65.    141,    89,    78,   308,     # /*   38 */
  66.    283,   183,   150,   616,     # /*   39 */
  67.     71,    47,    36,   154,     # /*   40 */
  68.    285,   193,   138,   616,     # /*   41 */
  69.     13,     9,     6,    28,     # /*   42 */
  70.     41,    29,    18,    88,     # /*   43 */
  71.     36,    26,    15,    77,     # /*   44 */
  72.    289,   213,   114,   616,     # /*   45 */
  73.    145,   109,    54,   308,     # /*   46 */
  74.    291,   223,   102,   616,     # /*   47 */
  75.     73,    57,    24,   154,     # /*   48 */
  76.    293,   233,    90,   616,     # /*   49 */
  77.     21,    17,     6,    44,     # /*   50 */
  78.    295,   243,    78,   616,     # /*   51 */
  79.     37,    31,     9,    77,     # /*   52 */
  80.     27,    23,     6,    56,     # /*   53 */
  81.    149,   129,    30,   308,     # /*   54 */
  82.    299,   263,    54,   616,     # /*   55 */
  83.     75,    67,    12,   154,     # /*   56 */
  84.     43,    39,     6,    88,     # /*   57 */
  85.    151,   139,    18,   308,     # /*   58 */
  86.    303,   283,    30,   616,     # /*   59 */
  87.     38,    36,     3,    77,     # /*   60 */
  88.    305,   293,    18,   616,     # /*   61 */
  89.    153,   149,     6,   308,     # /*   62 */
  90.    307,   303,     6,   616,     # /*   63 */
  91.      1,     1,     0,     2,     # /*   64 */
  92.    101,   105,     2,   208,     # /*   65 */
  93.     49,    53,     2,   104,     # /*   66 */
  94.     95,   107,     6,   208,     # /*   67 */
  95.     23,    27,     2,    52,     # /*   68 */
  96.     89,   109,    10,   208,     # /*   69 */
  97.     43,    55,     6,   104,     # /*   70 */
  98.     83,   111,    14,   208,     # /*   71 */
  99.      5,     7,     1,    13,     # /*   72 */
  100.    172,   181,    37,   390,     # /*   73 */
  101.     97,    76,    22,   195,     # /*   74 */
  102.     72,    41,    17,   130,     # /*   75 */
  103.    119,    47,    29,   195,     # /*   76 */
  104.      4,     1,     1,     6,     # /*   77 */
  105.      4,     1,     1,     6,     # /*   78 */
  106.      4,     1,     1,     6,     # /*   79 */
  107.      4,     1,     1,     6,     # /*   80 */
  108.      4,     1,     1,     6,     # /*   81 */
  109.      4,     1,     1,     6,     # /*   82 */
  110.      4,     1,     1,     6,     # /*   83 */
  111.      4,     1,     1,     6,     # /*   84 */
  112.      4,     1,     1,     6,     # /*   85 */
  113.     65,    18,    17,   100,     # /*   86 */
  114.     95,    29,    26,   150,     # /*   87 */
  115.    185,    62,    53,   300,     # /*   88 */
  116.     30,    11,     9,    50,     # /*   89 */
  117.     35,    14,    11,    60,     # /*   90 */
  118.     85,    37,    28,   150,     # /*   91 */
  119.     55,    26,    19,   100,     # /*   92 */
  120.     80,    41,    29,   150,     # /*   93 */
  121.    155,    86,    59,   300,     # /*   94 */
  122.      5,     3,     2,    10,     # /*   95 */
  123.      5,     3,     2,    10,     # /*   96 */
  124.      5,     3,     2,    10,     # /*   97 */
  125.      5,     3,     2,    10,     # /*   98 */
  126.      5,     3,     2,    10,     # /*   99 */
  127.      5,     3,     2,    10,     # /*  100 */
  128.      5,     3,     2,    10,     # /*  101 */
  129.      5,     3,     2,    10,     # /*  102 */
  130.      5,     3,     2,    10,     # /*  103 */
  131.      5,     3,     2,    10,     # /*  104 */
  132.      5,     3,     2,    10,     # /*  105 */
  133.      5,     3,     2,    10,     # /*  106 */
  134.      5,     3,     2,    10,     # /*  107 */
  135.    305,   176,   119,   600,     # /*  108 */
  136.    155,    86,    59,   300,     # /*  109 */
  137.    105,    56,    39,   200,     # /*  110 */
  138.     80,    41,    29,   150,     # /*  111 */
  139.     65,    32,    23,   120,     # /*  112 */
  140.     55,    26,    19,   100,     # /*  113 */
  141.    335,   152,   113,   600,     # /*  114 */
  142.     85,    37,    28,   150,     # /*  115 */
  143.    115,    48,    37,   200,     # /*  116 */
  144.     35,    14,    11,    60,     # /*  117 */
  145.    355,   136,   109,   600,     # /*  118 */
  146.     30,    11,     9,    50,     # /*  119 */
  147.    365,   128,   107,   600,     # /*  120 */
  148.    185,    62,    53,   300,     # /*  121 */
  149.     25,     8,     7,    40,     # /*  122 */
  150.     95,    29,    26,   150,     # /*  123 */
  151.    385,   112,   103,   600,     # /*  124 */
  152.     65,    18,    17,   100,     # /*  125 */
  153.    395,   104,   101,   600,     # /*  126 */
  154.      4,     1,     1,     6,     # /*  127 */
  155.      4,     1,     1,     6,     # /*  128 */
  156.    395,   104,   101,   600,     # /*  129 */
  157.     65,    18,    17,   100,     # /*  130 */
  158.    385,   112,   103,   600,     # /*  131 */
  159.     95,    29,    26,   150,     # /*  132 */
  160.     25,     8,     7,    40,     # /*  133 */
  161.    185,    62,    53,   300,     # /*  134 */
  162.    365,   128,   107,   600,     # /*  135 */
  163.     30,    11,     9,    50,     # /*  136 */
  164.    355,   136,   109,   600,     # /*  137 */
  165.     35,    14,    11,    60,     # /*  138 */
  166.    115,    48,    37,   200,     # /*  139 */
  167.     85,    37,    28,   150,     # /*  140 */
  168.    335,   152,   113,   600,     # /*  141 */
  169.     55,    26,    19,   100,     # /*  142 */
  170.     65,    32,    23,   120,     # /*  143 */
  171.     80,    41,    29,   150,     # /*  144 */
  172.    105,    56,    39,   200,     # /*  145 */
  173.    155,    86,    59,   300,     # /*  146 */
  174.    305,   176,   119,   600,     # /*  147 */
  175.      5,     3,     2,    10,     # /*  148 */
  176.      5,     3,     2,    10,     # /*  149 */
  177.      5,     3,     2,    10,     # /*  150 */
  178.      5,     3,     2,    10,     # /*  151 */
  179.      5,     3,     2,    10,     # /*  152 */
  180.      5,     3,     2,    10,     # /*  153 */
  181.      5,     3,     2,    10,     # /*  154 */
  182.      5,     3,     2,    10,     # /*  155 */
  183.      5,     3,     2,    10,     # /*  156 */
  184.      5,     3,     2,    10,     # /*  157 */
  185.      5,     3,     2,    10,     # /*  158 */
  186.      5,     3,     2,    10,     # /*  159 */
  187.      5,     3,     2,    10,     # /*  160 */
  188.    155,    86,    59,   300,     # /*  161 */
  189.     80,    41,    29,   150,     # /*  162 */
  190.     55,    26,    19,   100,     # /*  163 */
  191.     85,    37,    28,   150,     # /*  164 */
  192.     35,    14,    11,    60,     # /*  165 */
  193.     30,    11,     9,    50,     # /*  166 */
  194.    185,    62,    53,   300,     # /*  167 */
  195.     95,    29,    26,   150,     # /*  168 */
  196.     65,    18,    17,   100,     # /*  169 */
  197.      4,     1,     1,     6,     # /*  170 */
  198.      4,     1,     1,     6,     # /*  171 */
  199.      4,     1,     1,     6,     # /*  172 */
  200.      4,     1,     1,     6,     # /*  173 */
  201.      4,     1,     1,     6,     # /*  174 */
  202.      4,     1,     1,     6,     # /*  175 */
  203.      4,     1,     1,     6,     # /*  176 */
  204.      4,     1,     1,     6,     # /*  177 */
  205.      4,     1,     1,     6,     # /*  178 */
  206.    119,    47,    29,   195,     # /*  179 */
  207.     72,    41,    17,   130,     # /*  180 */
  208.     97,    76,    22,   195,     # /*  181 */
  209.    172,   181,    37,   390,     # /*  182 */
  210.      5,     7,     1,    13,     # /*  183 */
  211.     83,   111,    14,   208,     # /*  184 */
  212.     43,    55,     6,   104,     # /*  185 */
  213.     89,   109,    10,   208,     # /*  186 */
  214.     23,    27,     2,    52,     # /*  187 */
  215.     95,   107,     6,   208,     # /*  188 */
  216.     49,    53,     2,   104,     # /*  189 */
  217.    101,   105,     2,   208,     # /*  190 */
  218.      1,     1,     0,     2,     # /*  191 */
  219.    307,   303,     6,   616,     # /*  192 */
  220.    153,   149,     6,   308,     # /*  193 */
  221.    305,   293,    18,   616,     # /*  194 */
  222.     38,    36,     3,    77,     # /*  195 */
  223.    303,   283,    30,   616,     # /*  196 */
  224.    151,   139,    18,   308,     # /*  197 */
  225.     43,    39,     6,    88,     # /*  198 */
  226.     75,    67,    12,   154,     # /*  199 */
  227.    299,   263,    54,   616,     # /*  200 */
  228.    149,   129,    30,   308,     # /*  201 */
  229.     27,    23,     6,    56,     # /*  202 */
  230.     37,    31,     9,    77,     # /*  203 */
  231.    295,   243,    78,   616,     # /*  204 */
  232.     21,    17,     6,    44,     # /*  205 */
  233.    293,   233,    90,   616,     # /*  206 */
  234.     73,    57,    24,   154,     # /*  207 */
  235.    291,   223,   102,   616,     # /*  208 */
  236.    145,   109,    54,   308,     # /*  209 */
  237.    289,   213,   114,   616,     # /*  210 */
  238.     36,    26,    15,    77,     # /*  211 */
  239.     41,    29,    18,    88,     # /*  212 */
  240.     13,     9,     6,    28,     # /*  213 */
  241.    285,   193,   138,   616,     # /*  214 */
  242.     71,    47,    36,   154,     # /*  215 */
  243.    283,   183,   150,   616,     # /*  216 */
  244.    141,    89,    78,   308,     # /*  217 */
  245.    281,   173,   162,   616,     # /*  218 */
  246.      5,     3,     3,    11,     # /*  219 */
  247.    423,   256,   245,   924,     # /*  220 */
  248.    213,   130,   119,   462,     # /*  221 */
  249.     13,     8,     7,    28,     # /*  222 */
  250.    108,    67,    56,   231,     # /*  223 */
  251.    435,   272,   217,   924,     # /*  224 */
  252.     73,    46,    35,   154,     # /*  225 */
  253.     63,    40,    29,   132,     # /*  226 */
  254.    111,    71,    49,   231,     # /*  227 */
  255.    149,    96,    63,   308,     # /*  228 */
  256.    225,   146,    91,   462,     # /*  229 */
  257.    453,   296,   175,   924,     # /*  230 */
  258.     38,    25,    14,    77,     # /*  231 */
  259.    459,   304,   161,   924,     # /*  232 */
  260.      3,     2,     1,     6,     # /*  233 */
  261.    471,   304,   161,   936,     # /*  234 */
  262.    237,   148,    83,   468,     # /*  235 */
  263.     53,    32,    19,   104,     # /*  236 */
  264.     60,    35,    22,   117,     # /*  237 */
  265.    483,   272,   181,   936,     # /*  238 */
  266.     81,    44,    31,   156,     # /*  239 */
  267.    489,   256,   191,   936,     # /*  240 */
  268.    123,    62,    49,   234,     # /*  241 */
  269.    165,    80,    67,   312,     # /*  242 */
  270.    249,   116,   103,   468,     # /*  243 */
  271.    501,   224,   211,   936,     # /*  244 */
  272.      7,     3,     3,    13,     # /*  245 */
  273.     43,    15,    20,    78,     # /*  246 */
  274.     22,     6,    11,    39,     # /*  247 */
  275.     15,     3,     8,    26,     # /*  248 */
  276.     23,     3,    13,    39,     # /*  249 */
  277.     47,     3,    28,    78,     # /*  250 */
  278.      8,     0,     5,    13,     # /*  251 */
  279.      7,     0,     4,    11,     # /*  252 */
  280.     21,     0,    10,    31,     # /*  253 */
  281.     13,     0,     5,    18,     # /*  254 */
  282.     13,     0,     5,    18);
  283.    
  284. #   X 2
  285. # 0 1
  286. @glb_ostr0 = ();
  287. @glb_ostr1 = ();
  288. @glb_ostr2 = ();
  289. for($j = 0; $j<256; ++$j) {
  290.     my(@t) = (0) x 512;
  291.    
  292.     for($i = -256; $i<256; ++$i) {$t[$i & 0x1ff] = &err_trunc($i, $glb_extin * $glb_ostro[4*$j+1] * 1.0 / $glb_ostro[4*$j+3]) & 0x1ff;}
  293.     $glb_ostr0[$j] = [@t];
  294.    
  295.     for($i = -256; $i<256; ++$i) {$t[$i & 0x1ff] = &err_trunc($i, $glb_extin * $glb_ostro[4*$j+2] * 1.0 / $glb_ostro[4*$j+3]) & 0x1ff;}
  296.     $glb_ostr1[$j] = [@t];
  297.  
  298.     for($i = -256; $i<256; ++$i) {$t[$i & 0x1ff] = &err_trunc($i, $glb_extin * $glb_ostro[4*$j+0] * 1.0 / $glb_ostro[4*$j+3]) & 0x1ff;}
  299.     $glb_ostr2[$j] = [@t];
  300. }
  301.  
  302. # construit les maps pour la multiplication
  303. for($i = -256; $i<256; ++$i) {$glb_sqr [$i & 0x1ff] = $i * $i;}
  304.  
  305. # limit error
  306. $clamp = -48;
  307. for($i = -256; $i<256; ++$i) {$glb_clamp[$i & 0x1ff] = ($i< $clamp ? $clamp : $i) & 0x1ff;}
  308.  
  309. # map une intensité entre 0..255 vers l'intensité produite par le circuit EFxxx le plus proche (16 valeurs)
  310. @ef_vals = (0, 39, 74, 101, 122, 140, 157, 171, 185, 195, 206, 216, 227, 237, 248, 255) if 1;
  311.  
  312. # eval perso
  313. @ef_vals = (0,78,116,138,157,171,182,187,205,215,222,229,238,244,249,255) if 0;
  314. @ef_vals = (0,51,91,117,142,161,172,187,199,210,220,227,236,244,248,255) if 1;
  315.  
  316. # ef TEO
  317. @ef_vals = (0, 100, 127, 142, 163, 179, 191, 203, 215, 223, 231, 239, 243, 247, 251, 255) if 1;
  318. @ef_vals = (0, 127, 169, 188, 198, 205, 212, 219, 223, 227, 232, 239, 243, 247, 251, 255) if 0; # eval prehisto
  319. @ef_vals = (0, 174, 192, 203, 211, 218, 224, 229, 233, 237, 240, 244, 247, 249, 252, 255) if 0; # prehisto 2
  320. @ef_vals = (0, 169, 188, 200, 209, 216, 222, 227, 232, 236, 239, 243, 246, 249, 252, 255) if 0; # prehisto 3
  321. @ef_vals = (0, 153, 175, 189, 199, 207, 215, 221, 227, 232, 236, 241, 245, 248, 252, 255) if 0; # prehisto 4
  322.  
  323. @intens = @ef_vals;
  324.  
  325. if($glb_gamma) {
  326.     #print join(",", @intens), "\n";
  327.     foreach (@intens)  {$_ = &gamma($_);}
  328.     #print join(",", @intens), "\n";
  329.     foreach (@ef_vals) {$_ = &gamma($_);}
  330. }
  331.  
  332. # index
  333. @glb_sprd_idx = ();
  334. $k=0;
  335. for($i=0; $i<256; ++$i) {
  336.     $glb_sprd_idx[$i] = $i; next;
  337.     ++$k if $k<$#ef_vals && $i==$ef_vals[$k+1];
  338.     $glb_sprd_idx[$i] = xint(($i - $ef_vals[$k])*256/($ef_vals[$k+1]-$ef_vals[$k]));
  339. }
  340.  
  341. # remap des intens
  342. for($i=0; $i<=$#intens; ++$i) {
  343.     my($z) = 0;
  344.     for($j=0, $m=1e30; $j<=$#ef_vals; ++$j) {
  345.         next if $ef_vals[$j]<0;
  346.         $k = $intens[$i] - $ef_vals[$j]; $k = -$k if $k<0;
  347.         if($k<$m) {$m=$k; $z = $ef_vals[$j];}
  348.     }
  349.     $intens[$i] = $z;
  350. }
  351.  
  352. # mapping des intensités
  353. @map_ef = ();
  354. for($i=0; $i<256; ++$i) {  
  355.     for($j=0, $m=1e30; $j<=$#intens; ++$j) {
  356.         next if $intens[$j]<0;
  357.         $k = $i - $intens[$j]; $k = -$k if $k<0;
  358.         if($k<$m) {$m=$k; $map_ef[$i] = $intens[$j];}
  359.     }
  360.     for($j=0; $j<=$#intens && $intens[$j]<=$i; ++$j) {
  361.         next if $intens[$j]<0;
  362.         $map_ef2[$i] = $intens[$j];
  363.     }
  364. }
  365. #@map_ef = ();
  366.  
  367.  
  368. # analyse des fichiers en argments
  369. @files = @ARGV;
  370.  
  371. # si aucun fichier, alors on les prends depuis l'entrée standard
  372. if(!@files) {
  373.     while(<>) {
  374.         chomp;
  375.         next if /chlgdls/;
  376.         y%\\%/%;
  377.         s%^([\S]):%/cygdrive/$1%;
  378.         push(@files, $_);
  379.     }
  380. }
  381.  
  382. # extension supportées
  383. $supported_ext = "\.(gif|pnm|png|jpg|jpeg|ps|bmp)";
  384. # fichier a effacer pour stopper le prog
  385. $stopme = ".stop_me";
  386. open(FILE, ">$stopme"); close(FILE);
  387.  
  388. #&start_wd;
  389.  
  390. # traitement
  391. $pause_durat = 50;
  392. $pause_delay = int($pause_durat*100/$glb_pause);  # une pause de $glb_pause% du temps
  393. $next_pause  = time + $pause_delay;
  394.  
  395. # traitement de tous les fichiers
  396. $cpt = 0;
  397. foreach $in (@files) {
  398.     last if ! -e "$stopme";
  399.     next unless $in =~ /$supported_ext$/i;
  400.     next if $in =~ /.*\/rgb.*/;
  401.     next if $in =~ /rgb.*/;
  402.  
  403.     ++$cpt;
  404.     next if $in eq "-";
  405.     #next if $in =~ /ord/;
  406.     next if $in =~ /6846/;
  407.  
  408.     $out = $in; $out=~s/$supported_ext$/.MAP/i; $out=~s/.*[\/\\]//;
  409.     $out = "rgb/$out";
  410.  
  411.     print $cpt,"/",1+$#files," $in => $out\n";
  412.    
  413.     #&reset_wd;
  414.    
  415.     next if -e $out;
  416.  
  417.     # lecture
  418.     my(@px) = &read_image($in);
  419.    
  420.     @px = &cleanup(@px) if 1;
  421.     @px = &bst_lvl(@px) if 1;
  422.  
  423.     # creation palette 16 couls (passage par une globale pour simplifier le code)
  424.     @glb_pal = &find_palette($glb_maxcol, @px);
  425.    
  426.     #&simple_dither_pal(1, @px);
  427.     #&simple_dither_wpal(1, 1+$#glb_pal, @glb_pal, @px);
  428.    
  429.     #&print_pal(@glb_pal);
  430.  
  431.     # process image
  432.     my($p, $y, $x) = (0,0,0);
  433.     my(%cache);
  434.    
  435.     for($x=0; $x<160; ++$x) {
  436.         print "\r> ", int((100*$x)/160), "%  ";
  437.        
  438.         my($y0, $y1, $inc) = (199, -1, -1);
  439.         ($y0, $y1, $inc) = (0, 200, 1) unless $x & 1;
  440.        
  441.         for($y=$y0; $y!=$y1; $y+=$inc) {
  442.             $p = $y * 160 + $x;
  443.            
  444.             my($rvb) = &irgb_sat($px[$p]);
  445.             my($jm) = $cache{$rvb};
  446.            
  447.             if(!defined $jm) {
  448.                 for($dm=1e30, $jm=$j=0; $j<$glb_maxcol; ++$j) {
  449.                     my $d = &irgb_dist($glb_pal[$j], $rvb);
  450.                     if($d<$dm) {$dm = $d; $jm = $j;}
  451.                 }
  452.                 $cache{$rvb} = $jm;
  453.             }
  454.  
  455.             $px[$p] = $glb_pal[$jm];
  456.            
  457.             # diffusion d'erreur
  458.             my($err) = &irgb_sub($rvb, $px[$p]);
  459.            
  460.             if($inc>0) {
  461.                 $px[$p - 159] = &irgb_sprd($px[$p - 159], $err, $rvb, \@glb_ostr0) if $x<159 && $y>0;
  462.                 $px[$p + 001] = &irgb_sprd($px[$p + 001], $err, $rvb, \@glb_ostr1) if $x<159;
  463.                 $px[$p + 160] = &irgb_sprd($px[$p + 160], $err, $rvb, \@glb_ostr2) if           $y<199;
  464.             } else {
  465.                 $px[$p + 161] = &irgb_sprd($px[$p + 161], $err, $rvb, \@glb_ostr0) if $x<159 && $y<199;
  466.                 $px[$p + 001] = &irgb_sprd($px[$p + 001], $err, $rvb, \@glb_ostr1) if $x<159;
  467.                 $px[$p - 160] = &irgb_sprd($px[$p - 160], $err, $rvb, \@glb_ostr2) if           $y>0;
  468.             }
  469.         }
  470.         $| = 1; print "\r"; $| = 0;
  471.     }
  472.     %dist_cache = ();
  473.     undef %dist_cache;
  474.     undef %cache;
  475.    
  476.     # ecriture des pixels et lecture
  477.     #$out =~ s/.gif$/.c16.gif/;
  478.     #&write_image("$out.png", @px);
  479.    
  480.     &write_map($out, @px);
  481.     $| = 1; print "                                                             \r"; $| = 0;
  482.  
  483.         # on laisse du temps au processeur pour se refroidir
  484.         #my($t) = time;
  485.         #if($t > $next_pause) {
  486.         #        $next_pause = $t + $pause_delay;
  487.         #        sleep($pause_durat);
  488.         #}
  489.     sleep(10);
  490. }
  491. unlink($stopme);
  492.  
  493. if(0) {
  494.     %m = ();
  495.     foreach $out (<rgb# /*.MAP>) {
  496.         open(IN, "cygpath -w -s \"$out\" |"); $zz = <IN>; chomp($zz); close(IN);
  497.         $zz=~y/~\\/_\//;
  498.         $m{$out} = $zz;
  499.     }
  500.     foreach $out (keys %m) {
  501.         rename($out, $m{$out});
  502.     }
  503. }
  504.  
  505. exit;
  506.  
  507. sub bst_lvl {
  508.     my(@px, %num, %tot, $n) = @_;
  509.     #return @px;
  510.    
  511.     for my $p (@px) {      
  512.         my($r,$g,$b) = ($p>>20, ($p>>10)&255, $p&255);
  513.         ++$tot{$r}; ++$tot{$g}; ++$tot{$b};
  514.         $r &= ~7; $g &= ~7; $b &= ~7;
  515.         ++$num{$r} if $r<$map_ef[$r] && $ef_val[0]<$r && $r<255;
  516.         ++$num{$g} if $g<$map_ef[$g] && $ef_val[0]<$g && $g<255;
  517.         ++$num{$b} if $b<$map_ef[$b] && $ef_val[0]<$b && $b<255;
  518.     }
  519.    
  520.     my(@t) = sort {$num{$b}<=>$num{$a}} keys %num;
  521.    
  522.     return @px unless $#t>=0;
  523.    
  524.     my($tot) = 0; delete $tot{0}; delete $tot{255};
  525.     for my $t (values %tot) {$tot += $t;}
  526.    
  527.     my($f, $thr) = (1, $tot/10);
  528.     for my $t (@t) {
  529.         my($x) = $map_ef[$t]/$t;
  530.         my($o) = 0;
  531.         for my $z (keys %tot) {
  532.             $o += $tot{$z} if int($x * $z)>255;
  533.         }
  534.         if($o<$thr) {
  535.             $f = $x;
  536.             print STDERR "bst_lvl: $f $t($num{$t})->$map_ef[$t] $o<$thr\n";
  537.             last;
  538.         }
  539.     }
  540.        
  541.    
  542.     for my $p (@px) {
  543.         my($r,$g,$b) = ($p>>20, ($p>>10)&255, $p&255);
  544.         $r = int($r * $f); $r=255 if $r>255;
  545.         $g = int($g * $f); $g=255 if $g>255;
  546.         $b = int($b * $f); $b=255 if $b>255;
  547.         $p = ($r<<20)|($g<<10)|$b;
  548.     }
  549.    
  550.     return @px;
  551. }
  552.  
  553. sub err_trunc {
  554.     my($err, $coef) = @_;
  555.     #$err = 0 if $err>-10 && $err<10;
  556.     return &xint($err * $coef);
  557. }
  558.  
  559. sub print_pal {
  560.     my(@pal) = @_;
  561.     my($i, @t);
  562.     foreach $i (@pal) {
  563.         my($r) = ($i>>20) & 255;
  564.         my($g) = ($i>>10) & 255;
  565.         my($b) = ($i>>00) & 255;
  566.        
  567.         push(@t, sprintf("%3d,%3d,%3d", $r, $g, $b));
  568.     }
  569.     for $i (sort(@t)) {
  570.         print "$i\n";
  571.     }
  572. }
  573.  
  574. sub rgb8irgb {
  575.     return &rgb2irgb($_[0]/255.0, $_[1]/255.0, $_[2]/255.0);
  576. }
  577.  
  578. # calcul d'une palette de 16 couleurs
  579. sub find_palette {
  580.     my($max, @px) = @_;
  581.  
  582.     # cas TO7
  583.     return &to770_palette if $glb_to7pal;
  584.    
  585.     # si l'image a suffisament peu de couleurs alors on retourne la palette de l'image
  586.     # directement
  587.     my($i, %pal);
  588.     foreach $i (@px) {
  589.         $pal{&ef_clamp($i)} = 1;
  590.         last if length(keys %pal)>$max;
  591.     }
  592.     my(@t) = keys(%pal);
  593.     return @t if $#t<$max;
  594.     return &to9_pal($max, @px);
  595. }
  596.  
  597. sub ef_clamp {
  598.     my($t) = @_;
  599.     my($b) = $map_ef[$t & 255]; $t>>=10;
  600.     my($g) = $map_ef[$t & 255]; $t>>=10;
  601.     my($r) = $map_ef[$t & 255];
  602.     $t = ((($r<<10)+$g)<<10)+$b;
  603.     #print &irgb2hex($_[0]), "=>",&irgb2hex($t),"\n";
  604.     return $t;
  605. }
  606.  
  607. sub irgb_dist_spec {
  608.     my($rgb1, $rgb2) = @_;
  609.     my($d, $t) = 0;
  610.     $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $t = abs($t); $d += $t; $rgb1>>=10; $rgb2>>=10;
  611.     $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $t = abs($t); $d += $t; $rgb1>>=10; $rgb2>>=10;
  612.     $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $t = abs($t); $d += $t; $rgb1>>=10; $rgb2>>=10;
  613.     return $d;
  614. }
  615.  
  616. sub irgb_sprd {
  617.     my($px, $err, $ref, $coef) = @_;
  618.     my($r, $map) = 0;
  619.    
  620.     $ref = &irgb_sat($ref);
  621.    
  622.     $map = $coef->[$glb_sprd_idx[$ref & 255]]; $ref >>= 10;
  623.     $r = $map->[$err & 0x1ff]; $err >>= 10;
  624.    
  625.     $map = $coef->[$glb_sprd_idx[$ref & 255]]; $ref >>= 10;
  626.     $r |= $map->[$err & 0x1ff]<<10; $err >>= 10;
  627.    
  628.     $map = $coef->[$glb_sprd_idx[$ref & 255]];
  629.     $r |= $map->[$err]<<20;
  630.    
  631.     return &irgb_uadd($px, $r); # add ou uadd?
  632. }
  633.  
  634. # sauvegarde de l'image
  635. sub write_image {
  636.     my($file, @px) = @_;
  637.    
  638.     # on replace tout entre 0 et 255
  639.     my($t, $c, @p);
  640.     foreach $t (@px) {
  641.         my($b) = $t & 0x100 ? 0 : $t & 0xff; $t >>= 10;
  642.         my($v) = $t & 0x100 ? 0 : $t & 0xff; $t >>= 10;
  643.         my($r) = $t & 0x100 ? 0 : $t & 0xff;
  644.         if(0        && $#map_ef>=0) {
  645.             $r = $map_ef2[$r];
  646.             $v = $map_ef2[$v];
  647.             $b = $map_ef2[$b];
  648.         }
  649.         my(@z) = (&ammag($r), &ammag($v), &ammag($b));
  650.         push(@p, @z, @z); #, $r, $v, $b);
  651.     }
  652.     # on passe par un fichier temporaire
  653.     open(OUT,">.toto.pnm"); print OUT "P6\n320 200\n255\n", pack('C*', @p), "\n"; close(OUT);
  654.     @$glb_magick = ();
  655.     $glb_magick->Read(".toto.pnm");
  656.     $glb_magick->Set(page=>"320x200+0+0");
  657.    
  658.     # sauvegarde
  659.     $glb_magick->Write($file);
  660. }
  661.  
  662. # gamma / normalize / sigmoidal
  663. # 0 = orig / Linear / off
  664. # 1 = orig / Linear / on
  665. # 2 = orig / Normalize / off
  666. # 3 = orig / Normalize / on
  667. # 4 = gamma / Linear / off
  668. # 5 = gamma / Linear / on
  669. # 6 = gamma / Normalize / off
  670. # 7 = gamma / Normalize / on
  671.  
  672. # lit une image au format 320 x 200 sous la forme r10v10b10
  673. sub read_image {
  674.     my($file) = @_;
  675.  
  676.     @$glb_magick = ();     
  677.     my($x) = $glb_magick->Read($file);
  678.     warn "$x" if "$x";
  679.  
  680.     # formattage en 320x200 si necessaire
  681.     #$glb_magick->AutoGamma();
  682.     #$glb_magick->AutoLevel();
  683.    
  684.     $glb_magick->Modulate(saturation=>130);
  685.    
  686.     $glb_magick->Enhance();
  687.     $glb_magick->Normalize(); #"0.1%,0.1%"); #
  688.    
  689.     #$glb_magick->LinearStretch('black-point'=>0, 'white-point'=>1);
  690.     #$glb_magick->Contrast(sharpen=>"True");
  691.     #$glb_magick->ContrastStretch("4%,96%");
  692. #   $glb_magick->ContrastStretch("5%"); #faible, mais pas mal pour un standard
  693. #   $glb_magick->ContrastStretch("10%");
  694. #   $glb_magick->ContrastStretch("8%");
  695.     #$glb_magick->ContrastStretch("0");
  696.    
  697.     #$glb_magick->Set(antialias=>"True");
  698.     $glb_magick->SigmoidalContrast(contrast=>2);
  699.     $glb_magick->Gamma(0.98);
  700.        
  701.     #$glb_magick->Quantize(colorspace=>'gray');
  702.    
  703.     #$glb_magick->Gamma(0.8); #TEST
  704.     #$glb_magick->ContrastStretch("2%,99%"); #2% pour skyrim
  705.     #$glb_magick->ContrastStretch("4%,99%"); #2% pour skyrim
  706.     #$glb_magick->ContrastStretch("5%");
  707.    
  708.     #$glb_magick->Gamma(0.8);
  709.     $glb_magick->Trim();
  710.     $glb_magick->Set(page=>'0x0+0+0');
  711.     my($blur) = 1.15;
  712.     $glb_magick->AdaptiveResize(geometry=>"320x200", filter=>"lanczos", blur=>1);
  713.     $glb_magick->Border(width=>"320",height=>"100",color=>"black");
  714.     #  $glb_magick->Blur(1);
  715.     #  $glb_magick->OilPaint(2);
  716.     $glb_magick->Set(gravity=>"Center");
  717.     #   $glb_magick->Crop(geometry=>"320x200!", gravity=>"center");
  718.     $glb_magick->Crop(geometry=>"320x200!");
  719.     $glb_magick->Set(page=>"320x200+0+0");
  720.     $glb_magick->Resize(geometry=>"160x200!", filter=>"lanczos", blur=>$blur);
  721.     #$glb_magick->ReduceNoise(radius=>0);
  722.     #$glb_magick->Gamma(gamma=>0.8) if $glb_to7pal;
  723.     #$glb_magick->Gamma(gamma=>0.45);
  724.     #$glb_magick->AdaptiveSharpen(radius=>3);
  725.     #$glb_magick->AdaptiveBlur(radius=>4);
  726.     #$glb_magick->Contrast(sharpen=>"True");
  727.     #$glb_magick->Evaluate(operator=>"Multiply", value=>"0.9");
  728.  
  729.     #$glb_magick->ContrastStretch("3%");
  730.  
  731.    
  732.     #$glb_magick->Quantize(colors=>$glb_maxcol, colorspace=>"CYMK", dither=>"True");
  733.     #$glb_magick->OrderedDither(threshold=>"h4x4", channel=>"RGB");
  734.     my(@t) = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
  735.     my($i, @px);
  736.     #for $i (@u) {$i = &ammag($map_ef[&gamma($i*255)])/255.0;}
  737.     for($i = 0; $i<$#t; $i += 3) {
  738.         push(@px, &rgb2irgb(@t[$i..$i+2]));
  739.     }
  740.    
  741.     &write_image("rgb/totof.png", @px);
  742.     return @px;
  743. }
  744.  
  745. sub correct {
  746.     my($x, $t, $v) = @_;
  747.     $x *= $t/$v;
  748.     return $x;
  749. }
  750.  
  751. sub auto_stretch {
  752.     my($sz) = 320*200;
  753.     my($min, $max) = (int($sz*7/100), int($sz*9/100));
  754.     my($ok) = 0;
  755.     my($bak) = "rgb/.autostretch.png";
  756.    
  757.     $glb_magick->Write($bak);
  758.    
  759.     $glb_magick->ContrastStretch("$min,$sz");
  760.     $glb_magick->Write("rgb/.autostretch0.png");
  761.     my(@prof0) = &profile;
  762.    
  763.     @$glb_magick = ();
  764.     $glb_magick->Read($bak);
  765.    
  766.     print "Contrast";
  767.    
  768.     while(!$ok && $max) {
  769.         $ok = 0;
  770.         $glb_magick->ContrastStretch($min.",".($sz-$max));
  771.         $glb_magick->Write("rgb/.autostretch1.png");
  772.         my(@prof1) = &profile;
  773.  
  774.         $ok = &profile_diff(@prof0, @prof1);
  775.         if(!$ok) {
  776.             $| = 1; print "."; $| = 0;
  777.             @$glb_magick = ();
  778.             $glb_magick->Read($bak);
  779.             $max = int($max*.9);
  780.         }
  781.     }
  782.    
  783.     print " $max\n";
  784.    
  785.     @$glb_magick = ();
  786.     $glb_magick->Read($bak);
  787.     $glb_magick->ContrastStretch($min.",".($sz-$max)); 
  788.     $glb_magick->Write($bak);
  789. }
  790.  
  791. sub profile {
  792.     my(@t) = $glb_magick->GetPixels(map=>"RGB", height=>200, normalize=>"True");
  793.     my($l) = 3;
  794.     my(@c) = (0) x ($l*3);
  795.     my($i, $v);
  796.     for($i=0; $i<$#t; $i+=3) {
  797.         $rvb = 0;
  798.         $v = int($l*$t[$i+0]); $v = $l-1 if $v>=$l; ++$c[$v];
  799.         $v = int($l*$t[$i+1]); $v = $l-1 if $v>=$l; ++$c[$v+$l];
  800.         $v = int($l*$t[$i+2]); $v = $l-1 if $v>=$l; ++$c[$v+$l+$l];
  801.     }
  802.     return @c;
  803. }
  804.  
  805. sub profile_diff {
  806.     my(@v) = @_;
  807.     my($s) = ($#v+1)/6;
  808.     my(@r1) = splice(@v,0,$s);
  809.     my(@g1) = splice(@v,0,$s);
  810.     my(@b1) = splice(@v,0,$s);
  811.     my(@r2) = splice(@v,0,$s);
  812.     my(@g2) = splice(@v,0,$s);
  813.     my(@b2) = splice(@v,0,$s);
  814.     #print join(",", @r1), "\n", join(",", @r2), "\n";
  815.     #print join(",", @g1), "\n", join(",", @g2), "\n";
  816.     #print join(",", @b1), "\n", join(",", @b2), "\n";
  817.     return &profile_cmp($r1[$#$r1], $r2[$#r2]) && &profile_cmp($g1[$#$r1], $g2[$#r2]) && &profile_cmp($b1[$#$r1], $b2[$#r2]);
  818. }
  819.  
  820. sub profile_cmp {
  821.     my($vr, $v) = @_;
  822.     my($tol) = 2;
  823.     if($vr>640 && $v>640 && $v>$tol*$vr) {
  824.         #print "==> $vr $v\n";
  825.         return 0;
  826.     }
  827.     return 1;
  828. }
  829.  
  830. sub ammag {
  831.     return $_[0] unless $glb_gamma;
  832.     my $t = $_[0]/255;
  833.     if($t<=0.018) {$t = 4.5*$t;} else {$t = 1.099*($t**(1/$glb_gamma))-0.099;}
  834.     #$t = $t**(1/$glb_gamma);
  835.     return xint(255*$t);
  836. }
  837.  
  838. sub gamma {
  839.     return $_[0] unless $glb_gamma;
  840.     my $t = $_[0]/255;
  841.     if($t<=0.081) {$t = $t/4.5;} else {$t = (($t+0.099)/1.099)**$glb_gamma;}
  842.     #$t = $t**$glb_gamma;
  843.     return xint($t*255); #**1.2; #**1.4;
  844. }
  845.  
  846. # affichage
  847. sub irgb2hex {
  848.     my($irgb) = @_;
  849.     my($s) = "";
  850.     if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
  851.     if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
  852.     if($irgb & 0x100) {$s = sprintf("-%02x$s", (($irgb ^ 0x1ff)&0xff) + 1);} else {$s = sprintf("+%02x$s", $irgb & 0xff);} $irgb >>= 10;
  853.     return $s;
  854. }
  855.  
  856. # addition d'une valeur irgb signée .. inclu saturation -256 +255
  857. sub irgb_add {
  858.     my($irgb1, $irgb2) = @_;
  859.    
  860.     my($r) = $irgb1 + $irgb2;
  861.     my($o) = (($irgb1 & 0x0ff3fcff) + ($irgb2 & 0x0ff3fcff)) ^ ($r>>1);
  862.     $r = ($r & ~0x000003ff) | (0x00000100 - (($r & 0x00000100)>>8)) if $o & 0x00000100;
  863.     $r = ($r & ~0x000ffc00) | (0x00040000 - (($r & 0x00040000)>>8)) if $o & 0x00040000;
  864.     $r = ($r & ~0x3ff00000) | (0x10000000 - (($r & 0x10000000)>>8)) if $o & 0x10000000;
  865.     return $r & 0x1ff7fdff if 1; # saturation -256 et +255
  866. }  
  867.  
  868. # addition d'une valeur irgb signée .. inclu saturation 0 +255
  869. sub irgb_uadd {
  870.     return &irgb_sat(&irgb_add(@_));
  871. }
  872.  
  873. # sature les irgb<0 à 0
  874. sub irgb_sat {
  875.     my($irgb) = @_;
  876.    
  877.     return (((0x10040100 - (($irgb & 0x10040100)>>8)) ^ 0xff3fcff) & $irgb) & 0xff3fcff;
  878. }  
  879.  
  880. # soustraction de deux valeurs irgb>=0 (pas de satur)
  881. sub irgb_sub {
  882.     my($rgb1, $rgb2) = @_;
  883.     return (($rgb1 | 0x20080200) - $rgb2) & 0x1ff7fdff;
  884. }
  885.  
  886. # valeur opposée
  887. sub irgb_neg {
  888.     my($rgb) = @_;
  889.     return (0x20080200 - $rgb) & 0x1ff7fdff;
  890. }
  891.  
  892. # module du vecteur irgb
  893. sub irgb_module {
  894.     my($rgb) = @_;
  895.     my($d);
  896.     $d  = $glb_sqr[0x1ff & $rgb]; $rgb >>= 10;
  897.     $d += $glb_sqr[0x1ff & $rgb]; $rgb >>= 10;
  898.     $d += $glb_sqr[0x1ff & $rgb];
  899.     return sqrt($d);
  900. }
  901.  
  902. # intensité
  903. sub irgb_intens {
  904.     my($rgb) = &irgb_sat(@_);
  905.     my($d);
  906.     $d  = (0xff & $rgb)*0.0721; $rgb >>= 10;
  907.     $d += (0xff & $rgb)*0.7154; $rgb >>= 10;
  908.     $d += (0xff & $rgb)*0.2125;
  909.     return $d;
  910. }
  911.  
  912. # applique une table sur un irgb (en gros ca sert pour les multiplications par des constantes)
  913. sub irgb_map {
  914.     my($rgb, $map) = @_;
  915.     my($r);
  916.     $r  = $map->[$rgb & 0x1ff];     $rgb >>= 10;
  917.     $r |= $map->[$rgb & 0x1ff]<<10; $rgb >>= 10;
  918.     $r |= $map->[$rgb]<<20;
  919.     return $r;
  920. }
  921.  
  922. # rgb (0..1) vers irgb
  923. sub rgb2irgb {
  924.     my(@rgb) = @_;
  925.     my($t);
  926.     if($glb_gamma) {
  927.         $rgb[0] = &gamma($rgb[0]*255)/255;
  928.         $rgb[1] = &gamma($rgb[1]*255)/255;
  929.         $rgb[2] = &gamma($rgb[2]*255)/255;
  930.     }
  931.     $t = (int(255*$rgb[0]) & 0x1ff);
  932.     $t = (int(255*$rgb[1]) & 0x1ff) | ($t<<10);
  933.     $t = (int(255*$rgb[2]) & 0x1ff) | ($t<<10);
  934.     return $t;
  935. }
  936.  
  937. # irgb vers rgb (0..1). si la composante est negative, elle est clampée à 0
  938. sub irgb2rgb {
  939.     my($t) = @_;
  940.    
  941.     my($b) = ($t & 0x100) ? 0 : ($t & 255)/255.0; $t >>= 10;
  942.     my($v) = ($t & 0x100) ? 0 : ($t & 255)/255.0; $t >>= 10;
  943.     my($r) = ($t & 0x100) ? 0 : ($t & 255)/255.0;
  944.    
  945.     return ($r, $v, $b);
  946. }
  947.  
  948. # moyenne de 2 couleurs >= 0
  949. sub irgb_avg {
  950.     my($rgb1, $rgb2) = @_;
  951.     return (($rgb1 + $rgb2 + 0x100401) & ~0x20180601)>>1;
  952. }
  953.  
  954. # rgb (0..1) vers xyz
  955. sub rgb2xyz {
  956.     my($r, $v, $b) =  @_;
  957.     return (0.618*$r + 0.177*$v + 0.205*$b,
  958.         0.299*$r + 0.587*$v + 0.114*$b,
  959.                            0.056*$v + 0.944*$b);
  960. }
  961.  
  962. # xyz vers cie lab
  963. sub xyz2lab {
  964.     my($x, $y, $z) = @_;
  965.     #my($xn, $yn, $zn) = &rgb2xyz(1,1,1); $x /= $xn; $y /= $yn; $z /= $zn;
  966.     my($l,$a,$b);
  967.     if($y>0.008856) {
  968.         $l = 116*($y ** 0.33333333333333) - 16;
  969.     } else {
  970.         $l = 903*$y;
  971.     }
  972.     $a = 500*(&f_lab($x) - &f_lab($y));
  973.     $b = 200*(&f_lab($y) - &f_lab($z));
  974.     return ($l,$a,$b);
  975. }
  976.  
  977. sub f_lab {
  978.     my($v) = @_;
  979.    
  980.     if($v>0.008856) {
  981.         return $v ** 0.333333333333333;
  982.     } else {
  983.         return 7.787*$v + 16/116.0;
  984.     }
  985. }
  986.  
  987. # rgb vers lab
  988. sub rgb2lab {
  989.     return &xyz2lab(&rgb2xyz(@_));
  990. }
  991.  
  992. # approximated CIE formula from http://www.compuphase.com/cmetric.htm#GAMMA
  993. sub irgb_cie_dist_fast {
  994.     my($rgb1, $rgb2) = @_;
  995.        
  996.     my($rmean) = (($rgb1 + $rgb2) >> 21) & 0x1ff;
  997.     my($rgb) = &irgb_sub($rgb1, $rgb2);
  998.    
  999.     $d  = ($glb_sqr[0x1ff & $rgb] * (512 + $rmean)) >> 8; $rgb >>= 10;
  1000.     $d +=  $glb_sqr[0x1ff & $rgb] * 4; $rgb >>= 10;
  1001.     $d += ($glb_sqr[0x1ff & $rgb] * (767 - $rmean)) >> 8;
  1002.     return sqrt($d);
  1003. }
  1004.  
  1005. # calcule la distance entre les deux couleurs r10g10b10
  1006. sub irgb_dist {
  1007.     my($rgb1, $rgb2) = @_;
  1008.     #die &irgb2hex($rgb1) if $rgb1 & 0x10040100;
  1009.     #die &irgb2hex($rgb2) if $rgb2 & 0x10040100;
  1010.     if($glb_lab) {
  1011.         return &irgb_cie_dist_fast($rgb1, $rgb2);
  1012.         #my($k) = $rgb1."_".$rgb2;
  1013.         my($d); # = $dist_cache{$k};
  1014.         #if(!defined $d) {
  1015.         my($r1, $g1, $b1) = &xyz2lab(&rgb2xyz(&irgb2rgb($rgb1)));
  1016.         my($r2, $g2, $b2) = &xyz2lab(&rgb2xyz(&irgb2rgb($rgb2)));
  1017.        
  1018.         $r1 -= $r2; $g1 -= $g2; $b1 -= $b2;
  1019.         $d = sqrt($r1*$r1 + $g1*$g1 + $b1*$b1);
  1020.         #$dist_cache{$k} = $d;
  1021.         #}
  1022.         return $d;
  1023.     } else {
  1024.         my($k) = $rgb1<=$rgb2?$rgb1."_".$rgb2:$rgb2."_".$rgb1;
  1025.         my($d) = $dist_cache{$k};
  1026.         if(!defined $d) {
  1027.         my($t) = 0;
  1028.         $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $d += $t*$t; $rgb1>>=10; $rgb2>>=10;
  1029.         $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $d += $t*$t; $rgb1>>=10; $rgb2>>=10;
  1030.         $t = &irgb2sgn($rgb1) - &irgb2sgn($rgb2); $d += $t*$t; $rgb1>>=10; $rgb2>>=10;
  1031.         $d = sqrt($d);
  1032.         $dist_cache{$k} = $d;
  1033.         }
  1034.         return $d;
  1035.         #return &irgb_module(&irgb_sub($rgb1, $rgb2));
  1036.     }
  1037. }
  1038.  
  1039. sub irgb2sgn {
  1040.     my($v) = @_;
  1041.     $v &= 0x1FF;
  1042.     return $v & 0x100 ? -(($v ^ 0x1FF)+1) : $v;
  1043. }
  1044.  
  1045. sub rgbdist {
  1046.     my($r1, $g1, $b1, $r2, $g2, $b2) = @_;
  1047.     $r1 -= $r2;
  1048.     $g1 -= $g2;
  1049.     $b1 -= $b2;
  1050.     return sqrt($r1*$r1 + $g1*$g1 + $b1*$b1);
  1051. }
  1052.  
  1053. sub cleanup {
  1054.     return @_ if 0;
  1055.     my($thr) = $glb_clean;
  1056.     return @_ unless $thr>0;
  1057.     my(@r, $i, $t);
  1058.     my(@t) = @_;
  1059.    
  1060.     if(1) {
  1061.         # les composantes bien trop faibles sont eliminées
  1062.         @r = @t; @t = ();
  1063.         for $i (@r) {
  1064.             my($r) = ($i>>00) & 0xFF;
  1065.             my($g) = ($i>>10) & 0xFF;
  1066.             my($b) = ($i>>20) & 0xFF;
  1067.             my($M) = $r;
  1068.             $M = $g if $g>$M;
  1069.             $M = $b if $b>$M;
  1070.             my($m) = $r;
  1071.             $m = $g if $g<$m;
  1072.             $m = $b if $b<$m;
  1073.             my($l)  = 0.299*$r + 0.587*$g + 0.114*$b;
  1074.             #$m = $m*3 + $r + $g + $b;
  1075.             #$m /= 16;
  1076.             if(0) {
  1077.                 $M /= 4.2; #4.2; # pas mal
  1078.                 #$m = 255/8 if $m>255/8;
  1079.            
  1080.                 #while(($r<$m && $g<$m) || ($r<$m && $b<$m) || ($g<$m && $b<$m)) {$m/=1.05; last if $m<1e-3;}
  1081.                 if($l<38 && $m<$M) {
  1082.                     my($t) = ($m + $M)>>1;
  1083.                     $r = 0 if $r<=$t;
  1084.                     $g = 0 if $g<=$t;
  1085.                     $b = 0 if $b<=$t;
  1086.                     #$r = 0 if $r < $m;
  1087.                     #$g = 0 if $g < $m;
  1088.                     #$b = 0 if $b < $m;
  1089.                     #if($g<$m)    {$g=0;}
  1090.                     #elsif($r<$m) {$r=0;}
  1091.                     #elsif($b<$m) {$b=0;}
  1092.                 }
  1093.             } elsif(1) {
  1094.                 $M /= 4.2; #4.2; # pas mal
  1095.                 if($m<$M) {
  1096.                     my($t) = $M;
  1097.                     $r = 0 if $r<=$t;
  1098.                     $g = 0 if $g<=$t;
  1099.                     $b = 0 if $b<=$t;
  1100.                     #$r = 0 if $r < $m;
  1101.                     #$g = 0 if $g < $m;
  1102.                     #$b = 0 if $b < $m;
  1103.                     #if($g<$m)    {$g=0;}
  1104.                     #elsif($r<$m) {$r=0;}
  1105.                     #elsif($b<$m) {$b=0;}
  1106.                 }
  1107.             } elsif(0) {
  1108.                 my($n) = $r;
  1109.                 $n = $g if $g<$n;
  1110.                 $n = $b if $b<$n;
  1111.                 if($n<$m/8) {
  1112.                     $r = 0 if $r <= $n*2;
  1113.                     $g = 0 if $g <= $n*2;
  1114.                     $b = 0 if $b <= $n*2;
  1115.                 }
  1116.             }
  1117.             push(@t, ((($b<<10)|$g)<<10)|$r);
  1118.         }
  1119.     }
  1120.  
  1121.     if(1) {
  1122.         # on elimine les composantes plus faibles que 10% du max
  1123.         @r = @t; @t = ();
  1124.         for($i=0; $i<=$#r; $i+=8) {
  1125.             my($maxr, $maxv, $maxb) = (0, 0, 0);
  1126.             my($minr, $minv, $minb) = (1, 1, 1);
  1127.             my($rgb, @rgb);
  1128.             my(@o) = @r[$i..$i+7];
  1129.             for $rgb (@o) {
  1130.                 @rgb = &irgb2rgb($rgb);
  1131.                 $maxr = $rgb[0] if $rgb[0] > $maxr;
  1132.                 $maxv = $rgb[1] if $rgb[1] > $maxv;
  1133.                 $maxb = $rgb[2] if $rgb[2] > $maxb;
  1134.                 $minr = $rgb[0] if $rgb[0] < $minr;
  1135.                 $minv = $rgb[1] if $rgb[1] < $minv;
  1136.                 $minb = $rgb[2] if $rgb[2] < $minb;
  1137.             }
  1138.             $maxr = (1-$thr)*$minr + $thr*$maxr;
  1139.             $maxv = (1-$thr)*$minv + $thr*$maxv;
  1140.             $maxb = (1-$thr)*$minb + $thr*$maxb;
  1141.             for $rgb (@o) {
  1142.                 @rgb = &irgb2rgb($rgb);
  1143.                 $rgb[0] = $minr if $rgb[0] < $maxr;
  1144.                 $rgb[1] = $minv if $rgb[1] < $maxv;
  1145.                 $rgb[2] = $minb if $rgb[2] < $maxb;
  1146.                 #$rgb[0] = $maxr if $rgb[0] > $maxr;
  1147.                 #$rgb[1] = $maxv if $rgb[1] > $maxv;
  1148.                 #$rgb[2] = $maxb if $rgb[2] > $maxb;
  1149.                 $t  = int($rgb[0]*255)&0x1ff; $t<<=10;
  1150.                 $t += int($rgb[1]*255)&0x1ff; $t<<=10;
  1151.                 $t += int($rgb[2]*255)&0x1ff;
  1152.                 push(@t, $t);
  1153.             }
  1154.         }
  1155.     }
  1156.    
  1157.     if(0) {
  1158.         my($min, $max) = (32,128);
  1159.         my($mi2) = $min>>1;
  1160.         my($p, $x, $y);
  1161.         for($p=$y=0; $y<200; ++$y) {
  1162.             for($x=0; $x<320; ++$x) {
  1163.                 $p = 320*$y+$x;
  1164.                 my($rvb) = $t[$p];
  1165.                 my($r) = ($rvb>>00) & 0x1FF;
  1166.                 my($g) = ($rvb>>10) & 0x1FF;
  1167.                 my($b) = ($rvb>>20) & 0x1FF;
  1168.                 $r=0 if $r&0x100;
  1169.                 $g=0 if $g&0x100;
  1170.                 $b=0 if $b&0x100;
  1171.                 my($m) = $r; $m = $g if $g>$m; $m = $b if $b>$m; $m=$max+1;
  1172.                 $r = ($r<$mi2 ? 0:$min) if $r<$min && $m>$max;
  1173.                 $g = ($g<$mi2 ? 0:$min) if $g<$min && $m>$max;
  1174.                 $b = ($b<$mi2 ? 0:$min) if $b<$min && $m>$max;
  1175.                 $t[$p] = ((($b<<10)|$g)<<10)|$r;      
  1176.                 $rvb = &irgb_sub($rvb, $t[$p]);
  1177.                 #print " /_\\ = ", &irgb2hex($rvb), "\n";
  1178.                 $t[$p + 319] = &irgb_add_cln($t[$p + 319], &irgb_map($rvb, \@glb_map0)) if $glb_err0 && $y<199 && $x>0;
  1179.                 $t[$p + 320] = &irgb_add_cln($t[$p + 320], &irgb_map($rvb, \@glb_map1)) if $glb_err1 && $y<199;
  1180.                 $t[$p + 321] = &irgb_add_cln($t[$p + 321], &irgb_map($rvb, \@glb_map2)) if $glb_err2 && $y<199 && $x<319;
  1181.                 $t[$p + 001] = &irgb_add_cln($t[$p + 001], &irgb_map($rvb, \@glb_map3)) if $glb_err3 &&           $x<319;
  1182.             }
  1183.         }
  1184.     }
  1185.  
  1186.     #&write_image("zzz.png", @t);
  1187.        
  1188.     return @t;
  1189. }
  1190.  
  1191. sub sq {
  1192.     return $_[0]*$_[0];
  1193. }
  1194.  
  1195. sub xint {
  1196.     if(0) {
  1197.     # round to even?
  1198.     my($t) = @_;
  1199.     # round to even
  1200.     my($halfway) = int($t*2)==$t*2;
  1201.     if($t>=0) {$t = int($t + 0.5);} else {$t = int($t - 0.5);}
  1202.     if($halfway) {$t = int($t/2)*2;}
  1203.     return $t;
  1204.     }
  1205.  
  1206.     return   int($_[0]);
  1207.     return   int(0.5 + $_[0]) if $_[0]>=0;
  1208.     return - int(0.5 - $_[0]);
  1209. }
  1210.  
  1211. sub write_map {
  1212.     my($name, @px) = @_;
  1213.    
  1214.     my($i, $t);
  1215.    
  1216.     # récupération de la palette RGB
  1217.     my(%pal);
  1218.     foreach $i (@px) {++$pal{$i};}  
  1219.        
  1220.     #my(@t) = (sort { $pal{$b} - $pal{$a} } keys %pal);
  1221.     my(@t) = (sort { &irgb_module($a) - &irgb_module($b) } keys %pal);
  1222.     die "trop de couleurs ($#t)" if $#t>15;
  1223.     @t = (@t, (0) x 15)[0..15];
  1224.    
  1225.     # pour le tour on utilise la couleur la plus sombre
  1226.     @t = ($t[0], $t[15], @t[1..14]);
  1227.     my($tour) = 0;
  1228.     for($i=0; $i<15; ++$i)  {
  1229.         $tour = $i if &irgb_module($t[$i])<&irgb_module($t[$tour]);
  1230.     }
  1231.    
  1232.     # pour que l'afficheur de préhisto marche, il faut que le tour soit
  1233.     # d'indexe fixe. On fait en sorte que ce soit toujours 0
  1234.     if($tour != 0) {
  1235.         my($t) = $t[$tour];
  1236.         $t[$tour] = $t[0];
  1237.         $t[0] = $t;
  1238.         $tour = 0;
  1239.     }
  1240.    
  1241.     # conversion de la palette vers les intensités thomson
  1242.     my(@pal, %rgb2pal);
  1243.     foreach $i (@t) {
  1244.             $rgb2pal{$i} = ($#pal + 1)>>1;
  1245.            
  1246.             my($v, $j, $d, $m, $p);
  1247.            
  1248.             $v = $i & 255; $i>>=10; #print "$v ";
  1249.             for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
  1250.                 $d = $ef_vals[$j] - $v; $d = -$d if $d<0;
  1251.                 if($d<$m) {$m = $d; $p = $j;}
  1252.             }
  1253.             my($b) = $p;
  1254.             $v = $i & 255; $i>>=10; #print "$v ";
  1255.             for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
  1256.                 $d = $ef_vals[$j] - $v; $d = -$d if $d<0;
  1257.                 if($d<$m) {$m = $d; $p = $j;}
  1258.             }
  1259.             my($g) = $p;
  1260.             $v = $i & 255; $i>>=10; #print "$v ";
  1261.             for($m=1e30, $j = 0; $j<=$#ef_vals; ++$j) {
  1262.                 $d = $ef_vals[$j] - $v; $d = -$d if $d<0;
  1263.                 if($d<$m) {$m = $d; $p = $j;}
  1264.             }
  1265.             my($r) = $p;
  1266.            
  1267.             push(@pal, $b, $g*16 + $r);
  1268.         }
  1269.  
  1270.     @t = ();
  1271.    
  1272.     # construction rama / ramb
  1273.     my(@ram);
  1274.     for(my $p=0; $p<$#px; $p+=2) {
  1275.         push(@ram, $rgb2pal{$px[$p]}*16 + $rgb2pal{$px[$p+1]});
  1276.     }
  1277.    
  1278.     # compression à proprement parler
  1279.     my(@data);
  1280.     push(@data,
  1281.         # bm 16
  1282.         0x40,
  1283.         # ncols-1
  1284.         79,
  1285.         # nlines-1
  1286.         24,
  1287.         # ram a
  1288.         &to7_comp(@ram),
  1289.         0, 0);
  1290.    
  1291.     # if faut aligner l'extension sur une addr paire
  1292.     push(@data, 0) unless $#data & 1;
  1293.    
  1294.     push(@data,
  1295.         # to-snap
  1296.         0, 0, 0, $tour, 0, 0, @pal, 0xa5, 0x5a);
  1297.  
  1298.     # ecriture fichier binaire
  1299.     open(OUT, ">$name");
  1300.     print OUT pack('C*', 0, int((1+$#data)/256), (1+$#data)&255, 0, 0);
  1301.     print OUT pack('C*', @data);
  1302.     print OUT pack('C*', 255, 0, 0, 0, 0);
  1303.     close(OUT);
  1304. }
  1305.  
  1306. sub to7_comp {
  1307.     my(@data) = @_;
  1308.     my(@result, @partial);
  1309.    
  1310.     for(my $p=0; $p<16000; ++$p) {
  1311.         # on lit car num fois
  1312.         my($num, $car) = (1, $data[($p % 200)*80 + int($p/200)]);
  1313.         while($num<255 && $p+1<16000 && $data[(($p+1) % 200)*80 + int(($p+1)/200)]==$car) {++$p; ++$num;}
  1314.         my($default) = 1;
  1315.         if($#partial>$[) {
  1316.             # 01 aa 01 bb ==> 00 02 aa bb
  1317.             if($default && $num==1 && $partial[0]==1) {@partial = (00, 02, $partial[1], $car); $default = 0;}
  1318.             # 00 n xx xx xx 01 bb ==> 00 n+1 xx xx xx bb
  1319.             if($default && $num==1 && $partial[0]==0 && $partial[1]<255) {push(@partial, $car); $partial[1]++; $default = 0;}
  1320.             # 00 n xx xx xx 02 bb ==> 00 n+2 xx xx xx bb bb (pas utile mais sert quand combiné à la regle ci-dessus)
  1321.             if($default && $num==2 && $partial[0]==0 && $partial[1]<254) {push(@partial, $car, $car); $partial[1]+=2; $default = 0;}
  1322.             # 01 aa 02 bb ==> 00 03 aa bb bb
  1323.         }        
  1324.         if($default) {push(@result, @partial); @partial = ($num, $car);}
  1325.     }
  1326.     push(@result, @partial);
  1327.    
  1328.     return @result;
  1329. }
  1330.  
  1331. sub wd_file {
  1332.     return "rgb/.watchdog";
  1333. }
  1334.  
  1335. sub reset_wd {
  1336.     unlink &wd_file;
  1337. }
  1338.  
  1339. sub start_wd {
  1340.     my($pause) = 300;
  1341.     my($child) = fork;
  1342.     die "fork failed" unless defined $child;
  1343.     return unless $child;
  1344.     while(-e "$stopme") {
  1345.         for($i=0; $i<20 && -e "$stopme"; ++$i) {sleep($pause/20);}
  1346.         my($f) = &wd_file;
  1347.         if(-f $f) {
  1348.             reset_wd;
  1349.             kill 9, $child;
  1350.             die "Watch dog detected inactivity for $pause sec, exiting";
  1351.         } else {
  1352.             open(WDFILE,">$f");close(WDFILE);
  1353.         }
  1354.     }
  1355. }
  1356.  
  1357.  
  1358. sub blur {
  1359.     my($size, @px) = @_;
  1360.    
  1361.     return @px unless $size>0;
  1362.    
  1363.     my($sigma2) = 2*$size*$size;
  1364.     my($coef) = 1/sqrt(3.141592*$sigma2);
  1365.     my($len) = 0;
  1366.     while($coef * exp(-($len/$sigma2)*$len)>1/256) {++$len;}
  1367.    
  1368.     print STDERR "blur len=$len\n";
  1369.    
  1370.     my(@kernel);
  1371.     for my $i (0..$len-1) {
  1372.         my $c = $coef*exp(-($i/$sigma2)*$i);
  1373.         my(@t) = (0)x512;
  1374.         for $j (0..255) {$t[$j] = int($j*$c+.5);}
  1375.         $kernel[$i] = [@t];
  1376.     }
  1377.    
  1378.     my(@r) = (0) x (320*200);
  1379.     for my $y (0..199) {
  1380.         for my $x (0..319) {
  1381.             my($p) = $x + 320*$y;
  1382.             $r[$p] = &irgb_map($px[$p], $kernel[0]);
  1383.             for my $i (1..$len-1) {
  1384.                 my($j) = $i*320;
  1385.                 $r[$p] = &irgb_uadd($r[$p], &irgb_map($px[$p+$i], $kernel[$i])) if $x+$i<320;
  1386.                 $r[$p] = &irgb_uadd($r[$p], &irgb_map($px[$p-$i], $kernel[$i])) if $x-$i>=0;
  1387.             }
  1388.         }
  1389.     }
  1390.     @px = @r; @r = (0) x (320x200);
  1391.     for my $y (0..199) {
  1392.         for my $x (0..319) {
  1393.             my($p) = $x + 320*$y;
  1394.             $r[$p] = &irgb_map($px[$p], $kernel[0]);
  1395.             for my $i (1..$len-1) {
  1396.                 my($j) = $i*320;
  1397.                 $r[$p] = &irgb_uadd($r[$p], &irgb_map($px[$p+$j], $kernel[$i])) if $y+$i<200;
  1398.                 $r[$p] = &irgb_uadd($r[$p], &irgb_map($px[$p-$j], $kernel[$i])) if $y-$i>=0;
  1399.             }
  1400.         }
  1401.     }
  1402.    
  1403.     &write_image("rgb/.blur.png", @r);
  1404.    
  1405.     return @r;
  1406. }
  1407.  
  1408. ##########################################################################################
  1409. # reduction de palette TO9
  1410.  
  1411. sub to9_pal {
  1412.     my($max, @px) = @_;
  1413.    
  1414.     #my(@t) = simple_dither(1, @px);
  1415.     #for(my $i=0; $i<$#t; $i+=3) {$px[$i/3] = ($t[$i]<<20)|($t[$i+1]<<10)|$t[$i+2];}
  1416.    
  1417.     # map PC -> thomson
  1418.     my(@pc2ef);
  1419.     for(my $i=0; $i<256; ++$i) {
  1420.         my($best) = 1000;
  1421.         for(my $j=0; $j<=$#ef_vals; ++$j) {
  1422.             my($d) = $i - $ef_vals[$j];
  1423.             $d = -$d if $d<0;
  1424.             if($d < $best) {$best = $d; $pc2ef[$i] = $j;}
  1425.         }
  1426.     }
  1427.    
  1428.     # floutage
  1429.     #@px = &blur(0.8, @px);
  1430.        
  1431.     my($tree) = []; $tree->[0] = [-1, (0)x(8+7)];
  1432.     for my $px (@px) {
  1433.         my($r) = $px>>20;
  1434.         my($g) = ($px>>10)&255;
  1435.         my($b) = $px&255;
  1436.        
  1437.         #&nd_add($tree, $r, $g, $b, \@pc2ef);
  1438.        
  1439.         my($m) = $r; $m = $g if $g>$m; $m = $b if $b>$m;
  1440.        
  1441.         if($m>0) {
  1442.             my($n) = $map_ef[$m];
  1443.            
  1444.             $n = $ef_vals[1]  if $m<$ef_vals[1];
  1445.             #$n = $ef_vals[2]  if $m<$ef_vals[2];
  1446.             #$n = $ef_vals[14] if $m>$ef_vals[13];
  1447.             $n = $ef_vals[15] if $m>$ef_vals[14];
  1448.            
  1449.             $r = int(($r*$n)/$m+.5);   
  1450.             $g = int(($g*$n)/$m+.5);
  1451.             $b = int(($b*$n)/$m+.5);
  1452.         }
  1453.        
  1454.         &nd_add($tree, $r, $g, $b, \@pc2ef);
  1455.     }
  1456.    
  1457.     &nd_sum($tree, 0);
  1458.    
  1459.     my(%sel); $sel{0} = 1;
  1460.     while (scalar keys %sel < $max-1) {
  1461.         my(@chld) = ();
  1462.         for my $nd (keys %sel) {push(@chld, &nd_child($tree,$nd));}
  1463.         last unless $#chld>=0;
  1464.         my($best) = shift(@chld);
  1465.         for my $nd (@chld) {
  1466.             $best = $nd if
  1467.                 #&nd_eval($tree, $nd, keys %sel) < &nd_eval($tree, $best, keys %sel);
  1468.                 &nd_cmp($tree, $nd, $best)<0;
  1469.         }
  1470.         $sel{$best} = 1;
  1471.         if(&nd_detach($tree, $best) == 0) {
  1472.             my($par) = &nd_parent($tree, $best);
  1473.             delete $sel{$par};
  1474.         }
  1475.         #my($var) = 0;
  1476.         #for my $nd (keys %sel) {$var += &nd_var(&nd_nrgb($tree,$nd));}
  1477.         #print scalar keys %sel, " = ", &nd_str($tree, $best, \@pc2ef), " ", 1+$#chld, "\n";
  1478.     }
  1479.  
  1480.     my(@candidates) = keys %sel;
  1481.     for my $nd (@candidates) {&nd_cleanup($tree, $nd);}
  1482.     print STDERR "ncols=", 1+$#candidates,"\n";
  1483.    
  1484.     # palette
  1485.     my(@pal) = 0;
  1486.     print STDERR &irgb2hex($pal[0]), "\n";
  1487.     for my $nd (@candidates) {
  1488.         print STDERR &nd_str($tree, $nd, \@pc2ef), "\n";
  1489.         my(@t) = &nd_nrgb($tree, $nd);
  1490.         my($r, $g, $b) = ($t[1]/$t[0], $t[2]/$t[0], $t[3]/$t[0]);
  1491.        
  1492.         # cas spécial pour les petites intensités: le max est arrondi vers le haut
  1493.         my($m) = $r; $m = $g if $g>$m; $m = $b if $b>$m;
  1494.         if(0 && $map_ef[$m] == $ef_vals[1]) {
  1495.             $r = $ef_vals[0] if $r<=$m*.5;
  1496.             $g = $ef_vals[0] if $g<=$m*.5;
  1497.             $b = $ef_vals[0] if $b<=$m*.5;
  1498.         }
  1499.         if(1 && $map_ef[$m] == $ef_vals[1]) {
  1500.             $r = $ef_vals[0] if $r<$m*.8;
  1501.             $g = $ef_vals[0] if $g<$m*.8;
  1502.             $b = $ef_vals[0] if $b<$m*.8;
  1503.         }
  1504.            
  1505.         $r = int($r + 0*($r>=128?0.5:0));
  1506.         $g = int($g + 0*($g>=128?0.5:0));
  1507.         $b = int($b + 0*($b>=128?0.5:0));
  1508.         my($rgb) = ($map_ef[$r]<<20) | ($map_ef[$g]<<10) | $map_ef[$b];
  1509.         push(@pal, $rgb);
  1510.     }
  1511.        
  1512.     # on complète avec 0
  1513.     @pal = (@pal, ($pal[0])x$max)[0..$max-1];
  1514.    
  1515.     # conversion en mode PC
  1516.     #for my $i (0..$max-1) {
  1517.     #   my($rgb) = $pal[$i];
  1518.     #   my($r) = $ef_vals[$rgb>>8];
  1519.     #   my($g) = $ef_vals[($rgb>>4)&15];
  1520.     #   my($b) = $ef_vals[$rgb&15];
  1521.     #   $pal[$i] = ((($r<<10)|$g)<<10)|$b;
  1522.     #}
  1523.    
  1524.     return @pal;
  1525. }
  1526.  
  1527. sub nd_cleanup {
  1528.     my($tree, $nd) = @_;
  1529.  
  1530.     my(@c) = &nd_child($tree, $nd);
  1531.     if(@c) {for my $i (1..7) {$tree->[$nd]->[$i] = 0;}}
  1532.     for my $i (@c) {&nd_cleanup($tree, $i);}
  1533.     for my $i (sort {&nd_satur($tree,$b)<=>&nd_satur($tree,$a)} @c) {
  1534.     #print &nd_str($tree, $i), " \n";
  1535.     &nd_prune($tree, $i);}
  1536. }
  1537.  
  1538. sub nd_eval {
  1539.     my($tree, $nd, @nd) = @_;
  1540.    
  1541.    
  1542.     my($var) = 0;
  1543.     for my $i (@nd) {$var += &nd_err(&nd_nrgb($tree,$i));}
  1544.    
  1545.     my(@p) = &nd_nrgb($tree, &nd_parent($tree, $nd));
  1546.     my(@n) = &nd_nrgb($tree, $nd);
  1547.     my(@m) = &vec_sub(@p, @n);
  1548.    
  1549.     #return -&nd_var(@n);
  1550.  
  1551.     #return -$n[0];
  1552.    
  1553.     $var -= &nd_err(@p);
  1554.     $var += &nd_err(@n);
  1555.     $var += &nd_err(@m);
  1556.  
  1557.     return $var;
  1558. }
  1559.    
  1560. sub nd_sum {
  1561.     my($tree, $nd) = @_;
  1562.    
  1563.     for my $c (&nd_child($tree, $nd)) {
  1564.         &nd_sum($tree, $c);
  1565.         for my $i (1..7) {$tree->[$nd]->[$i] += $tree->[$c]->[$i];}
  1566.     }
  1567. }
  1568.  
  1569. sub nd_prune {
  1570.     my($tree, $nd) = @_;
  1571.     my($parent) = &nd_parent($tree, $nd);
  1572.     my($tol) = .8;
  1573.     my($make_sat) = # si l'element majoritaire est saturé ==> on force à garder la saturation
  1574.         (($tree->[$parent]->[1] >= $tree->[$nd]->[1]*$tol) && (&nd_satur($tree, $parent)>.8))
  1575.         ||
  1576.         (($tree->[$parent]->[1]*$tol <= $tree->[$nd]->[1]) && (&nd_satur($tree, $nd)>.8));
  1577.  
  1578.     for my $i (1..7) {
  1579.         $tree->[$parent]->[$i] += $tree->[$nd]->[$i];
  1580.         $tree->[$nd]->[$i] = 0;
  1581.     }
  1582.     if(0 && $make_sat) {
  1583.         my($r) = $map_ef[$tree->[$parent]->[2]];
  1584.         my($g) = $map_ef[$tree->[$parent]->[3]];
  1585.         my($b) = $map_ef[$tree->[$parent]->[4]];
  1586.  
  1587.         my($m) = $r; $m=$g if $g>$m; $m=$b if $b>$m;
  1588.         $tree[$parent]->[2] = $tree[$parent]->[5] = 0 if $r<$m;
  1589.         $tree[$parent]->[3] = $tree[$parent]->[6] = 0 if $g<$m;
  1590.         $tree[$parent]->[4] = $tree[$parent]->[7] = 0 if $b<$m;
  1591.  
  1592.         $tree[$parent]->[2] = $m if $r==$m;
  1593.         $tree[$parent]->[3] = $m if $g==$m;
  1594.         $tree[$parent]->[4] = $m if $b==$m;
  1595.     }
  1596. }
  1597.  
  1598. sub nd_detach {
  1599.     my($tree, $nd) = @_;
  1600.    
  1601.     my($parent) = &nd_parent($tree, $nd);
  1602.    
  1603.     for my $i (8..15) {
  1604.         if($tree->[$parent]->[$i] == $nd) {$tree->[$parent]->[$i] = 0; last;}
  1605.     }
  1606.    
  1607.     for my $i (1..7) {
  1608.         $tree->[$parent]->[$i] -= $tree->[$nd]->[$i];
  1609.     }
  1610.     #$tree->[$nd]->[0] = -1;
  1611.  
  1612.     return $tree->[$parent]->[1];
  1613. }
  1614.  
  1615. sub nd_add {
  1616.     my($tree, $r, $g, $b, $pc2ef) = @_;
  1617.    
  1618.     if(1) {
  1619.         my($m) = 0.3*$r + 0.59*$g + 0.11*$b;
  1620.         my($o) = 1/4;
  1621.         $r = ($r-$m)*(1+$o)+$m;
  1622.         $g = ($g-$m)*(1+$o)+$m;
  1623.         $b = ($b-$m)*(1+$o)+$m;
  1624.         $r=0 if $r<0; $r=255 if $r>255;
  1625.         $g=0 if $g<0; $g=255 if $g>255;
  1626.         $b=0 if $b<0; $b=255 if $b>255;
  1627.     }
  1628.    
  1629.     if(0) {
  1630.         my($m) = $r;
  1631.         $m = $g if $g>$m;
  1632.         $m = $b if $b>$m;
  1633.         $m = $m==0?1:
  1634.         #$m<64?64/$m:
  1635.         $m<128?128/$m:
  1636.         #$m<196?196/$m:
  1637.         255/$m;
  1638.         $r = int($r*$m);
  1639.         $g = int($g*$m);
  1640.         $b = int($b*$m);
  1641.     }
  1642.  
  1643.     # make saturated colors "pure"
  1644.     if(0) {
  1645.         my($ir) = $map_ef[$r];
  1646.         my($ig) = $map_ef[$g];
  1647.         my($ib) = $map_ef[$b];
  1648.         my($m) = $ir; $m=$ib if $ib>$m; $m=$ig if $ig>$m;
  1649.         my($sat, $t) = (1, $m*.9);
  1650.         $sat = 0 if $ir>0 && $ir<$t;
  1651.         $sat = 0 if $ig>0 && $ig<$t;
  1652.         $sat = 0 if $ib>0 && $ib<$t;
  1653.         if($sat) {
  1654.             #print STDERR "$r,$g,$b=>";
  1655.             $r = $ir>=$t?$m:0;
  1656.             $g = $ig>=$t?$m:0;
  1657.             $b = $ib>=$t?$m:0;
  1658.             #print STDERR "$r,$g,$b\n";
  1659.         }
  1660.     }
  1661.    
  1662.     if(0) {
  1663.     my($z) = int($ef_vals[1]/2+.5);
  1664.  
  1665.     $r=$z if $r>0 && $r<$z;
  1666.     $g=$z if $g>0 && $g<$z;
  1667.     $b=$z if $b>0 && $b<$z;
  1668.     }
  1669.    
  1670.     if(0) {
  1671.         my($z) = int($ef_vals[1]*.6);
  1672.        
  1673.         $r = 0 if $r<$z && ($g>$z||$b>$z);
  1674.         $g = 0 if $g<$z && ($r>$z||$b>$z);
  1675.         $b = 0 if $b<$z && ($r>$z||$g>$z);
  1676.        
  1677.         $r = $ef_vals[1] if $r > 0 && $r<$ef_vals[1];
  1678.         $g = $ef_vals[1] if $g > 0 && $g<$ef_vals[1];
  1679.         $b = $ef_vals[1] if $b > 0 && $b<$ef_vals[1]
  1680.     }
  1681.    
  1682.     if(0) {
  1683.         my($m) = $r;
  1684.         $m = $g if $g>$m;
  1685.         $m = $b if $b>$m;
  1686.         my($t) = $m*.25;
  1687.         my($o) = .25;
  1688.         $o = $ef_vals[2]*$o+$ef_vals[1]*(1-$o);
  1689.         $t = $o if $t<$o;
  1690.         $r = 0 if $r<$t;
  1691.         $g = 0 if $g<$t;
  1692.         $b = 0 if $b<$t;
  1693.     }
  1694.    
  1695.     my($rgb) = ($pc2ef->[$r]<<8) | ($pc2ef->[$g]<<4) | $pc2ef->[$b];
  1696.    
  1697.     return unless $rgb;
  1698.  
  1699.     my($nd) = 0;
  1700.     for(my $j=0; $j<4; ++$j, $rgb<<=1) {
  1701.         my($ix) = 8;
  1702.         $ix += 4 if $rgb & 0x800;
  1703.         $ix += 2 if $rgb & 0x080;
  1704.         $ix += 1 if $rgb & 0x008;
  1705.         my($k) = $tree->[$nd]->[$ix];
  1706.         if($k==0) {
  1707.             $k = $tree->[$nd]->[$ix] = 1+$#{$tree};
  1708.             $tree->[$k] = [$nd, (0)x(7+8)];
  1709.         }
  1710.         $nd = $k;
  1711.     }
  1712.    
  1713.     my($mult, $c, $p) = (1, 100, 10);
  1714.    
  1715.     #($c, $p) = (2, 2);
  1716.     #($c, $p) = (7, 4);
  1717.     ($c, $p) = (9, 2);
  1718.    
  1719.     my($c1, $p1) = (8, 2);
  1720.     my($c2, $p2) = (3, 4);
  1721.    
  1722.     #($c1, $p1, $c2, $p2) = (8, 3, 1, 3.88);
  1723.     #$c1 = $c2 = 0;
  1724.    
  1725.     ($c1, $p1, $c2, $p2) = (8, 2, 4, 64);
  1726.    
  1727.     $mult =
  1728.     #(1+$c*(abs($r-128)/128)**$p) * (1+$c*(abs($g-128)/128)**$p) * (1+$c*(abs($b-128)/128)**$p);
  1729.     #(1+$c*(abs(255-$r)/255)**$p) * (1+$c*(abs(255-$g)/255)**$p) * (1+$c*(abs(255-$b)/255)**$p);
  1730.     (1+$c1*((1-$r/255)**$p1)+$c2*(($r/255)**$p2)) *
  1731.     (1+$c1*((1-$g/255)**$p1)+$c2*(($g/255)**$p2)) *
  1732.     (1+$c1*((1-$b/255)**$p1)+$c2*(($b/255)**$p2));
  1733.    
  1734.     if(1) {
  1735.         $mult = 1;
  1736.         my($m) = $r;
  1737.         $m = $g if $g>$m;
  1738.         $m = $b if $b>$m;
  1739.         if($m>0) {
  1740.             $m /= 255;
  1741.             my($x, $y, $z) = ($r/255, $g/255, $b/255);
  1742.             ($x, $y, $z) = ($x/$m, $y/$m, $z/$m);
  1743.             my($s) = ($x+$y+$z)/3;
  1744.             my($d) = sqrt(1.5*(($x-$s)**2+($y-$s)**2+($z-$s)**2));
  1745.            
  1746.             die $d if $d>1;
  1747.            
  1748.             # pas mal, un peu pixelisé
  1749.             #$mult = 1+$d**2;
  1750.             #$mult *= 9 if $r<$ef_vals[2];
  1751.             #$mult *= 9 if $g<$ef_vals[2];
  1752.             #$mult *= 9 if $b<$ef_vals[2];
  1753.            
  1754.             #$mult = int(1+31*$d**3);
  1755.             $mult = 1+15*$d**3;
  1756.             #$mult = 1+$d**8;
  1757.             #$mult = 1+7*$d**8;
  1758.             #$mult = 1+8*$d**4;
  1759.            
  1760.             #$mult = 1;
  1761.             #$mult *= 4 if $d>0.88;
  1762.             #$mult *= 2 if $d>0.95;
  1763.             #$mult = 2 if $d*16 > 14;
  1764.             #$mult = 4 if $d*16 > 15;
  1765.             #$mult *= 4 if $pc2ef->[int($s)]>=14;
  1766.             #my($t) = ($ef_vals[2]+$ef_vals[1])/2;
  1767.             #$mult *= 2 if $r<$t;
  1768.             #$mult *= 2 if $g<$t;
  1769.             #$mult *= 2 if $b<$t;
  1770.             #$mult *= 2 if $m*255<$t;
  1771.            
  1772.             #$mult = 8 if $x == 1 || $y == 1 || $z == 1;+ $x + $y + $z);
  1773.            
  1774.             #$mult = 1;
  1775.         }
  1776.     }
  1777.    
  1778.     if(0) {
  1779.     $mult = 1; $c=8; #6
  1780.     $mult *= $c if $pc2ef->[$r]<=0;
  1781.     $mult *= $c if $pc2ef->[$g]<=0;
  1782.     $mult *= $c if $pc2ef->[$b]<=0;
  1783.    
  1784.     $mult *= $c if $pc2ef->[$r]<=1;
  1785.     $mult *= $c if $pc2ef->[$g]<=1;
  1786.     $mult *= $c if $pc2ef->[$b]<=1;
  1787.    
  1788.     #$mult *= $c if $pc2ef->[$r]>=14;
  1789.     #$mult *= $c if $pc2ef->[$g]>=14;
  1790.     #$mult *= $c if $pc2ef->[$b]>=14;
  1791.     }
  1792.    
  1793.     #$mult = 1;
  1794.    
  1795.     # 0 = parent
  1796.     $tree->[$nd]->[1] += $mult;
  1797.     $tree->[$nd]->[2] += $r*$mult;
  1798.     $tree->[$nd]->[3] += $g*$mult;
  1799.     $tree->[$nd]->[4] += $b*$mult;
  1800.     $tree->[$nd]->[5] += $r*$r*$mult;
  1801.     $tree->[$nd]->[6] += $g*$g*$mult;
  1802.     $tree->[$nd]->[7] += $b*$b*$mult;
  1803.     # 8-> 15 = child
  1804. }
  1805.  
  1806. sub nd_str {
  1807.     my($tree, $nd, $pc2ef) = @_;
  1808.     my(@z) = &nd_nrgb($tree, $nd);
  1809.    
  1810.     for my $i (1..3) {$z[$i] = int($z[$i]/($z[0]?$z[0]:1));}
  1811.    
  1812.     return sprintf("(%-4d: d=%d p=%-4d s=%d n=%-8d z=%-5.2f rgb=%x%x%x:%03d,%03d,%03d)",
  1813.         $nd, &nd_depth($tree,$nd), &nd_parent($tree, $nd), &nd_nchild($tree, $nd),
  1814.         $z[0], &nd_stderr(&nd_nrgb($tree,$nd)),
  1815.         $pc2ef->[$z[1]], $pc2ef->[$z[2]], $pc2ef->[$z[3]],
  1816.         $z[1], $z[2], $z[3]);
  1817. }
  1818.  
  1819. sub vec_add {
  1820.     my (@t) = @_;
  1821.     my($r, @r) = ($#t+1)>>1;
  1822.     for my $i (0..$r-1) {$r[$i] = $t[$i] + $t[$i + $r];}
  1823.     return @r;
  1824. }
  1825.  
  1826. sub vec_sub {
  1827.     my (@t) = @_;
  1828.     my($r, @r) = ($#t+1)>>1;
  1829.     for my $i (0..$r-1) {$r[$i] = $t[$i] - $t[$i + $r]; $r[$i]=0 if $r[$i]<0.001;}
  1830.     #$r[0] = 0 if $r[0]<0.01;
  1831.     return @r;
  1832. }
  1833.  
  1834. sub cmp_aux {
  1835.     my(@t) = @_;
  1836.     for(my $i=0; $i<$#t; $i+=2) {
  1837.         my($c) = $t[$i]<=>$t[$i+1];
  1838.         return $c if $c;
  1839.     }
  1840.    
  1841.     return 0;
  1842. }
  1843.  
  1844. # compare deux noeds
  1845. sub nd_cmp {
  1846.     my($tree, $a, $b) = @_;
  1847.    
  1848.     my($pa) = &nd_parent($tree, $a);
  1849.     my($pb) = &nd_parent($tree, $b);
  1850.    
  1851.     my(@npa) = &nd_nrgb($tree, $pa);
  1852.     my(@npb) = &nd_nrgb($tree, $pb);
  1853.     my(@na)  = &nd_nrgb($tree, $a);
  1854.     my(@nb)  = &nd_nrgb($tree, $b);
  1855.     my(@ma)  = &vec_sub(@npa, @na);
  1856.     my(@mb)  = &vec_sub(@npb, @nb);
  1857.    
  1858.     return (&nd_err(@ma) + &nd_err(@na) - &nd_err(@npa)) <=> (&nd_err(@mb) + &nd_err(@nb) - &nd_err(@npb));
  1859. }
  1860.  
  1861. # nb d'enfants du noeud courant
  1862. sub nd_nchild  {
  1863.     my($tree, $nd) = @_;
  1864.     my(@t) = @{$tree->[$nd]};
  1865.     my($r) = 0;
  1866.     for my $i (8..15) {++$r if $t[$i];}
  1867.     return $r;
  1868. }
  1869.  
  1870. # les enfants d'un noeuds
  1871. sub nd_child {
  1872.     my($tree, $nd) = @_;
  1873.     my(@t) = @{$tree->[$nd]};
  1874.     my(@r) = ();
  1875.     for my $i (8..15) {push(@r, $t[$i]) if $t[$i];}
  1876.     return @r;
  1877. }
  1878.  
  1879. # intensité moyene (entre 0 et 1) du noeud
  1880. sub nd_intens {
  1881.     my($tree, $nd) = @_;
  1882.     my(@t) = &nd_nrgb($tree, $nd); 
  1883.     $t[1] /= $t[0]*255;
  1884.     $t[2] /= $t[0]*255;
  1885.     $t[3] /= $t[0]*255;
  1886.  
  1887.     return ($t[1] + $t[2] + $t[3])/3;
  1888. }
  1889.  
  1890. sub my_die {
  1891.     my $i = 1;
  1892.     print "Stack Trace:\n";
  1893.     while ( (my @call_details = (caller($i++))) ){
  1894.         print $call_details[1].":".$call_details[2]." in function ".$call_details[3]."\n";
  1895.     }
  1896.     die @_;
  1897. }
  1898.  
  1899. # saturation d'un noeud
  1900. sub nd_satur {
  1901.     my($tree, $nd) = @_;
  1902.     my(@t) = &nd_nrgb($tree, $nd);
  1903.     &my_die(&nd_str($tree, $nd, \@pc2ef)) unless $t[0];
  1904.     $t[1] /= $t[0]*255;
  1905.     $t[2] /= $t[0]*255;
  1906.     $t[3] /= $t[0]*255;
  1907.     my($m) = $t[1]; $m = $t[2] if $t[2]>$m; $m = $t[3] if $t[3]>$m;
  1908.    
  1909.     $t[1] /= $m;
  1910.     $t[2] /= $m;
  1911.     $t[3] /= $m;
  1912.     $m = ($t[1] + $t[2] + $t[3])/3;
  1913.    
  1914.     return sqrt(1.5*(($t[1]-$m)**2 + ($t[2]-$m)**2 + ($t[3]-$m)**2));
  1915. }
  1916.  
  1917. # ecart type d'un noeud
  1918. sub nd_stderr {
  1919.     return sqrt(&nd_var(@_));
  1920. }
  1921.  
  1922. # variance d'un noeud
  1923. sub nd_var {
  1924.     my($n, $r,$g,$b, $r2,$g2,$b2) = @_;
  1925.     $n=1 unless $n; my($n2) = $n*$n;
  1926.     my($v) = $r2/$n-$r*$r/$n2 + $g2/$n-$g*$g/$n2 + $b2/$n-$b*$b/$n2;
  1927.     #print STDERR "v=$v\n" if $v<0;
  1928.     return $v<0?0:$v;
  1929. }
  1930.  
  1931. sub nd_err {
  1932.     return &nd_var(@_) * $_[0];
  1933. }
  1934.  
  1935. # retourne (nb_pixel, red, green, blue, red^2, green^2, blue^2)
  1936. sub nd_nrgb {
  1937.     my($tree, $nd) = @_;
  1938.     my(@t) = @{$tree->[$nd]};
  1939.     return @t[1..7];
  1940. }
  1941.  
  1942. sub nd_nrgb_ {
  1943.     my($tree, $nd) = @_;
  1944.     my(@t) = @{$tree->[$nd]};
  1945.     my(@r) = @t[1..7];
  1946.     for my $i (8..15) {
  1947.         if($t[$i]) {
  1948.             my(@s) = &nd_nrgb_($tree, $t[$i]);
  1949.             for my $j (0..$#s) {$r[$j] += $s[$j];}
  1950.         }
  1951.     }
  1952.     return @r;
  1953. }
  1954.  
  1955. # retourne le parent d'un noeud
  1956. sub nd_parent {
  1957.     my($tree, $nd) = @_;
  1958.     return $tree->[$nd]->[0];
  1959. }
  1960.  
  1961. # retourne la profondeur d'un noeud
  1962. sub nd_depth {
  1963.     my($tree, $nd) = @_;
  1964.     my($d) = 0;
  1965.     while($nd>0) {++$d; $nd = &nd_parent($tree, $nd);}
  1966.     return $d;
  1967. }
  1968.  
  1969. sub is_nd_candidate {
  1970.     my($tree, $nd) = @_;
  1971.     #return 0 unless &nd_parent($tree, $nd);
  1972.     return &is_nd_nrgb($tree, $nd);
  1973. }
  1974.  
  1975. # test si un noeud est candidat
  1976. sub is_nd_nrgb {
  1977.     my($tree, $nd) = @_;
  1978.     my(@t) = &nd_nrgb($tree, $nd);
  1979.     return $t[0]>0;
  1980. }
  1981.  
  1982. sub perc {
  1983.     my($perc) = @_;
  1984.    
  1985.     if($perc>0) {
  1986.         my($z) = int($perc*100);
  1987.         return if $z == $glb_perc_last;
  1988.         $glb_perc_last = $z;
  1989.     }
  1990.    
  1991.     my($t) = time;
  1992.     if($perc<=0) {
  1993.         $glb_perc_time = $t;
  1994.     } elsif($perc>=1) {
  1995.             print STDERR " " x length($glb_perc_txt), "\b" x length($glb_perc_txt);
  1996.         undef $glb_perc_last;
  1997.         undef $glb_perc_time;
  1998.         undef $glb_perc_txt;
  1999.     } elsif($t>$glb_perc_time+30) {
  2000.         my($old) = length($glb_perc_txt);
  2001.         $glb_perc_txt = sprintf("%3d%% (%ds rem)", $perc*100, int(($t-$glb_perc_time)*(1/$perc-1)));
  2002.         my($end) = " " x ($old-length($glb_perc_txt));
  2003.         print STDERR $glb_perc_txt, $end, "\b" x (length($glb_perc_txt) + length($end));
  2004.     }
  2005. }
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!