#/bin/perl
#
# tst_bm16.pl - Pbairefvba ivqrb ra tvs 15 pbhyf 160k200. [ROT13]
#
# par Samuel DEVULDER, Sept 2015.
#

if(0) {
    # pour trouver les niveaux equi-repartis
    &init_magick;

    my(@px);
    for my $c (0, 100, 127, 142, 163, 179, 191, 203, 215, 223, 231, 239, 243, 247, 251, 255) {push(@px,$c,$c,$c);}
    my $img=&px2img(16,1, @px);
    my @p1 = $img->GetPixels(height=>1,normalize=>"True");
    $img->Set(colorspace=>$LINEAR_SPACE);
    my @p2 = $img->GetPixels(height=>1,normalize=>"True");
    for my $i (0..15) {
        print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",2*$p2[$i*3]," ",255*$p2[$i*3]," ", 2*$p2[$i*3],"\n";
    }
    for my $i (0..15) {
        print "$i ",$px[$i*3]," ",255*$p1[$i*3]," ",3*$p2[$i*3]," ",255*$p2[$i*3]," ", 3*$p2[$i*3],"\n";
    }

    # 0 163 215 255
    # 0 191 255

    exit;
}

# parametres
($w, $h) = (160, 100);
$fps     = 10;
$dither  = "vac8"; #"bayer4";
$zigzag  = 0;
$satur   = 140;
$max     = 245;

# fichier entree
$file    = $ARGV[0];
$name    = $file;
$file =~ s/\.[^\.]*$/.gif/;
mkdir "out";
$file =~ s/^.*[\/]/out\//;
exit if -e $file;
print "$name\n";

# dossier temporaire
mkdir "tmp";
unlink(<tmp/img*.bmp>);

open(OUT,"| ./ffmpeg -i - -v 0 -r $fps -s ${w}x${h} -an tmp/img%05d.bmp");
open(IN, "<$name");
binmode(OUT);
binmode(IN);

open(OUT2,"| ./ffmpeg -i - -v 0 -r 1 -s ${w}x${h} -an tmp/img%05d.bmp");
open(IN2, "<$name");
binmode(OUT2);
binmode(IN2);

&init_magick;

$gif = Image::Magick->new(size=>($w*2)."x".($h*2));

@mat = ([1]) if $dither eq "checker";
@mat = ([1,3],
        [4,2]) if $dither eq "bayer2";
@mat = ([7,8,2],
        [6,9,4],
    [3,5,1]) if $dither eq "sam3";
@mat = ([3,7,4],
        [6,1,9],
    [2,8,5]) if $dither eq "3x3";
@mat = ([1,9,3,11],
        [13,5,15,7],
    [4,12,2,10],
    [16,8,14,6]) if $dither eq "bayer4";
@mat = ([21,2,16,11,6],
    [9,23,5,18,14],
        [19,12,7,24,1],
        [22,3,17,13,8],
        [15,10,25,4,20]) if $dither eq "vac5";
@mat = ([35,57,19,55,7,51,4,21],
    [29,6,41,27,37,17,59,45],
    [61,15,53,12,62,25,33,9],
    [23,39,31,49,2,47,13,43],
    [3,52,8,22,36,58,20,56],
    [38,18,60,46,30,5,42,28],
    [63,26,34,11,64,16,54,10],
    [14,48,1,44,24,40,32,50]) if $dither eq "vac8";

$mat_x = 1+$#mat;
$mat_y = 1+$#{$mat[0]};
for my $a (@mat) {for my $b (@$a) {$b /= $mat_x*$mat_y+1.0;}}

@teo_pal = (0,100,127,142,163,179,191,203,215,223,231,239,243,247,251,255);
@lin_pal = (0, 33, 54, 69, 93,115,133,152,173,188,204,220,229,237,246,255);
#($MID31, $MID21, $MID32) = (4,6,8);
#($MID31, $MID21, $MID32) = (2,4,8);
($MID31, $MID21, $MID32) = (1,3,5);

if(1) {
    my @pc2teo = ();
    for my $i (1..$#teo_pal) {
        my($a,$b,$c) = ($teo_pal[$i-1],($teo_pal[$i-1]+$teo_pal[$i])>>1,$teo_pal[$i]);
        for my $j ($a..$b)   {$pc2teo[$j] = $i-1;}
        for my $j ($b+1..$c) {$pc2teo[$j] = $i;}
    }

    my @tab1 = (0)x16;
    my @tab2 = (0)x16;
    $time = 1;
    my $run = 1;
    while(1) {
        my $name = sprintf("tmp/img%05d.bmp", $time);
        $expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
        if($expected_size != -s $name) {
            last unless $run;
            my $buf;
            my $read = read(IN2,$buf,4096);
            if($read) {
                syswrite OUT2, $buf, $read;
            } else {
                $run = 0;
                close(OUT2);
            }
        } else  {
            # image complete!
            print STDERR $time++,"s\r";

            # lecture de l'image
            my $img = Image::Magick->new();
            $img->Read($name);
            unlink $name;

            # on force la saturation (140%) pour avoir des couleurs plus franches
            $img->Modulate(saturation=>$satur);
            $img->Evaluate(operator=>'Multiply', value=>255/$max);

            # trammage
            my @px = $img->GetPixels(height=>$h, normalize=>"True");
            undef $img;
            for(my $i=0; $i<$#px; $i+=3) {
                ++$tab1[$pc2teo[int($px[$i]*255)]];
                ++$tab1[$pc2teo[int($px[$i+1]*255)]];
                ++$tab2[$pc2teo[int($px[$i+2]*255)]];
            }
        }
    }
    close(IN2);close(OUT2);

    # for my $i (0..15) {
        # print $tab1[$i],"  ",$tab2[$i],"\n";
    # }
    # 0 a b 15
    # 0  c  15
    my($tot,$acc);
    $tot = -$tab1[0]-$tab1[15];
    $acc = 0;
    for my $t (@tab1) {$tot += $t;}
    for(my $i=1; $i<16; ++$i) {
        $acc += $tab1[$i];
        if($acc*3>=$tot) {
            $MID31 = $i;
            last;
        }
    }
    for(my $i=$MID31+1; $i<16; ++$i) {
        $acc += $tab1[$i];
        if($acc*3>=$tot*2) {
            $MID32 = $i;
            last;
        }
    }
    $tot = -$tab2[0]-$tab2[15];
    $acc = 0;
    for my $t (@tab2) {$tot += $t;}
    for(my $i=1; $i<16; ++$i) {
        $acc += $tab2[$i];
        if($acc*2>=$tot) {
            $MID21 = $i;
            last;
        }
    }
    print "$MID31 $MID21 $MID32\n";

    unlink(<tmp/img*.bmp>);
}


$d4 = sub {
    my($v, $d) = @_;
    my($a) = $lin_pal[$MID32];
    return ($v-$a)/(255-$a)>=$d ? 255 : $teo_pal[$MID32] if $v>=$a;
    my($b) = $lin_pal[$MID31];
    return ($v-$b)/($a-$b)>=$d ? $teo_pal[$MID32] : $teo_pal[$MID31] if $v>=$b;
    return $v/$b>=$d ? $teo_pal[$MID31] : 0;
};
$d3 = sub {
    my($v, $d) = @_;
    my($a) = $lin_pal[$MID21];
    return ($v-$a)/(255-$a)>=$d ? 255 : $teo_pal[$MID21] if $v>=$a;
    return $v/$a>=$d ? $teo_pal[$MID21] : 0;
};

$cpt = 1;$run = 1;
while(1) {
    $name = sprintf("tmp/img%05d.bmp", $cpt);

    $expected_size = $h*(($w*3 + 3)&~3) + 54 if !$expected_size;
    if($expected_size != -s $name) {
        last unless $run;
        my $buf;
        my $read = read(IN,$buf,4096);
        if($read) {
            syswrite OUT, $buf, $read;
        } else {
            $run = 0;
            close(OUT);
        }

    } else  {
        # image complete!
        print STDERR int($cpt++/$fps),"s (",int(100*($cpt-2)/($fps*$time)),"%)\r";
        sleep(5) if ($cpt%100)==0; # on fait une pause régulière pour ne pas surchauffer le processeur

        # lecture de l'image
        my $img = Image::Magick->new();
        $img->Read($name);
        unlink $name;
        $img->Set(colorspace=>$LINEAR_SPACE);

        # on force la saturation (140%) pour avoir des couleurs plus franches
        $img->Modulate(saturation=>$satur);
        $img->Evaluate(operator=>'Multiply', value=>255/$max);

        # trammage
        my @px = $img->GetPixels(height=>$h, normalize=>"True");
        undef $img;
        for my $c (@px) {$c = int($c*255);}

        # dither
        my @im = (0,0,0)x($w*$h*4);
        for my $y (0..$h-1) {
            for my $x (0..$w-1) {
                my(@p) = splice(@px, 0, 3);
                my($d) = $mat[$x%$mat_x][$y%$mat_y];
                my($p) = ($y*$w*2 + $x)*6;

                @p = ($d4->($p[0],$d),$d4->($p[1],$d),$d3->($p[2],$d));

                if($zigzag & $x) {
                    @im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
                    $p += $w*6;
                    @im[($p+1,$p+4)]   = @p[(1,1)];
                } else {
                    @im[($p+1,$p+4)]   = @p[(1,1)];
                    $p += $w*6;
                    @im[($p,$p+2,$p+3,$p+5)] = @p[(0,2,0,2)];
                }
            }
        }
        $img = &px2img($w*2,$h*2, @im);
        $img->Write("tmp/toto.png");

        # ajout de l'image au gif animé
        $img->Set(dispose=>"None");
        $img->Set(delay=>int(100/$fps));
        push(@$gif, $img);
        undef $img;

        # pas plus de 3000 imgs (5mins)
        last if $cpt==3000 || !$run;
    }
}
close(IN);
close(OUT);

# ecriture du fichier gif
$gif->Set(dispose=>"None");
$gif->Set(Layers=>"optimize-trans");
$gif->Set(delay=>int(100/$fps));
$gif->Write($file);

sub init_magick {
    eval 'use Image::Magick;';

    # determination de l'espace RGB lineaire
    my $img = Image::Magick->new(size=>"256x1", depth=>16);
    $img->Read('gradient:black-white');
    $img->Set(colorspace=>'RGB');
    #$img->Set(colorspace=>"Gray") unless $coul;
    my @px1 = $img->GetPixel(x=>128, y=>0);
    $img->Read('gradient:black-white');
    $img->Set(colorspace=>'sRGB');
    #$img->Set(colorspace=>"Gray") unless $coul;
    my @px2 = $img->GetPixel(x=>128, y=>0);
    my $d1 = $px1[0]-0.5; $d1=-$d1 if $d1<0;
    my $d2 = $px2[0]-0.5; $d2=-$d2 if $d2<0;
    $LINEAR_SPACE = $d1>=$d2 ? "RGB" : "sRGB";
    #print $px1[0], "   ",$px2[0],"    $LINEAR_SPACE\n";
}

sub px2img {
    my($width,$height,@px) = @_;

    open(OUT2,">/tmp/.toto2.pnm");
    print OUT2 "P6\n$width $height\n255\n",pack('C*', @px),"\n";
    close(OUT2);
    my $img2 = Image::Magick->new();
    $img2->ReadImage("/tmp/.toto2.pnm");
    unlink "/tmp/.toto2.pnm";

    return $img2;
}