unit PDF_contents;

{PDF parser.
Copyright (C) 2008 Danny Milosavljevic <danny_milo@yahoo.com>

This program 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.

This program 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 this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}

{$MODE OBJFPC}
{$M+}

interface
uses variants, classes, contnrs, typinfo;

type
  // see Page 652.
  TOperator = (opInvalid, 
               opShowString {Tj},
               opNextLineShowString {'},
               opNextLineSpacedShowString {"},
               opSetWordSpacing {Tw},
               opSetCharacterSpacing {Tc},
               opSetHorizontalScaling{Tz},
               opSetFontAndSize {Tf},
               opSetTextRenderingMode {Tr},
               opSetTextRise {Ts},
               opMoveCaret {Td},
               opMoveCaretToStartOfNextLine{T*},
               opMoveCaretToStartOfNextLineAndOffsetAndSetLeading{TD},
               opSetTextMatrix {Tm},
               opShowStringWithVariableSpacing {TJ},
               opSetTextLeading {TL} {for T*, ', "},
               opBeginText {BT},
               opEndText {ET},
               
               // special graphics state:
               
               opPushGraphicsState {q},
               opPopGraphicsState {Q},
               opTransformationMatrixAppend {cm},

               // drawing:
               
               opColorSetStrokingColorspace {CS},
               opColorSetStrokingColorLimited {SC},
               opColorSetStrokingColor {SCN},
               opColorSetStrokingGrayColor {G},
               opColorSetStrokingRGBColor {RG}, // colorspace := RGB, Color := <arguments>.
               opColorSetStrokingCMYKColor {K}, // colorspace := CMYK, Color := <arguments>.
               
               opColorSetNonstrokingColorspace {cs},
               opColorSetNonstrokingColorLimited {sc},
               opColorSetNonstrokingColor {scn},
               opColorSetNonstrokingGrayColor {g}, // DUPE.
               opColorSetNonstrokingRGBColor {rg}, // colorspace := RGB, Color := <arguments>
               opColorSetNonstrokingCMYKColor {k}, // colorspace := CMYK, Color := <arguments>.
               
               opPathBegin {m},
               opPathAddLine {l},
               opPathAddCubicBezier123 {c},
               opPathAddCubicBezier23 {v},
               opPathAddCubicBezier13 {y},
               opPathClose {h},
               opPathRectangle {re},

               opPaintStroke {S},
               opPaintCloseAndStroke {s}, // = h S.
               opPaintCloseAndFill {f, F},
               opPaintFillEvenOdd {f*},
               opPaintFillAndStroke {B, like construct, f, construct, S},
               opPaintFillAndStrokeEvenOdd {B*},
               opPaintCloseAndFillAndStroke {b},
               opPaintCloseAndFillAndStrokeEvenOdd {b*},
               opPaintNoPaint {n},
               opPaintExternalObject {Do},
               
               opClipIntersect {W},
               opClipIntersectEvenOdd {W*},
               
               // general graphics state:
               
               opSetLineWidth  {w},
               opSetLineCap    {J},
               opSetLineJoin   {j},
               opSetMiterLimit {M},
               opSetDashPattern{d},
               opSetColorIntent{ri},
               opFlatness      {i},
               opSetParameterValue{gs},
               
               // marks:
               
               opSetMarkedContentPoint{MP},
               opSetMarkedContentPointWithAttributes{DP},
               opBeginMarkedContentBlock{BMC},
               opBeginMarkedContentBlockWithAttributes{BDC},
               opEndMarkedContentBlock{EMC},
               
               // compat:
               opBeginCompabilitySection{EX},
               opEndCompabilitySection{EX}
               
               );
  
  IInstruction = interface
    ['{6682310c-b6ac-11de-939b-338aefb4cc7f}']
    function GetArgument(aIndex : Cardinal) : Variant;
    function GetArgumentCount() : Cardinal;
    function GetOperator_() : TOperator;
    property Operator_ : TOperator read GetOperator_;
    procedure Debug(); // FIXME remove.
  end;
  TInstruction = class(TInterfacedObject, IInstruction, IInterface) // for parsecontent.
  private
    fArguments : Variant; // array of Variant;
    fArgumentCount : Cardinal;
    fOperator_ : TOperator;
  protected
    function GetArgument(aIndex : Cardinal) : Variant;
    function GetArgumentCount() : Cardinal;
    function GetOperator_() : TOperator;
  published
    constructor Create();
    property Operator_ : TOperator read fOperator_ write fOperator_;
    procedure AddArgument(aValue : Variant);
    procedure Debug();
  public
    property Argument[aIndex : Cardinal] : Variant read GetArgument;
    property ArgumentCount : Cardinal read fArgumentCount;
  end;  

  TTextBlock = class;
  //TTextBlock = TInstruction; 
  IContent = interface
    ['{d27d83d0-b3ae-11de-978f-3b027d10c2cc}']
    function GetInstruction(aIndex : Cardinal) : IInstruction;
    function GetInstructionCount() : Cardinal;
    //property Instruction[aIndex : Cardinal] : IInstruction read GetInstruction;
    property InstructionCount : Cardinal read GetInstructionCount;
  end;
  TContent = class(TInterfacedObject, IContent, IInterface)  // sigh... this is only an InterfacedObject because it needs to be in order to go into a variant.
  private
    fInstructions : TInterfaceList;
    fInstructionCount : Cardinal;
  public
    destructor Destroy(); override;
  protected
    function GetInstruction(aIndex : Cardinal) : IInstruction;
    function GetInstructionCount() : Cardinal;
  published
    constructor Create();
    procedure AddInstruction(const aInstruction : IInstruction);
    procedure AddTextBlock(aBlock : TTextBlock);
  public
    property Instruction[aIndex : Cardinal] : IInstruction read GetInstruction;
    property InstructionCount : Cardinal read GetInstructionCount;
  end;
  TTextBlock = class(TContent)
  end; 

implementation
uses sysutils;

{ TInstruction }

constructor TInstruction.Create();
begin
  fArguments := VarArrayCreate([0,200{FIXME}], varVariant); // FIXME does that leak?
  fArgumentCount := 0;
end;

function TInstruction.GetOperator_() : TOperator;
begin
  Result := fOperator_;
end;

function TInstruction.GetArgumentCount() : Cardinal;
begin
  Result := fArgumentCount;
end;

procedure TInstruction.AddArgument(aValue : Variant);
begin
  //if not VarIsArray(aValue) then
  // varIsArray Writeln('T', VarType(aValue));
  fArguments[fArgumentCount] := aValue;
  Inc(fArgumentCount);
  
  // FIXME optimize.
end;

function Str(const aValue : Variant) : String;
var
  vIndex : Cardinal;
begin
  if VarIsStr(aValue) then begin 
    Result := QuotedStr(aValue)
  end else if VarIsArray(aValue) then begin
    Result := '[';
    for vIndex := VarArrayLowBound(aValue, 1) to VarArrayHighBound(aValue, 1) do begin
      Result := Result + Str(aValue[vIndex]);
      Result := Result + ' ';
    end;
    Result := Result + ']';
  end else begin
    Result := aValue;
  end;
end;

procedure TInstruction.Debug();
var
  vIndex : Cardinal;
begin
  Writeln(GetEnumName(TypeInfo(TOperator), Ord(fOperator_)));
  if ArgumentCount > 0 then
    for vIndex := 0 to ArgumentCount  - 1 do begin
try
      Writeln('  Arg#', vIndex, ':', Str(Argument[vIndex]));
except
Writeln('?');
end;
    end;
end;

function TInstruction.GetArgument(aIndex : Cardinal) : Variant;
begin
  assert(aIndex < fArgumentCount);
  Result := fArguments[aIndex];
end;

{ TContent }

destructor TContent.Destroy();
begin
  FreeAndNil(fInstructions);
  inherited Destroy();
end;

constructor TContent.Create();
begin
  fInstructions := TInterfaceList.Create();
end;

function TContent.GetInstruction(aIndex : Cardinal) : IInstruction;
begin
  Result := IInstruction(fInstructions[aIndex]);
end;

procedure TContent.AddInstruction(const aInstruction : IInstruction);
begin
  fInstructions.Add(aInstruction);
  if aInstruction.Operator_ in [
               opShowString {Tj},
               opNextLineShowString {'},
               opNextLineSpacedShowString {"},
               //opSetWordSpacing {Tw},
               //opSetCharacterSpacing {Tc},
               //opSetFontAndSize {Tf},
               //opMoveCaret {Td},
               opShowStringWithVariableSpacing {TJ}] then begin
    // aInstruction.Debug();
  end;
  Inc(fInstructionCount);
end;

procedure TContent.AddTextBlock(aBlock : TTextBlock);
begin
  fInstructions.Add(aBlock);
end;

function TContent.GetInstructionCount() : Cardinal;
begin
  Result := fInstructionCount;
end;

end.