#! /usr/bin/perl
#
# Copyright (C) 2009-2019 Alexis Bienvenue <paamc@passoire.fr>
#
# This file is part of Auto-Multiple-Choice
#
# Auto-Multiple-Choice is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, either version 2 of
# the License, or (at your option) any later version.
#
# Auto-Multiple-Choice is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Auto-Multiple-Choice.  If not, see
# <http://www.gnu.org/licenses/>.

use Getopt::Long;

use Gtk3;
use Cairo;

use List::Util qw(min max sum);

use AMC::Path;
use AMC::Basic;
use AMC::Exec;
use AMC::Gui::Avancement;
use AMC::NamesFile;
use AMC::Data;
use AMC::DataModule::capture qw/:zone :position/;
use AMC::DataModule::layout qw/:flags/;
use AMC::Substitute;

use utf8;

my $cr_dir      = "";
my $rep_projet  = '';
my $rep_projets = '';
my $fichnotes   = '';
my $fich_bareme = '';
my $id_file     = '';

my $seuil    = 0.1;
my $seuil_up = 1.0;

my $data_dir = '';

my $taille_max  = "1000x1500";
my $qualite_jpg = "65";

my $debug = '';

my $progress    = 1;
my $progress_id = '';

my $line_width         = 2;
my @o_symbols          = ();
my $annote_indicatives = '';
my $position           = 'marge';
my $ecart              = 1;
my $ecart_marge        = 1.5;
my $pointsize_rel      = 60;

my $chiffres_significatifs = 4;

my $verdict                    = 'TOTAL : %S/%M => %s/%m';
my $verdict_question_cancelled = '"X"';
my $verdict_question           = '';

my $font_name      = 'FreeSans';
my $rtl            = '';
my $test_font_size = 100;

my $fich_noms      = '';
my $noms_encodage  = 'utf-8';
my $csv_build_name = '';

my $changes_only = 1;

# cle : "a_cocher-cochee"
my %symboles = (
    '0-0' => {qw/type none/},
    '0-1' => {qw/type circle color red/},
    '1-0' => {qw/type mark color red/},
    '1-1' => {qw/type mark color blue/},
);

@ARGV = unpack_args(@ARGV);

GetOptions(
    "cr=s" => \$cr_dir,
    "projet=s",  \$rep_projet,
    "projets=s", \$rep_projets,
    "data=s"                       => \$data_dir,
    "id-file=s"                    => \$id_file,
    "debug=s"                      => \$debug,
    "taille-max=s"                 => \$taille_max,
    "qualite=s"                    => \$qualite_jpg,
    "progression=s"                => \$progress,
    "progression-id=s"             => \$progress_id,
    "line-width=s"                 => \$line_width,
    "symbols=s"                    => \@o_symbols,
    "indicatives=s"                => \$annote_indicatives,
    "position=s"                   => \$position,
    "pointsize-nl=s"               => \$pointsize_rel,
    "ecart=s"                      => \$ecart,
    "ecart-marge=s"                => \$ecart_marge,
    "ch-sign=s"                    => \$chiffres_significatifs,
    "verdict=s"                    => \$verdict,
    "verdict-question=s"           => \$verdict_question,
    "verdict-question-cancelled=s" => \$verdict_question_cancelled,
    "fich-noms=s"                  => \$fich_noms,
    "noms-encodage=s"              => \$noms_encodage,
    "csv-build-name=s"             => \$csv_build_name,
    "font=s"                       => \$font_name,
    "rtl!"                         => \$rtl,
    "changes-only!"                => \$changes_only,
);

set_debug($debug);

print( ( "*" x 60 ) . "\n" );
print "* WARNING: AMC-annote is now obsolete\n* Please move to AMC-annotate\n";
print( ( "*" x 60 ) . "\n" );

for ( split( /,/, join( ',', @o_symbols ) ) ) {
    if (/^([01]-[01]):(none|circle|mark|box)(?:\/([\#a-z0-9]+))?$/) {
        $symboles{$1} = { type => $2, color => $3 };
    } else {
        die "Bad symbol syntax: $_";
    }
}

my $commandes = AMC::Exec::new("AMC-annote");
$commandes->signalise();

$cr_dir = $rep_projet . "/cr" if ( !$cr_dir );

if ( !-d $cr_dir ) {
    attention("No CR directory: $cr_dir");
    die "No CR directory: $cr_dir";
}

my $noms = '';

if ($fich_noms) {
    $noms = AMC::NamesFile::new(
        $fich_noms,
        encodage    => $noms_encodage,
        identifiant => $csv_build_name
    );

    debug "Keys in names file: " . join( ", ", $noms->heads() );
}

# ---

sub color_rgb {
    my ($s) = @_;
    my $col = Gtk3::Gdk::Color::parse($s);
    return ( $col->red / 65535, $col->green / 65535, $col->blue / 65535 );
}

my $avance = AMC::Gui::Avancement::new( $progress, id => $progress_id );

my $data    = AMC::Data->new($data_dir);
my $capture = $data->module('capture');
my $scoring = $data->module('scoring');
my $assoc   = $data->module('association');
my $layout  = $data->module('layout');

$seuil    = $scoring->variable_transaction('darkness_threshold');
$seuil_up = $scoring->variable_transaction('darkness_threshold_up');

#################################

sub milieu_cercle {
    my $zoneid = shift;
    return (
        $capture->sql_row(
            $capture->statement('zoneCenter'),
            $zoneid, POSITION_BOX
        )
    );
}

sub cercle_coors {
    my ( $context, $zoneid, $color ) = @_;
    my ( $x, $y ) = milieu_cercle($zoneid);
    my $t = sqrt( $capture->zone_dist2( $zoneid, $x, $y ) );
    $context->set_source_rgb( color_rgb($color) );
    $context->new_path;
    $context->arc( $x, $y, $t, 0, 360 );
    $context->stroke;
}

sub croix_coors {
    my ( $context, $zoneid, $color ) = @_;
    $context->set_source_rgb( color_rgb($color) );
    $context->new_path;
    for my $i ( 1, 2 ) {
        $context->move_to( $capture->zone_corner( $zoneid, $i ) );
        $context->line_to( $capture->zone_corner( $zoneid, $i + 2 ) );
    }
    $context->stroke;
}

sub boite_coors {
    my ( $context, $zoneid, $color ) = @_;
    my @pts = "";
    $context->set_source_rgb( color_rgb($color) );
    $context->new_path;
    $context->move_to( $capture->zone_corner( $zoneid, 1 ) );
    for my $i ( 2 .. 4 ) {
        $context->line_to( $capture->zone_corner( $zoneid, $i ) );
    }
    $context->close_path;
    $context->stroke;
}

my $delta = 1;

$capture->begin_read_transaction('PAGE');

my $annotate_source_change = $capture->variable('annotate_source_change');

my @pages = @{
    $capture->dbh->selectall_arrayref( $capture->statement('pages'),
        { Slice => {} } )
};

$capture->end_transaction('PAGE');

$delta             = 1 / ( 1 + $#pages ) if ( $#pages >= 0 );
$n_processed_pages = 0;

my %ok_students = ();

# a) first case: these numbers are given by --id-file option

if ($id_file) {

    open( NUMS, $id_file );
    while (<NUMS>) {
        chomp;
        if (/^[0-9]+(:[0-9]+)?$/) {
            $ok_students{$_} = 1;
        }
    }
    close(NUMS);

}

my $subst = AMC::Substitute::new(
    names   => $noms,
    scoring => $scoring,
    assoc   => $assoc,
    name    => '',
    chsign  => $chiffres_significatifs,
);

print "* Annotation\n";

PAGE: for my $p (@pages) {
    my @spc = map { $p->{$_} } (qw/student page copy/);

    if ( $id_file && !$ok_students{ studentids_string( $spc[0], $spc[2] ) } ) {
        next PAGE;
    }

    if ( $changes_only && $p->{timestamp_annotate} > $annotate_source_change ) {
        my $f = $p->{annotated};
        if ( -f "$cr_dir/corrections/jpg/$f" ) {
            print "Skipping page " . pageids_string(@spc) . " (up to date)\n";
            debug "Skipping page " . pageids_string(@spc) . " (up to date)";
            next PAGE;
        }
    }

    debug "Analyzing " . pageids_string(@spc);

    my $scan = $p->{src};

    debug "Scan file: $scan";

    if ($rep_projet) {
        $scan = proj2abs(
            {
                '%PROJET',  $rep_projet,
                '%PROJETS', $rep_projets,
                '%HOME' => $ENV{HOME},
            },
            $scan
        );
    }

    my $scan_f = $scan;

    $scan_f =~ s/\[[0-9]+\]$//;

    if ( -f $scan_f ) {

        # ONE SCAN FILE

        # read scan file (converting to PNG)
        debug "Reading $scan";
        open( CONV, "-|", magick_module("convert"), $scan, "png:-" );
        my $surface = Cairo::ImageSurface->create_from_png_stream(
            sub {
                my ( $cb_data, $length ) = @_;
                read CONV, $data, $length;
                return ($data);
            }
        );
        close(CONV);

        my $context = Cairo::Context->create($surface);
        $context->set_line_width($line_width);

        my $lay = Pango::Cairo::create_layout($context);

        # adjusts text size...
        my $l0 = Pango::Cairo::create_layout($context);
        $l0->set_font_description(
            Pango::FontDescription->from_string(
                $font_name . ' ' . $test_font_size
            )
        );
        $l0->set_text('H');
        my ( $text_x, $text_y ) = $l0->get_pixel_size();
        my $page_width  = $surface->get_width;
        my $page_height = $surface->get_height;
        debug "Scan height: $page_height";
        my $target_y = $page_height / $pointsize_rel;
        debug "Target TY: $target_y";
        my $font_size = int( $test_font_size * $target_y / $text_y );
        debug "Font size: $font_size";

        $lay->set_font_description(
            Pango::FontDescription->from_string(
                $font_name . ' ' . $font_size
            )
        );
        $lay->set_text('H');
        ( $text_x, $text_y ) = $lay->get_pixel_size();

        my ( $x_ppem, $y_ppem, $ascender, $descender, $width, $height,
            $max_advance );

        my $idf = pageids_string( @spc, path => 1 );

        print "Annotating $scan (sheet $idf)...\n";

        my %question = ();

        $capture->begin_read_transaction('xSTD');

        # print global mark and name on the page

        if ( $p->{page} == 1 || $capture->zones_count( @spc, ZONE_NAME ) ) {
            my $text = $subst->substitute( $verdict, @spc[ 0, 2 ] );

            $lay->set_text($text);
            $context->set_source_rgb( color_rgb('red') );
            if ($rtl) {
                my ( $tx, $ty ) = $lay->get_pixel_size;
                $context->move_to( $page_width - $text_x - $tx, $text_y * .7 );
            } else {
                $context->move_to( $text_x, $text_y * .7 );
            }
            Pango::Cairo::show_layout( $context, $lay );
        }

        #########################################
        # signs around each box

        my $sth = $capture->statement('pageZones');
        $sth->execute( @spc, ZONE_BOX );
      BOX: while ( my $b = $sth->fetchrow_hashref ) {

            my $p_strategy = $scoring->unalias( $p->{student} );
            my $q          = $b->{id_a};
            my $r          = $b->{id_b};
            my $indic      = $scoring->indicative( $p_strategy, $q );

            next BOX if ( $indic && !$annote_indicatives );

            # to be ticked?
            my $bonne = $scoring->correct_answer( $p_strategy, $q, $r );

            # ticked on this scan?
            my $cochee =
              $capture->ticked( $p->{student}, $p->{copy}, $q, $r, $seuil,
                $seuil_up );

            debug "Q=$q R=$r $bonne-$cochee";

            my $sy = $symboles{"$bonne-$cochee"};

            if ($debug) {
                for my $i ( 1 .. 4 ) {
                    debug(
                        sprintf( "Corner $i: (%.2f,%.2f)",
                            $capture->zone_corner( $b->{zoneid}, $i ) )
                    );
                }
            }

            if (
                !(
                    $layout->get_box_flags( $p->{student}, $q, $r,
                        BOX_ROLE_ANSWER ) & BOX_FLAGS_DONTANNOTATE
                )
              )
            {
                if ( $sy->{type} eq 'circle' ) {
                    cercle_coors( $context, $b->{zoneid}, $sy->{color} );
                } elsif ( $sy->{type} eq 'mark' ) {
                    croix_coors( $context, $b->{zoneid}, $sy->{color} );
                } elsif ( $sy->{type} eq 'box' ) {
                    boite_coors( $context, $b->{zoneid}, $sy->{color} );
                } elsif ( $sy->{type} eq 'none' ) {
                } else {
                    debug "Unknown symbol type ($bonne-$cochee): $sy->{type}";
                }
            }

            # pour avoir la moyenne des coors pour marquer la note de
            # la question

            $question{$q} = {} if ( !$question{$q} );
            my @mil = milieu_cercle( $b->{zoneid} );
            push @{ $question{$q}->{x} }, $mil[0];
            push @{ $question{$q}->{y} }, $mil[1];
        }

        #########################################
        # write questions scores

        if ( $position ne 'none' ) {
          QUEST: for my $q ( keys %question ) {
                next QUEST if ( $scoring->indicative( $p_strategy, $q ) );
                my $x;

                my $result = $scoring->question_result( @spc[ 0, 2 ], $q );

                my $text;

                if ( $result->{why} =~ /c/i ) {
                    $text = $verdict_question_cancelled;
                } else {
                    $text = $verdict_question;
                }

                $text =~ s/\%[S]/$result->{score}/g;
                $text =~ s/\%[M]/$result->{max}/g;
                $text =~ s/\%[W]/$result->{why}/g;
                $text =~ s/\%[s]/$subst->format_note($result->{score})/ge;
                $text =~ s/\%[m]/$subst->format_note($result->{max})/ge;

                my $te = eval($text);
                if ($@) {
                    debug "Annotation: $text";
                    debug "Evaluation error $@";
                } else {
                    $text = $te;
                }

                $lay->set_text($text);
                my ( $tx, $ty ) = $lay->get_pixel_size;

                # mean of the y coordinate of all boxes
                my $y = sum( @{ $question{$q}->{y} } ) /
                  ( 1 + $#{ $question{$q}->{y} } ) - $ty / 2;

                if ( $position eq 'marge' ) {

                    # scores written in one margin
                    if ($rtl) {
                        $x = $page_width - $ecart_marge * $text_x - $tx;
                    } else {
                        $x = $ecart_marge * $text_x;
                    }
                } elsif ( $position eq 'case' ) {

                    # scores written at the left of the boxes
                    if ($rtl) {
                        $x = max( @{ $question{$q}->{x} } ) + $ecart * $text_x;
                    } else {
                        $x =
                          min( @{ $question{$q}->{x} } ) -
                          $ecart * $text_x -
                          $tx;
                    }
                } elsif ( $position eq 'marges' ) {

                    # scores written in one of the margins (left or right),
                    # depending on the position of the boxes. This mode is often
                    # used when the subject is in a 2-column layout.

                # fist extract the y coordinates of the boxes in the left column
                    my $left = 1;
                    my @y    = map { $question{$q}->{y}->[$_] } grep {
                        $rtl xor( $question{$q}->{x}->[$_] <= $page_width / 2 )
                    } ( 0 .. $#{ $question{$q}->{x} } );
                    if ( !@y ) {

                        # if empty, use the right column
                        $left = 0;
                        @y    = map { $question{$q}->{y}->[$_] } grep {
                            $rtl
                              xor( $question{$q}->{x}->[$_] > $page_width / 2 )
                        } ( 0 .. $#{ $question{$q}->{x} } );
                    }

                    # set the x-position to the right margin
                    if ( $left xor $rtl ) {
                        $x = $ecart_marge * $text_x;
                    } else {
                        $x = $page_width - $ecart_marge * $text_x - $tx;
                    }

                    # set the y-position to the mean of y coordinates of the
                    # boxes in the corresponding column
                    $y = sum(@y) / ( 1 + $#y ) - $ty / 2;
                } else {
                    debug "Annotation : position invalide : $position";
                    $x = $ecart_marge * $text_x;
                }

                $context->set_source_rgb( color_rgb('red') );
                $context->move_to( $x, $y );
                Pango::Cairo::show_layout( $context, $lay );
            }
        }

        $capture->end_transaction('xSTD');

        # WRITE TO FILE

        $context->show_page;

        my $out_file = "page-$idf.jpg";

        debug "Saving annotated scan to $cr_dir/corrections/jpg/$out_file";

        my @args = ();

        if ($qualite_jpg) {
            if ( $qualite_jpg =~ /^[0-9]+$/ ) {
                push @args, "-quality", $qualite_jpg;
            } else {
                debug
"WARNING: non-numeric --qualite argument, ignored ($qualite_jpg)";
            }
        }

        if ($taille_max) {
            if ( $taille_max =~ /^[0-9]*x?[0-9]*$/ ) {
                push @args, "-geometry", $taille_max;
            } else {
                debug
"WARNING: malformed --taille-max argument, ignored ($taille_max)";
            }
        }

        open( CONV, "|-", magick_module("convert"),
            "png:-", @args, "$cr_dir/corrections/jpg/$out_file" );
        $surface->write_to_png_stream(
            sub {
                my ( $cb_data, $data ) = @_;
                print CONV $data;
            }
        );
        close(CONV);

        $capture->begin_transaction('ANNf');
        $capture->set_annotated( @spc, $out_file );
        $capture->end_transaction('ANNf');

        $n_processed_pages++;

    } else {
        print "No scan for page " . pageids_string(@spc) . ":$scan_f\n";
        debug "No scan: $scan_f";
    }

    $avance->progres($delta);
}

# stores state parameter to know all sheets have been annotated

$capture->begin_transaction('Aend');
$capture->variable( 'annotate_source_change', 0 );
$capture->end_transaction('Aend');

print "VAR: n_processed=$n_processed_pages\n";

$avance->fin();

