package PDF::Template::Context;

use strict;

BEGIN {
    use vars qw(@ISA);
    @ISA = qw(PDF::Template::Base);

    use PDF::Template::Base;

    use PDF::Template::Constants qw( %PointsPer );
}

# This is a helper object.    It is not instantiated by the user,
# nor does it represent an XML object.    Rather, every container
# will use this object to maintain the context for its children.

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->{FONTS}     = {} unless UNIVERSAL::isa($self->{FONTS},     'HASH');
    $self->{IMAGES}    = {} unless UNIVERSAL::isa($self->{IMAGES},    'HASH');
    $self->{PARAM_MAP} = [] unless UNIVERSAL::isa($self->{PARAM_MAP}, 'ARRAY');
    $self->{STACK}     = [] unless UNIVERSAL::isa($self->{STACK},     'ARRAY');

    $self->reset_pagebreak;

    return $self;
}

sub param {
    my $self = shift;
    my ($param, $depth) = @_;
    $param = uc $param;
    $depth ||= 0;

    my $val = undef;
    my $found = 0;
    for my $map (reverse @{$self->{PARAM_MAP}}) {
        next unless exists $map->{$param};
        $depth--, next if $depth;

        $found = 1;
        $val = $map->{$param};
        last;
    }

    die "Parameter '$param' not found", $/
        if !$found && $self->{DIE_ON_NO_PARAM};

    return $val;
}

#GGG This is god-awful
my %isDimension = map { $_ => 1 } qw(
    X Y W H R
    START_Y END_Y
    X1 X2 Y1 Y2
    PAGE_HEIGHT PAGE_WIDTH
    HEADER_HEIGHT FOOTER_HEIGHT
    LEFT_MARGIN RIGHT_MARGIN
    LMARGIN RMARGIN
    SIZE WIDTH SCALE
);

sub resolve {
    my $self = shift;
    my ($obj, $key, $depth) = @_;
    $key = uc $key;
    $depth ||= 0;

    my $obj_val = $obj->{$key};

    my $is_param = 0;
    if ($obj->{$key} =~ /^\$(\S+)$/o) {
        $is_param = 1;
        $obj_val = $self->param($1)
    }

    return $obj_val unless $isDimension{$key};

#GGG Does this adequately test values to make sure they're legal??
    # A value is defined as:
    #    1) An optional operator (+, -, *, or /)
    #    2) A decimal number
    #    3)    An optional unit (currently I, P, or C) or % (indicating percentage)

#GGG Convert this to use //x
    my ($op, $val, $unit) = $obj_val =~ m!^\s*([\+\*\/\-])?\s*([\d.]*\d)\s*([a-z%]+)?\s*$!oi;
    $op ||= '';

    if ($unit) {
        # Only the first character of the unit is useful, and it needs to be uppercase to key
        # into %PointsPer.
        my $uom = uc substr($unit, 0, 1);

        if ($uom eq '%') {
#GGG Is this all that's needed?
            if ($key eq 'W') {
                $val *= ($self->get($obj, 'PAGE_WIDTH') -
                            $self->get($obj, 'LEFT_MARGIN') -
                            $self->get($obj, 'RIGHT_MARGIN'));
            }
            elsif ($key eq 'H') {
                $val *= ($self->get($obj, 'PAGE_HEIGHT') -
                            $self->get($obj, 'HEADER_HEIGHT') -
                            $self->get($obj, 'FOOTER_HEIGHT'));
            }
            $val /= 100;
        }
        elsif (exists $PointsPer{$uom}) {
            $val *= $PointsPer{$uom};
        }
        else {
            warn "'$unit' is not a recognized unit of measurement.", $/;
        }

        $obj->{$key} = $op . $val unless $is_param;

        $obj_val = $val;
    }

    return $obj_val unless $op;

    my $prev_val = $key eq 'X' || $key eq 'Y'
        ? $self->{$key}
        : $self->get($obj, $key, $depth + 1);

    return $obj_val unless defined $prev_val;
    return $prev_val unless defined $obj_val;

    # Prevent divide-by-zero issues.
    return $val if $op eq '/' and $val == 0;

    my $new_val;
    for ($op) {
        /^\+$/ && do { $new_val = ($prev_val + $val); last; };
        /^\-$/ && do { $new_val = ($prev_val - $val); last; };
        /^\*$/ && do { $new_val = ($prev_val * $val); last; };
        /^\/$/ && do { $new_val = ($prev_val / $val); last; };

        die "Unknown operator '$op' in arithmetic resolve", $/;
    }

    return $new_val if defined $new_val;
    return;
}

sub enter_scope {
    my $self = shift;
    my ($obj) = @_;

    push @{$self->{STACK}}, $obj;

    for my $key (qw(X Y)) {
        next unless exists $obj->{$key};
        $self->{$key} = $self->resolve($obj, $key);
    }

    return 1;
}

sub exit_scope {
    my $self = shift;
    my ($obj, $no_delta) = @_;

    unless ($no_delta) {
        my $deltas = $obj->deltas($self);
        $self->{$_} += $deltas->{$_} for keys %$deltas;
    }

    pop @{$self->{STACK}};

    return 1;
}

sub get {
    my $self = shift;
    my ($dummy, $key, $depth) = @_;
    $depth ||= 0;
    $key = uc $key;

    return unless @{$self->{STACK}};

    my $obj = $self->{STACK}[-1];
    if (exists $obj->{"TEMP_$key"}) {
        my $val = delete $obj->{"TEMP_$key"};
        return $val;
    }

    return $self->{$key} if $key eq 'X' || $key eq 'Y';

    my $val = undef;
    my $this_depth = $depth;
    foreach my $e (reverse @{$self->{STACK}}) {
        next unless exists $e->{$key};
        next if $this_depth-- > 0;

        $val = $self->resolve($e, $key, $depth);
        last;
    }

    $val = $self->{$key} unless defined $val;
    return $val unless defined $val;

    return $self->param($1, $depth) if $val =~ /^\$(\S+)$/o;

    return $val;
}

sub should_render {
    my $self = shift;
    my ($obj) = @_;

    # The objects for which this would be bad are going to bypass this check as they
    # see fit. All other objects should not render if the pagebreak has been tripped.
    return 0 if $self->pagebreak_tripped;

    return $self->check_end_of_page($obj);
}

sub check_end_of_page {
    my $self = shift;
    my ($obj) = @_;

    my $deltas = $obj->deltas($self);

    if (
        ($self->get($obj, 'Y') || 0) + ($deltas->{Y} || 0)
            < ($self->get($obj, 'END_Y') || 0)
    ) {
        $self->trip_pagebreak;
        return 0;
    }

    return 1;
}

sub close_images {
    my $self = shift;
    my $p = $self->{PDF};

    $p->close_image($_) for values %{$self->{IMAGES}};
}

sub new_page_def {
    my $self = shift;

    $self->{PARAM_MAP}[0]{__PAGEDEF__}++;
    $self->{PARAM_MAP}[0]{__PAGEDEF_PAGE__} = 1;
}

sub trip_pagebreak       { $_[0]{PB_TRIP} = 1 }
sub reset_pagebreak      { $_[0]{PB_TRIP} = 0 }
sub pagebreak_tripped    { $_[0]{PB_TRIP} = $_[1] if defined $_[1]; $_[0]{PB_TRIP} }
sub store_font           { $_[0]{FONTS}{$_[1]} ||= $_[2] }
sub retrieve_font        { $_[0]{FONTS}{$_[1]} }
sub delete_fonts         { $_[0]{FONTS} = {}; }
sub store_image          { $_[0]{IMAGES}{$_[1]} ||= $_[2] }
sub retrieve_image       { $_[0]{IMAGES}{$_[1]} }
sub increment_pagenumber { $_[0]{PARAM_MAP}[0]{$_}++ for qw(__PAGE__ __PAGEDEF_PAGE__) }

1;
__END__