# Copyright (C) 2013-2021 Alexis Bienvenüe <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 warnings;

use 5.012;

package AMC::Annotate;

use Gtk3;

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

use File::Copy;

use Unicode::Normalize;

use File::Temp qw/ tempfile /;

use Text::CSV;

use AMC::Path;

use AMC::Basic;

use AMC::Export;

use AMC::Subprocess;

use AMC::NamesFile;

use AMC::Substitute;

use AMC::DataModule::report ':const';

use AMC::DataModule::capture qw/:zone :position/;

use AMC::DataModule::layout qw/:flags/;

use AMC::Gui::Avancement;

use AMC::Calage;

use AMC::Boite;

use utf8;

sub new {

    my (%o) = (@_);

    my $self = {

        data_dir               => '',

        project_dir            => '',

        projects_dir           => '',

        pdf_dir                => '',

        single_output          => '',

        filename_model         => '(N)-(ID)',

        force_ascii            => '',

        pdf_subject            => '',

        names_file             => '',

        names_encoding         => 'utf8',

        association_key        => '',

        csv_build_name         => '',

        anonymous              => '',

        header_only            => '',

        significant_digits     => 1,

        darkness_threshold     => '',

        darkness_threshold_up  => '',

        id_file                => '',

        sort                   => '',

        annotate_indicatives   => '',

        position               => 'marges',

        text_color             => 'red',

        line_width             => 1,

        font_name              => 'Linux Libertine O 12',

        dist_to_box            => '1cm',

        dist_margin            => '5mm',

        dist_margin_globaltext => '3mm',

        symbols                => {

            '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/},

        },

        verdict                    => '',

        verdict_question           => '',

        verdict_question_cancelled => '',

        progress                   => '',

        progress_id                => '',

        compose                    => 0,

        pdf_corrected              => '',

        pdf_background             => '',

        changes_only               => '',

        embedded_max_size          => '',

        embedded_format            => 'jpeg',

        embedded_jpeg_quality      => 80,

        rtl                        => '',

        debug                      => ( get_debug() ? 1 : 0 ),

    };

    for my $k ( keys %o ) {

        $self->{$k} = $o{$k} if ( defined( $self->{$k} ) );

    }

    $self->{type} = (

        $self->{single_output}

        ? REPORT_SINGLE_ANNOTATED_PDF

        : REPORT_ANNOTATED_PDF

    );

    $self->{type}       = REPORT_ANONYMIZED_PDF if ( $self->{anonymous} );

    $self->{loaded_pdf} = '';

    # checks that the position option is available

    $self->{position} = lc( $self->{position} );

    if ( $self->{position} !~ /^(marges?|case|zones|none)$/i ) {

        debug "ERROR: invalid \<position>: $self->{position}";

        $self->{position} = 'none';

    }

    # chacks that the embedded_format is ok

    $self->{embedded_format} = lc( $self->{embedded_format} );

    if ( $self->{embedded_format} !~ /^(jpeg|png)$/i ) {

        debug "ERROR: invalid <embedded_format>: $self->{embedded_format}";

        $self->{embedded_format} = 'jpeg';

    }

    # checks that the pdf files exist

    for my $k (qw/subject corrected/) {

        if ( $self->{ 'pdf_' . $k } && !-f $self->{ 'pdf_' . $k } ) {

            debug "WARNING: PDF $k file not found: " . $self->{ 'pdf_' . $k };

            $self->{ 'pdf_' . $k } = '';

        }

    }

    # force to default value when filename model is empty

    $self->{filename_model} = '(N)-(ID)'

      if ( $self->{filename_model} eq '' );

    # adds pdf extension if not already there

    if ( $self->{filename_model} !~ /\.pdf$/i ) {

        debug "Adding pdf extension to $self->{filename_model}";

        $self->{filename_model} .= '.pdf';

    }

    # if the corrected answer sheet is not given, use the subject

    # instead.

    if ( $self->{compose} == 2 && !-f $self->{pdf_corrected} ) {

        $self->{compose} = 1;

    }

    # which pdf file will be used as a background when scans are not

    # available?

    if ( $self->{compose} == 1 ) {

        $self->{pdf_background} = $self->{pdf_subject};

    } elsif ( $self->{compose} == 2 ) {

        $self->{pdf_background} = $self->{pdf_corrected};

    }

    # set up the object to send progress to calling program

    $self->{avance} =

      AMC::Gui::Avancement::new( $self->{progress}, id => $self->{progress_id} )

      if ( $self->{progress} );

    bless $self;

    return ($self);

}

# units conversion

my %units = (

    in => 1,

    ft => 12,

    yd => 36,

    pt => 1 / 72,

    cm => 1 / 2.54,

    mm => 1 / 25.4,

    m  => 1000 / 25.4,

);

sub dim2in {

    my ($d) = @_;

  UNITS: for my $u ( keys %units ) {

        if ( $d =~ /^(.*)(?<![a-zA-Z])$u$/ ) {

            $d = $1 * $units{$u};

        }

    }

    return ($d);

}

# get absolute path from a path that can contain %PROJECT or %PROJECTS

# strings, that refer to the project directory and the projetcs

# directory.

sub absolute_path {

    my ( $self, $path ) = @_;

    if ( $self->{project_dir} ) {

        $path = proj2abs(

            {

                '%PROJET',  $self->{project_dir},

                '%PROJETS', $self->{projects_dir},

                '%HOME' => $ENV{HOME},

            },

            $path

        );

    }

    return ($path);

}

# Tests if the report that has already been made is still present and

# up to date. If up-to-date, returns the filename. Otherwise, returns

# the empty string.

sub student_uptodate {

    my ( $self, $student ) = @_;

    my ( $filename, $timestamp ) =

      $self->{report}->get_student_report_time(

        ( $self->{anonymous} ? REPORT_ANONYMIZED_PDF : REPORT_ANNOTATED_PDF ),

        @$student );

    if ($filename) {

        debug "Registered filename " . show_utf8($filename);

        my $source_change =

          $self->{capture}->variable('annotate_source_change');

        debug

"Registered answer sheet: updated at $timestamp, source change at $source_change";

        # we say there is an up-to-date annotated answer sheet if the file

        # exists and has been built after the last time some result or

        # configuration variable were changed.

        debug "Directory " . show_utf8( $self->{pdf_dir} );

        debug "Looking for filename " . show_utf8($filename);

        my $path = "$self->{pdf_dir}/$filename";

        if ( -f $path && $timestamp > $source_change ) {

            debug "Exists!";

            return ($filename);

        } else {

            debug "NOT up-to-date.";

        }

    } else {

        debug "No registered annotated answer sheet.";

    }

    return ('');

}

# Computes the filename to be used for the student annotated answer

# sheet. Returns this filename, and, if there is already a up-to-date

# annotated answer sheet, also returns the name of this one.

sub pdf_output_filename {

    my ( $self, $student ) = @_;

    $self->needs_data;

    $self->needs_names;

    my $f = $self->{filename_model};

    debug "F[0]=$f";

    # computes student/copy four digits ID and substitutes (N) with it

    my $ex;

    if ( $student->[1] ) {

        $ex = sprintf( "%04d:%04d", @$student );

    } else {

        $ex = sprintf( "%04d", $student->[0] );

    }

    $f =~ s/\(N\)/$ex/gi;

    debug "F[N]=" . show_utf8($f);

    # Substitute (aID) with anonymous ID

    if ( $self->{anonymous} && $f =~ /\(aID\)/ ) {

        $self->{association}->begin_transaction('anon');

        my $aid = $self->{association}

          ->anonymized( $student->[0], $student->[1], $self->{anonymous} );

        $f =~ s/\(aID\)/$aid/g;

        $self->{association}->end_transaction('anon');

    }

    # get student data from the students list file, and substitutes

    # into filename

    if ( $self->{names} ) {

        $self->{data}->begin_read_transaction('rAGN');

        my $i = $self->{association}->get_real(@$student);

        $self->{data}->end_transaction('rAGN');

        my $name = 'XXX';

        my $n;

        debug "Association -> ID=$i";

        if ( defined($i) ) {

            debug "Looking for student $self->{association_key} = $i";

            ($n) = $self->{names}

              ->data( $self->{association_key}, $i, test_numeric => 1 );

            if ($n) {

                debug "Found";

                $f = $self->{names}->substitute( $n, $f );

            }

        }

        debug "F[n]=" . show_utf8($f);

    } else {

        $f =~ s/-?\(ID\)//gi;

    }

    # Substitute all spaces and non-ascii characters from the file name

    # if the user asked so.

    if ( $self->{force_ascii} ) {

        $f = string_to_filename( $f, 'copy' );

        debug "F[a]=" . show_utf8($f);

    }

    # The filename we would like to use id $f, but now we have to check

    # it is not already used for another annotated file... and register

    # it.

    $self->{data}->begin_transaction('rSST');

    # check if there is already an up-to-date annotated answer sheet for

    # this student BEFORE removing the entry from the database (and

    # recall this filename).

    my $uptodate_filename = '';

    if ( $self->{changes_only} ) {

        $uptodate_filename = $self->student_uptodate($student);

    }

    # delete the entry from the database, and build a filename that is

    # not already registered for another student (the same or similar to

    # $f).

    $self->{report}->delete_student_report( $self->{type}, @$student );

    $f = $self->{report}->free_student_report( $self->{type}, $f );

    $self->{report}->set_student_report( $self->{type}, @$student, $f, 'now' );

    $self->{data}->end_transaction('rSST');

    debug "F[R]=" . show_utf8($f);

    return ( $f, $uptodate_filename );

}

sub connects_to_database {

    my ($self) = @_;

    # Open connections to the SQLite databases that we will use.

    $self->{data} = AMC::Data->new( $self->{data_dir} );

    for my $m (qw/layout capture association scoring report/) {

        $self->{$m} = $self->{data}->module($m);

    }

    # If they are not already given by the user, read association_key

    # and darkness_threshold from the variables in the database.

    $self->{association_key} =

      $self->{association}->variable_transaction('key_in_list')

      if( !$self->{association_key} );

    $self->{darkness_threshold} =

      $self->{scoring}->variable_transaction('darkness_threshold')

      if ( !$self->{darkness_threshold} );

    $self->{darkness_threshold_up} =

      $self->{scoring}->variable_transaction('darkness_threshold_up')

      if ( !$self->{darkness_threshold_up} );

    # But darkness_threshold_up is not defined for old projects… set it

    # to an inactive value in this case

    $self->{darkness_threshold_up} = 1.0 if ( !$self->{darkness_threshold_up} );

}

sub error {

    my ( $self, $message ) = @_;

    debug_and_stderr("**ERROR** $message");

}

sub needs_data {

    my ($self) = @_;

    if ( !$self->{data} ) {

        $self->connects_to_database;

    }

}

sub connects_students_list {

    my ($self) = @_;

    $self->needs_data();

    # If given, opens the students list and read it.

    if ( -f $self->{names_file} ) {

        $self->{names} = AMC::NamesFile::new(

            $self->{names_file},

            encodage    => $self->{names_encoding},

            identifiant => $self->{csv_build_name}

        );

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

    } else {

        $self->{names} = '';

        if ( $self->{names_file} ) {

            debug "No names file";

        } else {

            debug "Names file not found: $self->{names_file}";

        }

    }

    # Set up a AMC::Substitute object that will be used to substitute

    # marks, student name, and so on in the verdict strings for question

    # scores and global header.

    $self->{subst} = AMC::Substitute::new(

        names     => $self->{names},

        scoring   => $self->{scoring},

        assoc     => $self->{association},

        name      => '',

        chsign    => $self->{significant_digits},

        anonymous => $self->{anonymous},

    );

}

sub needs_names {

    my ($self) = @_;

    if ( !$self->{subst} ) {

        $self->connects_students_list;

    }

}

# get a sorted list of all students, using AMC::Export

sub compute_sorted_students_list {

    my ($self) = @_;

    if ( !$self->{sorted_students} ) {

        # Use AMC::Export that can do the work for us...

        my $sorted_students = AMC::Export->new();

        $sorted_students->set_options(

            'fich',

            datadir => $self->{data_dir},

            noms    => $self->{names_file}

        );

        $sorted_students->set_options(

            'noms',

            encodage => $self->{names_encoding},

            useall   => 0

        );

        $sorted_students->set_options( 'sort', keys => $self->{sort} );

        $sorted_students->pre_process();

        $self->{sorted_students} = $sorted_students;

    }

}

# sort the students so that they are ordered as in the sorted_students

# list

sub sort_students {

    my ($self) = @_;

    $self->compute_sorted_students_list();

    my %include =

      map { studentids_string(@$_) => 1 } ( @{ $self->{students} } );

    $self->{students} = [

        map { [ $_->{student}, $_->{copy} ] }

          grep { $include{ studentids_string( $_->{student}, $_->{copy} ) } }

          ( @{ $self->{sorted_students}->{marks} } )

    ];

}

# get the students to process from a file and return the number of

# students

sub get_students_from_file {

    my ($self) = @_;

    my @students;

    # loads a list of students from a plain text file (one per line)

    if ( -f $self->{id_file} ) {

        my @students;

        open( NUMS, $self->{id_file} );

        while (<NUMS>) {

            if (/^([0-9]+):([0-9]+)$/) {

                push @students, [ $1, $2 ];

            } elsif (/^([0-9]+)$/) {

                push @students, [ $1, 0 ];

            }

        }

        close(NUMS);

        $self->{students} = \@students;

        return ( 1 + $#students );

    } else {

        return (0);

    }

}

# get the students to process from capture data (all students that

# have some data capture -- scan or manual -- on at least one page)

sub get_students_from_data {

    my ($self) = @_;

    $self->needs_data;

    $self->{capture}->begin_read_transaction('gast');

    $self->{students} = $self->{capture}

      ->dbh->selectall_arrayref( $self->{capture}->statement('studentCopies') );

    $self->{capture}->end_transaction('gast');

    return ( 1 + $#{ $self->{students} } );

}

# get the students to process

sub get_students {

    my ($self) = @_;

    my $n = $self->get_students_from_file

      || $self->get_students_from_data;

    # sort this list if we are going to make an unique annotated

    # file with all the students' copies (and if a sort key is given)

    if ( $n > 1 && $self->{single_output} && $self->{sort} ) {

        $self->sort_students();

    }

    debug "Number of students to process: $n";

    return ($n);

}

# get dimensions of a subject page

sub get_dimensions {

    my ($self) = @_;

    $self->needs_data;

    # get width, height and DPI from a subject page (these values should

    # be the same for all pages).

    $self->{data}->begin_read_transaction("aDIM");

    ( $self->{width}, $self->{height}, undef, $self->{dpi} ) =

      $self->{layout}->dims( $self->{layout}->random_studentPage );

    $self->{data}->end_transaction("aDIM");

    # Now, convert all dist_* lenghts to a number of points.

    if ( !$self->{unit_pixels} ) {

        for my $dd ( map { \$self->{ 'dist_' . $_ } }

            (qw/to_box margin margin_globaltext/) )

        {

            $$dd = dim2in($$dd);

        }

        $self->{unit_pixels} = 1;

    }

}

sub needs_dims {

    my ($self) = @_;

    if ( !$self->{dpi} ) {

        $self->get_dimensions;

    }

}

# subprocess (call to AMC-buildpdf) initialisation

sub process_start {

    my ($self) = @_;

    $self->needs_dims;

    $self->{process} = AMC::Subprocess::new(

        mode => 'buildpdf',

        'args' =>

          [ '-d', $self->{dpi}, '-w', $self->{width}, '-h', $self->{height} ]

    );

    $self->command( "embedded " . $self->{embedded_format} );

    if ( $self->{embedded_max_size} =~ /([0-9]*)x([0-9]*)/i ) {

        my $width  = $1;

        my $height = $2;

        $self->command( "max width " .  ( $width  ? $width  : 0 ) );

        $self->command( "max height " . ( $height ? $height : 0 ) );

    }

    $self->command( "jpeg quality " . $self->{embedded_jpeg_quality} );

    $self->command( "margin " . $self->{dist_margin} );

    $self->command("debug") if ( $self->{debug} );

}

# send a command to the subprocess

sub command {

    my ( $self, @command ) = @_;

    $self->{process}->commande(@command);

}

# Sends a (maybe multi-line) text to AMC-buildpdf to be used in the

# following command.

sub stext {

    my ( $self, $text ) = @_;

    $self->command("stext begin\n$text\n__END__");

}

# gets RGB values (from 0.0 to 1.0) from color text description

sub color_rgb {

    my ($s) = @_;

    my $col = Gtk3::Gdk::Color::parse($s);

    if ($col) {

        return ( $col->red / 65535, $col->green / 65535, $col->blue / 65535 );

    } else {

        debug "Color parse error: $col";

        return ( .5, .5, .5 );

    }

}

# set color for drawing

sub set_color {

    my ( $self, $color_string ) = @_;

    $self->command( join( ' ', "color", color_rgb($color_string) ) );

}

# inserts a page from a pdf file

sub insert_pdf_page {

    my ( $self, $pdf_path, $page ) = @_;

    if ( $pdf_path ne $self->{loaded_pdf} ) {

        # If this PDF file is not already loaded by AMC-buildpdf, load it.

        $self->command("load pdf $pdf_path");

        $self->{loaded_pdf} = $pdf_path;

    }

    $self->command("page pdf $page");

}

# get a list of pages for a particular student

sub student_pages {

    my ( $self, $student ) = @_;

    return (

        $self->{layout}->pages_info_for_student( $student->[0], enter_tag => 1 )

    );

}

# Inserts the background for an annotated page. Returns:

#

# -1 if no page were inserted (without compose option, or when the

# page from the subject is not available)

#

# 0 if a scan is used

#

# 1 if a subject page with no answer boxes is used

#

# 2 if a subject page with answer boxes is used

sub page_background {

    my ( $self, $student, $page ) = @_;

    # First get the scan, if available...

    my $page_capture =

      $self->{capture}->get_page( $student->[0], $page->{page}, $student->[1] )

      || {};

    my $scan = '';

    $scan = $self->absolute_path( $page_capture->{src} )

      if ( $page_capture->{src} );

    if ( -f $scan ) {

        # Anonymous mode : erease scan parts where the name, ID, and

        # so on can be found

        my $tmp_scan = '';

        if ( $self->{anonymous} ) {

            debug "Anonymize [$student->[0],$page->{page}] $scan ...";

            my @idzones =

              $self->{layout}->type_info( 'idzone', $student->[0], $page->{page} );

            if (@idzones) {

                debug "Anonymize ".(1+$#idzones)." zones";

                my $fh;

                my $t = AMC::Calage::new;

                $t->set( map { "t_".$_ => $page_capture->{$_} }

                         (qw/a b c d e f/) );

                debug "* Anonymize $scan";

                ( $fh, $tmp_scan ) = tempfile();

                my $bg = magick_perl_module()->new();

                $bg->Read($scan);

                for my $z (@idzones) {

                    my $box=AMC::Boite::new();

                    $box->def_droite_MN(map { $z->{$_} } (qw/xmin ymin xmax ymax/));

                    debug "> ".$box->contour();

                    $box->transforme($t);

                    $bg->Draw(primitive=>'polyline',

                              fill=>'white',

                              stroke=>'black',

                              points=>$box->contour());

                    $bg->Draw(primitive=>'line',

                              stroke=>'blue',

                              points=>$box->diag1());

                    $bg->Draw(primitive=>'line',

                              stroke=>'blue',

                              points=>$box->diag2());

                }

                $bg->Write($tmp_scan);

                $scan = $tmp_scan;

            } else {

                debug "Nothing to anonymize";

            }

        }

        # If the scan is available, use it (with AMC-buildpdf "page png"

        # or "page img" command, depending on the file type). The matrix

        # that transforms coordinates from subject to scan has been

        # computed when automatic data capture was made. It is sent to

        # AMC-buildpdf.

        my $img_type = 'img';

        if ( AMC::Basic::file_mimetype($scan) eq 'image/png' ) {

            $img_type = 'png';

        }

        $self->command("page $img_type $scan");

        $self->command(

            join(

                ' ', "matrix", map { $page_capture->{$_} } (qw/a b c d e f/)

            )

                      );

        if(-f $tmp_scan) {

            unlink($tmp_scan);

        }

        return (0);

    } else {

        if ($scan) {

            debug "WARNING: Registered scan \"$scan\" was not found.";

        }

        # If there is no scan,

        if ( $page->{enter} && -f $self->{pdf_subject} ) {

            # If the page contains something to be filled by the student

            # (either name field or boxes), inserts the page from the PDF

            # subject.

            debug "Using subject page.";

            $self->insert_pdf_page( $self->{pdf_subject},

                $page->{subjectpage} );

            $self->command("matrix identity");

            return (2);

        } else {

            if ( !$page->{enter} ) {

                debug "Page without fields.";

            }

            # With <compose> option, pages without anything to be filled

            # (only subject) are added, from the corrected PDF if available

            # (then the student will see the correct answers easily on the

            # annotated answer sheet).

            if ( -f $self->{pdf_background} ) {

                $self->insert_pdf_page( $self->{pdf_background},

                    $page->{subjectpage} );

                return (1);

            }

        }

        return (-1);

    }

}

# draws one symbol. $b is one row from the capture:pageZones SQL query

# (from which we use only the id_a=question, id_b=answer and role

# attributes). When $tick is true, boxes are tickedas the student did

# (this can be usefull for manual data capture for example, when the

# background is not the scan but the PDF subject, and we want to

# illustrate which boxes has been ticked by the student).

sub draw_symbol {

    my ( $self, $student, $b, $tick ) = @_;

    my $p_strategy = $self->{scoring}->unalias( $student->[0] );

    my $q     = $b->{id_a};                                    # question number

    my $r     = $b->{id_b};                                    # answer number

    my $indic = $self->{scoring}->indicative( $p_strategy, $q )

      ;    # is it an indicative question?

    # ticked on this scan?

    my $cochee = $self->{capture}->ticked(

        @$student, $q, $r,

        $self->{darkness_threshold},

        $self->{darkness_threshold_up}

    );

    # get box position on subject

    my $box =

      $self->{layout}->get_box_info( $student->[0], $q, $r, $b->{role} );

    # when the subject background is used instead of the scan, darken

    # boxes that have been ticked by the student

    if ( $tick && $cochee ) {

        debug "Tick.";

        $self->set_color('black');

        $self->command(

            join( ' ',

                ( $self->{darkness_threshold_up} < 1 ? 'mark' : 'fill' ),

                map { $box->{$_} } (qw/xmin xmax ymin ymax/) )

        );

    }

    return if ( $indic && !$self->{annotate_indicatives} );

    # to be ticked?

    my $bonne = $self->{scoring}->correct_answer( $p_strategy, $q, $r );

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

    # get symbol to draw

    my $sy = $self->{symbols}->{"$bonne-$cochee"};

    if ( $box->{flags} & BOX_FLAGS_DONTANNOTATE ) {

        debug "This box is flagged \"don't annotate\": skipping";

    } else {

        if ( $sy->{type} =~ /^(circle|mark|box)$/ ) {

            # tells AMC-buildpdf to draw the symbol with the right color

            $self->set_color( $sy->{color} );

            $self->command(

                join( ' ',

                    $sy->{type}, map { $box->{$_} } (qw/xmin xmax ymin ymax/) )

            );

        } elsif ( $sy->{type} eq 'none' ) {

        } else {

            debug "Unknown symbol type ($bonne-$cochee): $sy->{type}";

        }

    }

    # records box position so that question scores can be

    # well-positioned

    $self->{question}->{$q} = {} if ( !$self->{question}->{$q} );

    push @{ $self->{question}->{$q}->{x} }, ( $box->{xmin} + $box->{xmax} ) / 2;

    push @{ $self->{question}->{$q}->{y} }, ( $box->{ymin} + $box->{ymax} ) / 2;

}

# draws symbols on one page

sub page_symbols {

    my ( $self, $student, $page, $tick ) = @_;

    # goes through all the boxes on the page

    # the question boxes (in separate answer sheet mode)

    if ( $self->{compose} == 1 ) {

        my $sth = $self->{layout}->statement('pageQuestionBoxes');

        $sth->execute( $student->[0], $page );

        while ( my $box = $sth->fetchrow_hashref ) {

            $self->draw_symbol( $student, $box, 1 );

        }

    }

    # the answer boxes that were captured

    my $sth = $self->{capture}->statement('pageZones');

    $sth->execute( $student->[0], $page, $student->[1], ZONE_BOX );

    while ( my $box = $sth->fetchrow_hashref ) {

        $self->draw_symbol( $student, $box, $tick );

    }

}

# computes the score text for a particular question

sub qtext {

    my ( $self, $student, $question ) = @_;

    my $result = $self->{scoring}->question_result( @$student, $question );

    my $text;

    # begins with the right verdict version depending on if the question

    # result was cancelled or not.

    if ( $result->{why} =~ /c/i ) {

        $text = $self->{verdict_question_cancelled};

    } else {

        $text = $self->{verdict_question};

    }

    # substitute scores values

    $text =~ s/\%[S]/$result->{score}/g;

    $text =~ s/\%[M]/$result->{max}/g;

    $text =~ s/\%[W]/$result->{why}/g;

    $text =~ s/\%[s]/$self->{subst}->format_note($result->{score})/ge;

    $text =~ s/\%[m]/$self->{subst}->format_note($result->{max})/ge;

    # evaluates the result

    my $te = eval($text);

    if ($@) {

        debug "Annotation: $text";

        debug "Evaluation error $@";

    } else {

        $text = $te;

    }

    return ($text);

}

# mean of the y positions of the boxes for one question

sub q_ymean {

    my ( $self, $q ) = @_;

    return ( sum( @{ $self->{question}->{$q}->{y} } ) /

          ( 1 + $#{ $self->{question}->{$q}->{y} } ) );

}

# where to write question status?

# 1) scores written in the left margin

sub qtext_position_marge {

    my ( $self, $student, $page, $question ) = @_;

    my $y = $self->q_ymean($question);

    if ( $self->{rtl} ) {

        return ("stext margin 1 $y 1 0.5");

    } else {

        return ("stext margin 0 $y 0 0.5");

    }

}

# 2) 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.

sub qtext_position_marges {

    my ( $self, $student, $page, $q ) = @_;

    # fist extract the y coordinates of the boxes in the left column

    my $left = 1;

    my @y    = map { $self->{question}->{$q}->{y}->[$_] }

      grep {

        $self->{rtl}

          xor( $self->{question}->{$q}->{x}->[$_] <= $self->{width} / 2 )

      } ( 0 .. $#{ $self->{question}->{$q}->{x} } );

    if ( !@y ) {

        # if empty, use the right column

        $left = 0;

        @y    = map { $self->{question}->{$q}->{y}->[$_] }

          grep {

            $self->{rtl}

              xor( $self->{question}->{$q}->{x}->[$_] > $self->{width} / 2 )

          } ( 0 .. $#{ $self->{question}->{$q}->{x} } );

    }

    # set the x-position to the left or right margin

    my $jx = 1;

    $jx = 0 if ( $left xor $self->{rtl} );

    # set the y-position to the mean of y coordinates of the

    # boxes in the corresponding column

    my $y = sum(@y) / ( 1 + $#y );

    return ("stext margin $jx $y $jx 0.5");

}

# 3) scores written at the side of all the boxes

sub qtext_position_case {

    my ( $self, $student, $page, $q ) = @_;

    my $x = max( @{ $self->{question}->{$q}->{x} } ) +

      ( $self->{rtl} ? 1 : -1 ) * $self->{dist_to_box} * $self->{dpi};

    my $y = $self->q_ymean($q);

    return ("stext $x $y 0 0.5");

}

# 4) scores written in the zone defined by the source file

sub qtext_position_zones {

    my ( $self, $student, $page, $q ) = @_;

    my @c = ();

    for my $b ( $self->{layout}->score_zones( $student->[0], $page, $q ) ) {

        push @c, "stext rectangle "

          . join( " ", map { $b->{$_} } (qw/xmin xmax ymin ymax/) );

    }

    return ( \@c );

}

# writes one question score (or a particular text if given)

sub write_qscore {

    my ( $self, $student, $page, $question, $text, $position ) = @_;

    $position = $self->{position} if(!$position);

    return if ( $position eq 'none' );

    $text = $self->qtext( $student, $question ) if ( !defined($text) );

    # no score to write for indicative questions

    my $p_strategy = $self->{scoring}->unalias( $student->[0] );

    if ( $self->{scoring}->indicative( $p_strategy, $question ) ) {

        debug "Indicative question: no score to write";

        return;

    }

    # if no coordinates, tries with a score zone...

    $position = 'zones' if(!$self->{question}->{$question});

    my $xy      = "qtext_position_" . $position;

    my $command = $self->$xy( $student, $page, $question );

    if ( ref($command) eq 'ARRAY' ) {

        if ( $#$command >= 0 ) {

            $self->stext($text);

            for my $c (@$command) {

                $self->command($c) if ($c);

            }

        }

    } elsif ($command) {

        $self->stext($text);

        $self->command($command);

    }

}

# writes question scores on one page

sub page_qscores {

    my ( $self, $student, $page ) = @_;

    if ( $self->{position} ne 'none' ) {

        $self->set_color( $self->{text_color} );

        # go through all questions present on the page (recorded while

        # drawing symbols)

        for my $q (

            $self->{layout}->page_question_scores( $student->[0], $page ) )

        {

            $self->write_qscore( $student, $page, $q );

        }

    }

}

# write question IDs, for external scoring

sub page_qids {

    my ( $self, $student, $page ) = @_;

    if ( $self->{position} ne 'none' ) {

        $self->set_color( $self->{text_color} );

        for my $q ( @{ $self->{qnobox} } ) {

            $self->write_qscore( $student, $page, $q->{question}, $q->{name},

                'zones' );

        }

    }

}

# draws the page header (only on the first page)

sub page_header {

    my ( $self, $student ) = @_;

    if ( !$self->{header_drawn} ) {

        $self->needs_names;

        $self->set_color( $self->{text_color} );

        $self->command("matrix identity");

        $self->stext(

            $self->{subst}->substitute( $self->{verdict}, @$student ) );

        $self->command(

            "stext "

              . (

                  $self->{rtl}

                ? $self->{width} -

                  $self->{dist_margin_globaltext} * $self->{dpi}

                : $self->{dist_margin_globaltext} * $self->{dpi}

              )

              . " "

              . ( $self->{dist_margin_globaltext} * $self->{dpi} ) . " "

              . ( $self->{rtl} ? "1.0" : "0.0" ) . " 0.0"

        );

        $self->{header_drawn} = 1;

    }

}

# annotate a single page

sub student_draw_page {

    my ( $self, $student, $page ) = @_;

    debug "Processing page $student->[0]:$student->[1] page $page->{page} ...";

    # clears boxes positions data for the page

    $self->{question} = {};

    my $draw = $self->page_background( $student, $page );

    if ( $draw >= 0 ) {

        $self->command("line width $self->{line_width}");

        $self->command("font name $self->{font_name}");

        if(! $self->{header_only} ) {

            $self->page_symbols( $student, $page->{page}, $draw > 0 );

            $self->page_qscores( $student, $page->{page} );

        }

        if ( $self->{anonymous} ) {

            $self->page_qids( $student, $page->{page} );

        }

        $self->command("matrix identity");

        $self->page_header($student);

    } else {

        debug "Nothing to draw for this page";

    }

}

# process a student copy

sub process_student {

    my ( $self, $student ) = @_;

    debug "Processing student $student->[0]:$student->[1]";

    # Computes the filename to use, and check that there is no

    # up-to-date version of the annotated answer sheet (if so, simply

    # keep or rename the file).

    if ( !$self->{single_output} ) {

        my ( $f, $f_ok ) = $self->pdf_output_filename($student);

        debug "Directory " . show_utf8( $self->{pdf_dir} );

        debug "Dest file " . show_utf8($f);

        debug "Existing  " . show_utf8($f_ok);

        my $path = $self->{pdf_dir} . "/$f";

        if ( $f_ok ne '' ) {

            # we only need to move the file!

            debug "The file is up-to-date";

            if ( $f ne $f_ok ) {

                debug "... but has to be moved: $f_ok --> $f";

                my $path_ok = $self->{pdf_dir} . "/$f_ok";

                move( $path_ok, $path )

                  || debug

"ERROR: moving the annotated file in directory $self->{pdf_dir} from $f_ok to $f";

            }

            return ();

        }

        $self->command("output $path");

    }

    # Go through all the pages for the student.

    $self->{data}->begin_read_transaction('aOST');

    $self->{header_drawn} = 0;

    for my $page ( $self->student_pages($student) ) {

        $self->student_draw_page( $student, $page );

    }

    $self->{data}->end_transaction('aOST');

}

# All processing

sub go {

    my ($self) = @_;

    my $n = $self->get_students();

    debug "STUDENTS TO PROCESS: $n\n";

    if ( $n > 0 ) {

        $self->process_start;

        # Anonymous mode: get list of anonymous IDs for stusents, and

        # list of external questions.

        if ( $self->{anonymous} ) {

            $self->{layout}->begin_transaction('aIDQ');

            $self->{qnobox} = $self->{layout}->questions_with_no_box();

            $self->{aIDs} = [

                sort { $a cmp $b }

                  map {

                    $self->{association}

                      ->anonymized( $_->[0], $_->[1], $self->{anonymous} )

                  } @{ $self->{students} }

            ];

            $self->{layout}->end_transaction('aIDQ');

        }

        # With option <single_output>, all annotated answer sheets are

        # made in a single PDF file. We open this file.

        $self->command(

            "output " . $self->{pdf_dir} . "/" . $self->{single_output} )

          if ( $self->{single_output} );

        # Loop over students...

        for my $student ( @{ $self->{students} } ) {

            $self->process_student($student);

            $self->{avance}->progres( 1 / $n ) if ( $self->{avance} );

        }

        # Anonymized sheets: add a spreadsheet with questions that are

        # to be graded externally (with no boxes)

        if ( $self->{anonymous} ) {

            if ( @{ $self->{qnobox} } ) {

                my @empty = ('') x (1+$#{$self->{qnobox}});

                my $csv = Text::CSV->new( { binary => 1, auto_diag => 1 } );

                open my $fh, ">", $self->{pdf_dir} . "/external.csv"

                  or die "Unable to write to $self->{pdf_dir}/external.csv: $!";

                $csv->say( $fh,

                    [ "aID", map { $_->{name} } @{ $self->{qnobox} } ] );

                for my $id ( @{ $self->{aIDs} } ) {

                    $csv->say( $fh,

                        [ $id, @empty ] );

                }

                close $fh;

            }

        }

    }

}

# quit!

sub quit {

    my ($self) = @_;

    $self->{process}->ferme_commande if ( $self->{process} );

    $self->{avance}->fin() if ( $self->{avance} );

}

1;