#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P 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.
#
# A2P 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 A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: IOB.pm 3 2007-10-18 16:20:19Z guillaume $
#
# Class to export Include Object members
#
# cf ref #1, p. 92 & ref #2, p. 180
#

package AFPDS::MODCA::IOB ;

use strict ;
use GD ;
use A2P::Globals ;
use A2P::Syslog ;
use AFPDS::MODCA::Common ;

BEGIN {
    our $VERSION = sprintf "%s", q$Rev: 1172 $ =~ /([0-9.]+)\s+/ ;
}
our $VERSION ;
our @ISA = ("AFPDS::MODCA");
our $IDENTS ;

sub _ID { 0xD3AFC3 }

sub _supported_triplets {
    return [], [
            0x10, # Mandatory object classification only if object type is 0x92
            0x4B, # Measurement units mandatory if coordinates are overrided
            # 0x01, # Coded charset GID
            # 0x02, # FQN
            # 0x04, # Mapping option
            # 0x4C, # object area size
            # 0x4E, # color specs
            # 0x70, # presentation space reset mixing
            # 0x71, # presentation space mixing rules
        ];
}

sub new {
    my $class = shift ;
    &Debug("new " . __PACKAGE__ . " v$VERSION object");

    my $self = {
        FLUX     => 0,        # Associated flux
        IDENT    => _ID,      # MO:DCA identity
        FLAG     => 0,        # MO:DCA flags
        RESERVED => 0,        # MO:DCA reserved
        LONG     => 0,        # MO:DCA buffer length
        BUFFER   => ''        # MO:DCA content buffer
    };

    return bless $self , $class ;
}

sub validate {
    my $self = shift ;

    &Debug("Found IOB to include object");
    &UPSTAT('GET-RESOURCE-INCLUSION');

    # Check minimal buffer size
    return ( 251, "IOB is malformed as too short (" . $self->{LONG} . "<28)" )
        if ( $self->{LONG} < 28 );

    # Check FLUX is a Flux object
    return ( 251, "IOB needs to be used with Flux object" )
        unless ( ref($self->{FLUX}) =~ /^AFPDS::Flux$/ );

    return () ;
}

sub create {
    my $self = shift ;

    # Set resource name
    my $resname = substr( $self->{BUFFER}, 0, 8 );
    $resname = $self->convert( $resname );
    return ( 252, "Invalid resource name found" ) unless $resname ;

    # Set resource name as member as it can be later overrided by X'02' triplet
    $self->name( $resname );

    # Extract values
    my $zero     = $self->get_from_buffer(  8, 1 );
    my $ObjType  = $self->get_from_buffer(  9, 1 );
    my $XoaOset  = $self->get_from_buffer( 10, 3 );
    my $YoaOset  = $self->get_from_buffer( 13, 3 );
    my $XoaOrent = $self->get_from_buffer( 16, 2 );
    my $YoaOrent = $self->get_from_buffer( 18, 2 );
    my $XocaOset = $self->get_from_buffer( 20, 3 );
    my $YocaOset = $self->get_from_buffer( 23, 3 );
    my $RefCSys  = $self->get_from_buffer( 26, 1 );

    # Analyse offsets
    unless ( $XoaOset == 0xFFFFFF ) {
        # This is a signed number
        $XoaOset -= 0x1000000 if ( $XoaOset > 0x7FFFFF );

        # Check and set X off-set
        return ( 252, "Found bad IOB XoaOset ($XoaOset)" )
            if ( $XoaOset < -32768 or $XoaOset > 32767 );
    }
    unless ( $YoaOset == 0xFFFFFF ) {
        # This is a signed number
        $YoaOset -= 0x1000000 if ( $YoaOset > 0x7FFFFF );

        # Check and set X off-set
        return ( 252, "Found bad IOB YoaOset ($YoaOset)" )
            if ( $YoaOset < -32768 or $YoaOset > 32767 );
    }
    unless ( $XocaOset == 0xFFFFFF ) {
        # This is a signed number
        $XocaOset -= 0x1000000 if ( $XocaOset > 0x7FFFFF );

        # Check and set X off-set
        return ( 252, "Found bad IOB XocaOset ($XocaOset)" )
            if ( $XocaOset < -32768 or $XocaOset > 32767 );
    }
    unless ( $YocaOset == 0xFFFFFF ) {
        # This is a signed number
        $YocaOset -= 0x1000000 if ( $YocaOset > 0x7FFFFF );

        # Check and set X off-set
        return ( 252, "Found bad IOB YocaOset ($YocaOset)" )
            if ( $YocaOset < -32768 or $YocaOset > 32767 );
    }

    # Check invalid values
    return ( 252, "Invalid reserved value in IOB ($zero)" )
        if ( $zero );
    return ( 252, "Invalid object type in IOB ($ObjType)" )
        unless ( $ObjType == 0x92 or $ObjType == 0x5F or $ObjType == 0xBB
        or $ObjType == 0xEB or $ObjType == 0xFB );

    # Check supported orientation
    return ( 252, "Unsupported orientation found in IOB ($XoaOrent;$YoaOrent)" )
        unless ( $XoaOrent == 0x0000 and $YoaOrent == 0x2D00 );

    # Check supported system reference
    return ( 252, "Unsupported RefCSys found in IOB ($RefCSys)" )
        unless ( $RefCSys == 0x01 );

    # Analyse now authorized triplets as it is mandatory
    my @err = $self->check_triplets(substr( $self->{BUFFER}, 27 ));
    return @err if @err ;

    # Set a default resolution if not set
    $self->{RESOLUTION} = 240 unless (exists($self->{RESOLUTION}));

    # Get current resolution
    my $reso = $self->{RESOLUTION} ;

    # Update resname if update by triplet X'02', and set it with resolution
    $resname = $self->name ;

    # Check container is opened in flux
    my $flux = $self->{FLUX} ;
    my $container = $flux->get_resource($resname);
    return ( 252, "Resource '$resname' not available" )
        unless ( $container and ref($container) =~ /^AFPDS::MODCA/ );

    # Validate the expected structure of BOC
    my $struct = $container->{STRUCT} || 0 ;
    return ( 253, "Unexpected '$struct' structure found for BOC object" )
        unless ( $struct == 0xDC00 );

    # Validate the expected structure of ourself
    $struct = $self->{STRUCT} || 0 ;
    return ( 253, "Unexpected '$struct' structure found for IOB object" )
        unless ( $struct == 0xA800 );

    if ( $ObjType == 0x92 ) {
        return ( 252, "No OID found in object container for IOB" )
            unless ( exists($container->{OID}) and $container->{OID} );

        # Check triplet X'10' has been set as mandatory here and match container
        return ( 252, "No OID found in object inclusion with IOB" )
            unless ( exists($self->{OID}) and $self->{OID} );
        return ( 253, "OID included is different from container" )
            unless ( $container->{OID} eq $self->{OID} );

        # Check specified class in triplet X'10'
        my $class = $self->{CLASS} || 0 ;
        return ( 253, "Unexpected '$class' class found for IOB object" )
            unless ( $class == 0x01 );

        # Check origins are not set for the object
        return ( 253, "Origin offset not allowed for this IOB object" )
            if ( $XocaOset or $YocaOset );

        # Reset to default offsets for the object if not set
        $XoaOset = 0 if ( $XoaOset == 0xFFFFFF );
        $YoaOset = 0 if ( $YoaOset == 0xFFFFFF );

        # OID is validated, now we only need to handle supported format

        # Get eventually still converted image
        my $teximage = $container->teximage( $reso ) ;

        # Cancel convertion if image is still converted
        unless ( $teximage ) {
            &Debug("Converting $resname resource from $self->{FORMAT} format");

            return ( 254, "Can't process empty $self->{FORMAT} for $resname" )
                unless ( defined($container->{RESOURCE_BUFFER})
                and length($container->{RESOURCE_BUFFER}) > 0 );

            my $image = $self->get_image( \$container->{RESOURCE_BUFFER} );

            return ( 254, "Unsupported $self->{FORMAT} format for $resname" )
                unless ( defined($image) );

            return ( 254, "Can't convert $resname resource" )
                unless ( $image );

            # Get the TeX name for the inclusion directive
            my $texname = $flux->resource_texname($resname);
            return ( 254, "TeX compatible name not set for $resname resource" )
                unless ( defined($texname) and $texname );

            # Tag texname with resolution
            my $tag = $reso ;
            $tag =~ y/0-9/A-J/ ;
            $texname .= 'at' . $tag ;

            # Get the resource number for the PCL inclusion macro
            my $number = $flux->resource_number( $resname, $reso ) ;
            return ( 254, "PCL number not set for $resname resource" )
                unless ( defined($number) );
            return ( 254, "Bad $number PCL number for $resname resource" )
                unless ( $number > -1 and $number < 32768 );

            # Convert image for TeX/LaTeX inclusion
            $teximage = $self->convert_image( $texname, $image,
                \$container->{RESOURCE_BUFFER}, $number, $reso );
            return ( 254, "Can't convert $resname resource for TeX/LaTeX" )
                unless ( defined($teximage) and $teximage and @{$teximage} );

            # Insert TeX/LaTeX directive definitions to allow inclusion
            $flux->addline( '{%', @{$teximage}, '}%' ) ;

            # Keep converted image inclusion in container
            $teximage = $container->teximage( $reso, $texname );
        }

        # Prepare array of Tex/LaTeX lines
        my @texlines = ( "{% $teximage inclusion as $resname at $reso dpi" ) ;

        # TODO Offset should be absolute in the AFP standard
        push @texlines,
            "\\PAGEPUT{\\XX\\kern$XoaOset\\Xunit}{\\YY\\kern$YoaOset\\Yunit}{" .
            "\\$teximage}%",
            "}%" ;

        # Add TeX/LaTeX code to flux for the inclusion
        $flux->addline(@texlines) ;

    } elsif ( $ObjType == 0x5F ) {
        return ( 252, "Unsupported Page Segment ObjType found in IOB" );

    } elsif ( $ObjType == 0xBB ) {
        return ( 252, "Unsupported GOCA Graphics ObjType found in IOB" );

    } elsif ( $ObjType == 0xEB ) {
        return ( 252, "Unsupported BCOCA Bar Code ObjType found in IOB" );

    } elsif ( $ObjType == 0xFB ) {
        return ( 252, "Unsupported IOCA Image ObjType found in IOB" );

    } else {
        return ( 252, "Unsupported ObjType found in IOB ($ObjType)" );
    }

    return () ;
}

sub get_image {
    my $self = shift ;
    return 0 unless ( exists($self->{FORMAT}) and $self->{FORMAT} );

    my $dataref = shift ;
    return 0 unless ( defined($dataref) and $dataref );

    if ( $self->{FORMAT} eq 'GIF' ) {
         return GD::Image->newFromGifData( $$dataref );
    }

    # No supported format
    return undef ;
}

###################### Image convertion to TeX/LaTeX inclusion code
sub convert_image {
    my $self = shift ;
    # We must be called with 4 defined arguments
    return undef unless ( map { defined($_) and $_ } @_[0..3] == 4 );
    my $name = shift ;
    my $image = shift ;
    my $gifref = shift ;
    my $number = shift ;
    my $reso = shift ;

    my ( $width , $height ) = ( $image->width, $image->height );

    # Open TeX/LaTeX global directive declaration with given name
    my @lines = (
        "\\global\\def\\" . $name . "{% as " . $self->name . " at $reso dpi"
        ) ;

    # In case of PDF, we could prepare the resource as PNG image to include
    my $flux = $self->{FLUX} ;
    my $pdf = $flux->getEnv('DO_PDF') =~ /^yes$/i ? 1 : 0 ;
    if ( $pdf ) {
        # Get the image as PNG with compression
        my $png = $image->png($PNGCOMPRESSION);

        # Create the PNG file
        my ( $pngname ) = $flux->getoutbase =~ m|^(.*)/[^/]+$| ;
        $pngname .= '/' . $name . '.png' ;

        # Add PNG image to resource to clean
        $flux->toclean( $pngname );

        unless ( open PNG, '>', $pngname ) {
            &Error("Can't open file $pngname for writing: $!");
            return 0 ;
        }
        binmode(PNG);
        print PNG $png ;
        close(PNG);

        # Insert TeX/LaTeX code for PDF image inclusion
        unshift @lines,
            "\\ifpdf%",
            "\\pdfimageresolution" . $reso . "%",
            "\\pdfximage{$name.png}%",
            "\\newcount\\ximage$name%",
            "\\global\\ximage$name=\\pdflastximage%",
            "\\fi% End pdf inclusion preparation" ;

        # Add TeX/LaTeX for PDF inclusion
        push @lines,
            "\\if\\pcloutput0%",
            "\\ifpdf%",
            "\\ifx\\ximage$name\\undefined\\else%",
            "\\message{PNG[" . $self->name . "]}%",
            "\\pdfrefximage\\ximage$name%",
            "\\fi\\fi%",
            "\\else% End pdf case" ;
    }

    # Handle PCL case
    my $pcl = $flux->getEnv('DO_PCL') =~ /^yes$/i ? 1 : 0 ;
    $pcl = $flux->getEnv('DO_VPCL') =~ /^yes$/i ? 1 : 0
        unless $pcl ;

    if ( $pcl and ! $ONLY_DO_PDF ) {
        # Create the PCL file
        my ( $pclname ) = $flux->getoutbase =~ m|^(.*)/[^/]+$| ;
        $pclname .= '/' . $name . '.pcl' ;

        # Add PCL resource as to be cleaned
        $flux->toclean( $pclname );

        # Check PCL_RESOLUTION environment with a configuration default
        my $resolution = $flux->getEnv('PCL_RESOLUTION') || $PCL_RESOLUTION ;

        # Update the width/height resource expected with the defined resolution
        my $newwidth  = int( $width  * $resolution / $reso ) ;
        my $newheight = int( $height * $resolution / $reso ) ;

        # Prepare the command to start for PCL resource generation
        &Debug("Scaling resource from $width to $newwidth in PCL conversion");
        my $command = sprintf( $GIFTOPCL, $newwidth, $resolution );
        &Debug("Scaling resource with '$command' command")
            if $ADVANCED_DEBUGGING ;

        # Finally the PCL flux is output in a file to be included later
        $command .= " > '$pclname'" ;

        unless ( open PCL, '|' . $command ) {
            &Error("Can't use '$command' for execution: $!");
            return 0 ;
        }
        print PCL $$gifref ;
        close(PCL);

        # Insert TeX/LaTeX code for RAW image inclusion
        unshift @lines,
            "\\if\\pcloutput1%",
            # Specify the macro ID to use and start the macro
            '\\special{pcl5="&f' . $number . 'y0X" ' .
            # Set the raster resource width/height
            'pcl5="*r'. $newwidth .'s'. $newheight .'T" ' .
            "$name.pcl}%", # Include PCL code for the resource
            '\\special{pcl5="&f1X"}%', # Stop the macro
            # Set the global TeX/LaTeX definition
            '\\global\\def\\pclimage' . $name . "{%",
            '\\special{pcl5="&f0s' . # Store the PCL current position
            # Specify the macro ID to use, call it and restore the PCL position
            $number . 'y3x1S"}%',
            "}\\fi% End pcl inclusion preparation" ;

        # Add TeX/LaTeX for PCL inclusion
        push @lines,
            "\\message{PCL[" . $self->name . "]}%",
            "\\pclimage" . $name . "%" ;
    }

    # Close TeX/LaTeX if condition if pdf required
    push @lines, "\\fi% End pcl case" if $pdf ;

    push @lines, "}% End of $name as " . $self->name . " resource" ;

    return \@lines ;
}

&Debug("Module " . __PACKAGE__ . " v$VERSION loaded");

( $IDENTS->{&_ID} ) = __PACKAGE__ =~ /(\w+)$/ ;