### ----------------------------------------------------
### -- PDF::Content
### -- Licenses: Artistic-2.0
### -- Authors: David Warring
### -- File: lib/PDF/Content/Ops.rakumod
### ----------------------------------------------------
### -- Chunk 2 of 2
|Pair) {
        my Pair $prop = do given $p {
            when Hash {
                # bypass type coercements; create a plan dictionary object
                PDF::COS::Dict.new(:dict($_)).content
            }
            when Str  { :name($_) }
        }
        [ :$name, $prop ]
    },

    # dashArray dashPhase    d
    'd' => sub (Str $op, @array!, Numeric $phase!) {
        die X::PDF::Content::OP::BadArg.new: :$op, :mnemonic(%OpName{$op}), :arg($_)
                                                                                         with @array.first: {$_ !~~ Numeric|Pair};
        [ :@array, $phase ];
    },

    # flatness               i
    # gray                   g | G
    # miterLimit             m
    # charSpace              Tc
    # leading                TL
    # rise                   Ts
    # wordSpace              Tw
    # scale                  Tz
    # lineWidth              w
    'i'|'g'|'G'|'M'|'Tc'|'TL'|'Ts'|'Tw'|'Tz'|'w' => sub (Str, Numeric $val!) {
        [ $val ]
    },

    # lineCap                J
    # lineJoin               j
    # render                 Tr
    'j'|'J'|'Tr' => sub (Str, UInt $val!) {
        [ $val ]
    },

    # x y                    m l
    # wx wy                  d0
    # tx ty                  Td TD
    'd0'|'l'|'m'|'Td'|'TD' => sub (Str, Numeric $n1!, Numeric $n2!) {
        [ $n1, $n2 ]
    },

    # aw ac string           "
    '"' => sub (Str, Numeric $n1!, Numeric $n2!, Str $literal! ) {
        [ $n1, $n2, :$literal ]
    },

    # r g b                  rg | RG
    'rg'|'RG' => sub (Str, Numeric $n1!,
                      Numeric $n2!, Numeric $n3!) {
        [ $n1, $n2, $n3 ]
    },

    # c m y k                k | K
    # x y width height       re
    # x2 y2 x3 y3            v y
    'k'|'K'|'re'|'v'|'y' => sub (Str, Numeric $n1!, Numeric $n2!,
                                      Numeric $n3!, Numeric $n4!) {
        [ $n1, $n2, $n3, $n4 ]
    },

    # x1 y1 x2 y2 x3 y3      c | cm
    # wx wy llx lly urx ury  d1
    # a b c d e f            Tm
    'c'|'cm'|'d1'|'Tm' => sub (Str,
        Numeric $n1!, Numeric $n2!, Numeric $n3!, Numeric $n4!, Numeric $n5!, Numeric $n6!) {
        [ $n1, $n2, $n3, $n4, $n5, $n6 ]
    },

    # c1, ..., cn             sc | SC
    'sc'|'SC' => sub (Str $op, *@args is copy) {

        die X::PDF::Content::OP::TooFewArgs.new: :$op, :mnemonic(%OpName{$op})
            unless @args;

        die X::PDF::Content::OP::BadArg.new: :$op, :mnemonic(%OpName{$op}), :arg($_)
            with @args.first: {$_ !~~ Numeric|Pair};

        @args
    },

    # c1, ..., cn [name]      scn | SCN
    'scn'|'SCN' => sub (Str $op, *@_args) {

        my @args = @_args.list;
        die X::PDF::Content::OP::TooFewArgs.new: :$op, :mnemonic(%OpName{$op})
            unless @args;

        # scn & SCN have an optional trailing name
        my Str $name = @args.pop
            if @args.tail ~~ Str;

        die X::PDF::Content::OP::BadArg.new: :$op, :mnemonic(%OpName{$op}), :arg($_)
            with @args.first: {$_ !~~ Numeric|Pair};

        @args.push: (:$name) if $name.defined;

        @args
    },

 );

my subset Comment of Pair where {.key eq 'comment'}
my subset SuspectOp of Pair where {.key eq '??'}
proto sub op(|c) returns Pair {*}
# semi-raw and a little dwimmy e.g:  op('TJ' => [[:literal<a>, :hex-string<b>, 'c']])
#                                     --> :TJ( :array[ :literal<a>, :hex-string<b>, :literal<c> ] )
multi sub op(Comment $comment) { $comment }
multi sub op(Pair $raw!) {
    my Str $op = $raw.key;
    my @raw-vals = $raw.value.grep(* !~~ Comment);
    # validate the operation and get fallback coercements for any missing pairs
    my @vals = @raw-vals.map: { from-ast($_) };
    my \opn = op($op, |@vals);
    my \coerced-vals = opn.value;

    my @ast-values = @raw-vals.pairs.map: {
        .value.isa(Pair)
            ?? .value
            !! coerced-vals[.key]
    };
    $op => [ @ast-values ];
}
multi sub op(Str $op, |c) {
    with %Ops{$op} {
        CATCH {
            when X::PDF::Content {.rethrow }
            default {
                die X::PDF::Content::OP::Error.new: :$op, :mnemonic(%OpName{$op}), :error($_);
            }
        }
        $op => .($op,|c);
    }
    else {
        die X::PDF::Content::OP::Unknown.new :$op;
    }
}

method is-graphics-op($op-name) {
    my constant GraphicsOps = GeneralGraphicOps ∪ ColorOps ∪ set <cm>;
    $op-name ∈ GraphicsOps;
}

my subset Vector of List is export(:Vector) where {.elems == 2 && .are ~~ Numeric}
#| return current point
method current-point is rw returns List {
    sub FETCH($) {
        $!context == Path
            ?? ($!cur-x, $!cur-y)
            !! List
    }
    sub STORE($,  Vector \v) {
        unless $!context == Path && $!cur-x =~= v[0] && $!cur-x =~= v[1] {
            self.op(MoveTo, |v);
        }
    }
    Proxy.new: :&FETCH, :&STORE;
}
=para This method returns the x,y position of current point in a path context, or an undefined list otherwise.

#| process operator quarantined by PDF::Grammar::Content / PDF::Native::COS as either an
#| unknown operator or having an incorrect argument list
multi method op(SuspectOp $_) {
    given .value {
        my $op = .key;
        if %OpName{$op}:exists {
            # known operator with incorrect arguments
            my @args = .value.map(&from-ast);
            die X::PDF::Content::OP::BadArgs.new: :$op, :@args, :mnemonic(%OpName{$op}) ;
        }
        else {
            # unknown operator
            if $!extended-ops {
                # preserve, if we're in a BX .. EX extension block
                @!ops.push: $_;
            }
            else {
                die X::PDF::Content::OP::Unknown.new: :$op;
            }
        }
    }
}

#| Process a parsed graphics operation
multi method op(*@args is copy) {
    $!content-cache = Nil;
    my \opn = op(|@args);
    my Str $op = do given opn {
        when Comment { .key }
        when Pair {
            @args = .value.map(&from-ast);
            .key.Str
        }
        default {
            .Str;
        }
    }

    if $!strict && !@!gsaves && self.is-graphics-op($op) {
        # not illegal just bad practice to perform graphics outside of a
        # block. makes it harder to later edit/reuse this content stream
        # and may upset downstream utilities
        warn X::PDF::Content::OP::Unexpected.new: :$op, :mnemonic(%OpName{$op}), :type('graphics operator'), :where("outside of a 'q' ... 'Q' (Save .. Restore) graphics block");
    }

    if $op ~~ 'comment' {
        note '% ' ~ opn if $!trace && ! $!comment;
    }
    else {
        if $op ~~ 'BDC'|'DP'|'TJ'|'d'|'ID' {
            # operation may have array or dict operands
            @args .= map: {
                when List { [ .map: { from-ast($_) } ] }
                when Hash { %( .map: {.key => from-ast(.value)} ) }
                default { $_ }
            }
        }

        # built-in callbacks
        my $new-context = self!track-context($op);
        with %Store{$op} {
            .(self, |@args)
        }

        # user supplied callbacks
        if @!callback {
            my $*gfx = self;
            .($op, |@args )
                for @!callback;
        }

        unless $op eq 'ID' {
            if $!comment {
                my $comment = %OpName{$op};
                $comment ~= self!show-updates($op)
                    if $!trace;
                opn.value.push: (:$comment);
            }
            else {
                self!trace($op, opn) if $!trace;
            }
        }

        $!context = $new-context;
    }

    @!ops.push(opn);
    opn;
}

method !show-updates(Str $op) {
    my $updates := do given $op {
        when 'k'|'g'|'rg'  { %(:$!FillColorSpace, :@!FillColor) }
        when 'K'|'G'|'RG'  { %(:$!StrokeColorSpace, :@!StrokeColor) }
        when 'sc'|'scn'    { %(:@!FillColor) }
        when 'SC'|'SCN'    { %(:@!StrokeColor) }
        when 'Td'|'T*'|"'" { %(:@!TextMatrix) }
        when 'TD'          { %(:$!TextLeading, :@!TextMatrix) }
        when '"'           { %(:$!WordSpacing, :$!CharSpacing, :@!TextMatrix) }
        when 'd0'          { %(:$!char-width, :$!char-height) }
        when 'd1'          { %(:$!char-width, :$!char-height, :@!char-bbox) }
        when 'Q'|'gs'      { $.graphics-state(:delta); }
        when 'cm'          { %( :@!CTM ) }
        default {
            my $value = Nil;
            my $op-name := %OpName{$op};
            # look for any miscellaneous setters
            if $op-name.starts-with('Set') {
                given $op-name.substr(3) {
                    $value = %($_ => self."$_"())
                        if %GraphicVars{$_}:exists;
                }
            }
            $value;
        }
    }

    with $updates {
        "\t" ~ to-json($_, :!pretty, :sorted-keys);
    }
    else {
        '';
    }
}

method !trace(Str $op, Pair \opn) {
    my $nesting = @!gsaves.elems + @.open-tags.elems;
    $nesting++ if $!context == Text && $op ne 'ET';
    $nesting-- if $op ∈ Openers && $op ne 'BT';
    my $indent = '  ' x $nesting;
    my PDF::IO::Writer $writer .= new;

    my $str = $indent ~ $writer.write-content(opn);
    my $op-name := %OpName{$op};
    $str ~= "\t% $op-name";

    note $str ~ self!show-updates($op);
}

#| Parse and process graphics operations
multi method ops(Str $ops! --> Array) {
    $.ops: self.parse($ops);
}

#| Parse and process a list of graphics operations
multi method ops(List $ops? --> Array) {
    with $ops {
        self.op($_)
            for .list
    }
    @!ops;
}

#| Add a comment to the content stream
method add-comment(Str $_) {
    @!ops.push: (:comment[$_]);
}

my Bool $have-native-parser;
my $native-parser;
try {
    if (require ::('PDF::Native')).^ver >= v0.1.8 {
        require ::('PDF::Native::COS');
        $native-parser = ::('PDF::Native::COS::COSContent');
        $have-native-parser = True;
    }
}

#| parse, but don't process PDF content operators
multi sub parse-content(Str $content where $have-native-parser) {
    .ast.value with $native-parser.parse($content);
}

multi sub parse-content(Str $content) {
    need PDF::Grammar::Content::Fast;
    need PDF::Grammar::Content::Actions;
    my PDF::Grammar::Content::Actions:D $actions .= new: :lite;
    .ast with PDF::Grammar::Content::Fast.parse($content, :$actions);
}

method parse($content) {
    .List given
       parse-content($content) // die X::PDF::Content::ParseError.new :$content;
}

method !color-args-ok($op, @colors) {
    my Str $cs = do given $op {
        when 'SC'|'SCN' {$!StrokeColorSpace}
        when 'sc'|'scn' {$!FillColorSpace}
    }
    constant %Arity = %(
        'DeviceGray'|'CalGray'|'Indexed' => 1,
        'DeviceRGB'|'CalRGB'|'Lab' => 3,
        'DeviceCMYK' => 4
    );

    with %Arity{$cs} -> \arity {
        my $got = +@colors;
        $got-- if $op.uc eq 'SCN' && @colors.tail ~~ Str;
        die X::PDF::Content::OP::ArgCount.new: :$op, :mnemonic(%OpName{$op}), :error("expected {arity} $cs colors, got: $got")
            unless $got == arity;
    }
    True;
}

method !text-move(Numeric $tx, Numeric $ty) {
    $!tf-x = 0.0; $!tf-y = 0.0;
    @!TextMatrix = [1, 0, 0, 1, $tx, $ty].&multiply: @!TextMatrix;
}

method !new-line {
    self!text-move(0, - $!TextLeading);
}

#| Finish a content stream
method finish is hidden-from-backtrace {
    die X::PDF::Content::Unclosed.new: :message("Unclosed tags {@.open-tags».gist.join: ' '} at end of content stream")
        if @.open-tags;
    die X::PDF::Content::Unclosed.new: :message("'q' (Save) unmatched by closing 'Q' (Restore) at end of content stream")
        if @!gsaves;
    warn X::PDF::Content::Unclosed.new: :message("unexpected end of content stream in $!context context")
        if $!strict && $!context != Page;

    .cb-finish()
        for $!canvas.resources('Font').values;
}

#| serialize content into a string. indent blocks for readability
has Str $!content-cache;
method Str is hidden-from-backtrace { $!content-cache //= self!content }

method !content returns Str is hidden-from-backtrace {
    $.finish;
    if $have-native-parser {
        $native-parser.COERCE(@!ops).write;
    }
    else {
        my PDF::IO::Writer $writer .= new;

        my UInt $nesting = 0;

        @!ops.map({
            my \op = ~ .key;

            $nesting-- if $nesting && op ∈ Closers;
            $writer.indent = '  ' x $nesting;
            $nesting++ if op ∈ Openers;

            my \pad = op eq 'EI'
                         ?? ''
                         !! $writer.indent;
            pad ~ $writer.write-content: $_;
       }).join: "\n";
    }
}

#| serialized current content as a sequence of strings - for debugging/testing
method content-dump returns Seq {
    my PDF::IO::Writer $writer .= new;
    @!ops.map: { $writer.write-content($_) };
}

method dispatch:<.?>(\name, |c) is raw {
    self.can(name) || %OpCode{name} ?? self."{name}"(|c) !! Nil
}
#++ avoid flattening issues on lists
method ShowSpaceText(List $args) {
    self.op(OpCode::ShowSpaceText, $args);
}
method SetDashPattern(List $args, Numeric $phase) {
    self.op(OpCode::SetDashPattern, $args, $phase);
}
#-- avoid flattening issues on lists
#| Treat operator mnemonics as methods
method FALLBACK($method, |c) {
    with %OpCode{$method} -> \op-code {
        # e.g. $.Restore :== $.op('Q', [])
        self.op(op-code, |c);
    }
    else {
        my $typename := self.^name;
        die X::Method::NotFound.new: :$method, :$typename;
    }
}




