unit draw;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)

{$X+}

interface
uses Types, SysUtils,Graphics,
    objlist,variabl,express;

type
   TTransformTerm=class
       //procedure exec(p:Taffine);virtual;abstract;
       function Code:Ansistring;virtual;abstract;
   end;

type
   TTransFormList=class(TObjectList)
       function Code1:ansistring;
       function Code2:ansistring;
       function Code0(m:TMatrix):AnsiString; // for TransForm-mat statement
   end;


function transformation:TTransformList;


implementation

uses
      arithmet, base,base0, texthand, compiler,
      struct,confopt,helpctex,plottext,sconsts{,graphsys}{,gridaxes};



type
   TTransformMatrix=class(TTransformTerm)
          mat:TMatrix;
       constructor  create;
       //procedure exec(p:Taffine);override;
       destructor  destroy;override;
       function Code:ansistring;override;
   end;

   TTransformFunction=class(TTransformTerm)
          exp1,exp2:TPrincipal;
       destructor  destroy;override;
       function Code:ansistring;override;
   end;

   TSHIFT=class(TTransformFunction)
       constructor  create;
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;

   TSCALE=class(TTransformFunction)
       constructor  create(e1:TPrincipal);
       //function Code:ansistring;override;
   end;

   TSCALE1=class(TSCALE)
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;

   TSCALEC=class(TSCALE)
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;

   TSCALE2=class(TSCALE)
       constructor create(e1:TPrincipal);
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;

   TROTATE=class(TTransformFunction)
        rad:extended;
        cost,sint:extended;
       constructor  create;
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;

   TSHEAR=class(TTransformFunction)
        rad:extended;
       constructor  create;
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;


   TcurrentTransform=class(TTransformFunction)
       //procedure exec(p:Taffine);override;
       function Code:ansistring;override;
   end;


type
   ESyntaxError=class(Exception);

constructor TTransformMatrix.create;
begin
    inherited create;
    mat:=NMatrix;
    if mat=nil then raise ESyntaxError.create('');
    if mat.idr.dim<>2 then begin seterrdimension(IDH_PICTURE);raise ESyntaxError.create('') end
end;


constructor TSHIFT.create;
begin
    inherited create;
    gettoken;    { keyword }
    gettoken;    { '(' }
    exp1:=NExpression;
    if (ProgramUnit.arithmetic=PrecisionComplex) and (token<>',') then exit;
    check(',',IDH_PICTURE);
    exp2:=NExpression;
end;

constructor TSCALE.create(e1:TPrincipal);
begin
    inherited create;
    exp1:=e1;
end;

constructor TSCALE2.create(e1:TPrincipal);
begin
    inherited create(e1);
    gettoken;
    exp2:=NExpression;
end;


function scale:TSCALE;
var
   exp1:TPrincipal;
begin
    gettoken;    { keyword }
    gettoken;    { '(' }
    exp1:=NExpression;
    if token=',' then
       result:=TSCALE2.create(exp1)
    else if ProgramUnit.arithmetic=PrecisionComplex then
       result:=TSCALEC.create(exp1)
    else
       result:=TSCALE1.create(exp1)
end;

constructor TROTATE.create;
var
   x:extended;
begin
    inherited create;
    gettoken;    { keyword }
    gettoken;    { '(' }
    exp1:=NExpression;
    if confirmedDegrees then
       rad:=pi/180
    else
       rad:=1;
    if (exp1=nil) then begin raise ESyntaxError.create('') end;
    if (exp1.isConstant) then
       begin
           x:=exp1.evalX;
           cost:=cos(x*rad);
           sint:=sin(x*rad);
           exp1.free;
           exp1:=nil;
        end;
end;

constructor TShear.create;
begin
    inherited create;
    gettoken;    { keyword }
    gettoken;    { '(' }
    exp1:=NExpression;
    if confirmedDegrees then
       rad:=pi/180
    else 
       rad:=1;
    if (exp1=nil) then
                  begin raise ESyntaxError.create('') end;
end;

destructor TTransformmatrix.destroy;
begin
    mat.free;
    inherited destroy;
end;

destructor TTransformFunction.destroy;
begin
    exp1.free;
    exp2.free;
    inherited destroy;
end;



type
   TDRAW=class(TCALL)
           transform:TTransformList;   {collection of PTransformterm }
           substitution: string;   //function(x,y:extended):boolean;   {AXES,GRID}
           exp1,exp2:TPrincipal;
           NoBeamOff:boolean;
       constructor create(prev,eld:TStatement);
       destructor destroy;override;
      // procedure exec;override;
        function OverflowErCode:integer;override;
        function InvalidErCode:integer;override;
        function OpName:string;override;
       {for Code Gen.}
       function Code:AnsiString;override;


   end;

function DRAWst(prev,eld:TStatement):TStatement;
begin
    DRAWst:=TDRAW.create(prev,eld{,idr});
    graphmode:=true;
end;

function transformation:TTransformList;
var
   p:TTransformTerm;
   s:boolean;
begin
   result:=TTransformList.create(4);
   try
           s:=true;
           repeat
              p:=nil;
              if nexttoken='(' then
                 begin
                    if token='SHIFT' then
                       p:=TSHIFT.create
                    else if token='SCALE' then
                       p:=scale
                    else if token='ROTATE' then
                       p:=TROTATE.create
                    else if token='SHEAR' then
                       p:=TSHEAR.create
                    else
                       seterrillegal(token,IDH_PICTURE);
                    check(')',IDH_PICTURE);
                 end
              else if token='TRANSFORM' then
                 begin
                    gettoken;
                    p:=TCurrentTransform.create
                 end
              else
                 p:=TTransformMatrix.create;
              if p<>nil then result.add(p);
              if token='*' then
                  gettoken
              else
                  s:=false;
           until s=false;
    except
      on syntaxError do
        begin
          result.free;
          result:=nil;
        end;
    end;
end;

constructor TDRAW.create(prev,eld:TStatement);
begin
    transform:=nil;

    try
          inherited create(prev,eld,'P')
    except
       on SyntaxError do
       begin
          inherited TStatementCreate(prev,eld);
          {reseterr; }
          if token='AXES0' then
               substitution:='drawaxes0'
          else if token='GRID0' then
               substitution:='drawgrid0'
          else if token='AXES' then
               substitution:='drawaxes2'
          else if token='GRID' then
               substitution:='drawgrid2'
          else if token='CIRCLE' then
               substitution:='drawcircle'
          else if token='DISK' then
              begin
               substitution:='drawdisk';
               NoBeamOff:=true;
              end 
          else
             raise;

          gettoken;
          if token='(' then
             begin
                check('(',IDH_DRAW_axes);
                exp1:=NExpression;
                check(',',IDH_DRAW_axes);
                exp2:=NExpression;
                check(')',IDH_DRAW_axes);
             end;
          statusmes.clear;
          HelpContext:=0;
       end;
    end;

    if token='WITH' then
       begin
          {
          if (pass=2)
             and ParactMain
             and not confirm(s_Paract_DrawWith_incompati,IDH_PARACT) then
                seterr('',IDH_PARACT);
          }
          gettoken;
          transform:=Transformation;
          if transform=nil then seterr('',IDH_PICTURE);

      end;
end;

destructor TDRAW.destroy;
begin
   transform.free;
   inherited destroy;
end;

function TDRAW.OverflowErCode:integer;
begin
  result:=-1005
end;

function TDRAW.InvalidErCode:integer;
begin
   result:=-3009
end;

function TDRAW.OpName:string;
begin
   result:=s_TDrawOpName;
end;


function TTransformMatrix.code:ansistring;
   begin
     result:=' mlt('+mat.code+');'
   end;

function TTransformFunction.Code:ansistring;
begin
  result:='('+exp1.Code+','+exp2.Code+');'
end;

function TSHIFT.Code:Ansistring;
begin
  if exp2<>nil then
     result:=' shift'+inherited code
  else
     result:=' shift('+exp1.Code+');'
end;


function TSCALE1.code:ansistring;
begin
   result:=' scale1('+exp1.Code+');'
end;

function TSCALEC.code:ansistring;
begin
   result:=' cmlt('+exp1.Code+');'
end;

function TSCALE2.Code:ansistring;
begin
  result:=' scale'+inherited code;
end;

function TROTATE.Code:ansistring;
begin
  if exp1=nil then
      result:=' rotate2('+Format20(cost)+','+Format20(sint)+');'
  else if rad=1 then
      result:=' rotate('+exp1.code+');'
  else
      result:=' rotate(('+exp1.code+')*PI/180);'
end;

function TSHEAR.Code:ansistring;
begin
  if rad=1 then
      result:=' shear('+exp1.code+');'
  else
      result:=' shear(('+exp1.code+')*PI/180);'
end;


function TcurrentTransform.Code:ansistring;
begin
  result:=' mlt(CurrentTransform);'
end;

function TTransformList.Code0(m:TMatrix):ansistring;
var
  i:integer;
begin
  result:='WaitReady;'+EOL
         +'With Taffine.create do'+EOL
         +'begin'+EOL;
     for i:=0 to Count-1 do
        result:=result+(items[i] as TTransformTerm).code;
        result:=result +' store(' + m.Code +');'+EOL
               +' free;'+EOL
               +'end;'
end;


function TTransformList.Code1:ansistring;
var
  i:integer;
begin
  result:='PushTransform; ';
  for i:=0 to Count-1 do
    result := result+(items[i] as TTransformTerm).code;
  result:=result +' mlt_next;'+EOL  //nextはcurrenttransformである。
end;

function TTransFormList.Code2:ansistring;
begin
   result:='PopTransform;';
end;

function TDraw.Code:ansistring;
var
  i:integer;
begin
  result:='';
  if Transform<>nil then
     result:=result
            +'EnterCriticalSection(DrawCriticalSection);'+EOL
            +Transform.Code1;

  if not( NoBeamoff or (Routine<>nil) and (Routine.NoBeamOff)) then
     result:=result
            +'BeamManage;'+EOL;


  if substitution='' then
     result:=result+inherited code
  else
     begin
       result:=result+substitution+'(';
       if exp1<>nil then
          result:=result+exp1.code+','
       else
          result:=result+'1,';

       if exp2<>nil then
           result:=result+exp2.code+');'
       else
           result:=result+'1);';
     end;
  result:=result+EOL;

  if not( NoBeamoff or (Routine<>nil) and (Routine.NoBeamOff)) then
     result:=result
       +'BeamManage;'+EOL;

  if Transform<>nil then
     result:=result
            +Transform.Code2+EOL
            +'LeaveCriticalSection(DrawCriticalSection);'+EOL;


end;




procedure statementTableinit;
begin
          StatementTableInitImperative('DRAW',DRAWst);
end;

begin
    tableInitProcs.accept(statementTableinit) ;
    //graphic.transform:=transform;
    //graphic.inversetransform:=transforminv;

end.




