unit graphic;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)



{********}
interface
{********}
uses Graphics,Types,Forms,Dialogs,SysUtils,
     struct,variabl;

type
   TAskStatus=Class(Tstatement)
      Status:TVariable;
     //procedure StatusInit;
     destructor destroy;override;
     function Code:Ansistring;override;
     function AskCode:Ansistring;virtual;abstract;
   end;
function  ASKst(prev,eld:TStatement):TAskStatus;

function PixelX(x:double):double;
function PixelY(x:double):double;
function WindowX(x:double):double;
function WindowY(x:double):double;


var
   SetTextJustifySt:function(prev,eld:TStatement):TStatement;
   PlotTextst:      function(prev,eld:TStatement):TStatement;


function MATPLOTst(prev,eld:TStatement):TStatement;
function MATLOCATEst(prev,eld:TStatement):TStatement;
function MSLINEst(prev,eld:TStatement):TStatement;



{************}
implementation
{************}
uses
     MyUtils,base,base0,objlist,float{,affine},texthand,
     express, mat,setask,helpctex, statemen,
     draw,sconsts,confopt{,graphsys};

{********}
{graphics}
{********}
type
     setprocedure=procedure(x:double; insideofWhen:boolean);


type
    TCustomSetWindow=class(TStatement)
       x1,x2,y1,y2:TPrincipal;
       destructor destroy;override;
       //procedure exec;override;
       function codesub:ansistring;
      end;

    TSetWindow=class(TCustomSetWindow)
       constructor create(prev,eld:TStatement);
       function Code:AnsiString;override;
    end;

   TSetDeviceViewPort=class(TSetWindow)
       //procedure exec;override;
       //function execute(var l,r,b,t:extended):boolean;override;
       function Code:AnsiString;override;
    end;

   TSetDeviceWindow=class(TSetDeviceViewport)
       //procedure exec;override;
       function Code:AnsiString;override;
    end;

   TSetViewPort=class(TSetDeviceViewport)
       //procedure exec;override;
       function Code:AnsiString;override;
    end;


constructor TsetWindow.create(prev,eld:TStatement);
label
   errorExit;
begin
    inherited create(prev,eld);
    graphmode:=true;
    x1:=nexpression;
    check(',',IDH_WINDOW);
    x2:=nexpression;
    check(',',IDH_WINDOW);
    y1:=nexpression;
    check(',',IDH_WINDOW);
    y2:=nexpression;
end;

destructor TCustomSetWindow.destroy;
begin
    x1.free;
    x2.free;
    y1.free;
    y2.free;
    inherited destroy
end;



type
    TSetColorMix=class(TStatement)
       ColorIndex,Red,Green,Blue:TPrincipal;
       constructor create(prev,eld:TStatement);
       destructor destroy;override;
       //procedure exec;override;
       function code:ansistring;override;
      end;




constructor TsetColorMix.create(prev,eld:TStatement);
begin
    graphmode:=true;
    inherited create(prev,eld);
    Check('(',IDH_SET_COLOR_MIX);
    ColorIndex:=nexpression;
    check(')',IDH_SET_COLOR_MIX);
    Red:=nexpression;
    check(',',IDH_SET_COLOR_MIX);
    Green:=nexpression;
    check(',',IDH_SET_COLOR_MIX);
    Blue:=nexpression;
end;

destructor TSetColorMix.destroy;
begin
    ColorIndex.free;
    Red.free;
    Green.free;
    Blue.free;
    inherited destroy
end;




type
     TSET=class(TStatement)
          exp:TPrincipal;
          setprc:string;
          idxmax:integer;
          ercode:integer;
        constructor create(prev,eld:TStatement; s:string; imax:integer; erc:integer);
        constructor createColor(prev,eld:TStatement; s:string);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSet.create(prev,eld:TStatement; s:string; imax:integer; erc:integer);
begin
   inherited create(prev,eld);
   exp :=nexpression;
   setprc:=s;
   idxmax:=imax;
   ercode:=erc;
end;

constructor TSet.createColor(prev,eld:TStatement; s:string);
begin
   inherited create(prev,eld);
   exp :=NSExpression;
   setprc:=s;
   idxmax:=255;
   ercode:=11085;
end;


destructor TSet.destroy;
begin
   exp.free;
   inherited destroy
end;



type
     TSetDrawMode=class(TStatement)
        mode:char;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
       function code:ansistring;override;
      end;

constructor TSetDrawMode.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   if (token='EXPLICIT')
     or (token='HIDDEN')
     or (token='MERGE')
     or (token='XOR')
     or (token='NOTXOR')
     or (token='OVERWRITE')  then
         mode:=token[1]
   else if token='MASK' then
         mode:='A'
   else
      seterrIllegal(token,0);
   gettoken;
end;



{SET TEXT HEIGHT}
type
     TSetTextHeight=class(TStatement)
          exp:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetTextHeight.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp :=nexpression;
end;

destructor TSetTextHeight.destroy;
begin
   exp.free;
   inherited destroy
end;


{ask text height}

{SET TEXT ANGLE}
type
     TSetTextAngle=class(TStatement)
          exp:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetTextAngle.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp :=nexpression;
end;

destructor TSetTextAngle.destroy;
begin
   exp.free;
   inherited destroy
end;


type
     TSetClip=class(TStatement)
          exp:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetClip.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp :=sexpression;
end;

destructor TSetClip.destroy;
begin
   exp.free;
   inherited destroy
end;

{SET TEXT Font}
type
     TSetTextFont=class(TStatement)
          exp1,exp2:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetTextFont.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1 :=SExpression;
   //checktoken(',',IDH_GRAPH_EXT);
   if test(',') then             //2013.12.21
      exp2:=NExpression;
end;

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



{TSetTextBk}

type
     TSetTextBk=class(TStatement)
          exp:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetTextBk.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp :=sexpression;
end;

destructor TSetTextBk.destroy;
begin
   exp.free;
   inherited destroy
end;


type
  TSetAreaStyle=class(TSetTextBk)
        //procedure exec;override;
       function code:ansistring;override;
  end;



type
     TSetBitmapSize=class(TStatement)
          exp1,exp2:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
       function code:ansistring;override;
      end;

constructor TSetBitmapSize.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1 :=NExpression;
   checktoken(',',IDH_GRAPH_EXT);
   exp2:=NExpression;
end;

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



type
     TSetColorMode=class(TStatement)
          exp1:TPrincipal;
        constructor create(prev,eld:TStatement);
        destructor destroy;override;
        //procedure exec;override;
       function code:ansistring;override;
      end;

constructor TSetColorMode.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=SExpression;
end;

destructor TSetColorMode.destroy;
begin
     exp1.free;
    inherited destroy
end;



type
   TSetBeamMode=class(TsetColorMode)
        //procedure exec;override;
       function code:ansistring;override;
end;

const
    MaxLineStyle=5;
    MaxPointStyle=7;
    MaxAreaStyleIndex=6;

function  SETst(prev,eld:TStatement):TStatement;
begin
    setst:=nil;
    if token='WINDOW' then
       begin
            gettoken;
            SETst:=TSetWindow.create(prev,eld);
       end
    else if  (token='VIEWPORT') then
       begin
            gettoken;
            SETst:=TSetViewport.create(prev,eld);
       end
    else if (token='DEVICE') then
        begin
           gettoken;
           if (token='WINDOW')  then
                 begin
                     gettoken;
                     SETst:=TSetDeviceWindow.create(prev,eld)
                 end
          else if(token='VIEWPORT') then
               begin
                    gettoken;
                    SETst:=TSetDeviceViewport.create(prev,eld)
               end
        end
    else if  (token='CLIP') then
       begin
            gettoken;
            SETst:=TSetClip.create(prev,eld);
       end
    else if  (token='LINE') then
        begin
            gettoken;
            if  (token='COLOR')  then
                begin
                    gettoken;
                    SETst:=TSet.createColor(prev,eld,'setlinecolor')
                end
            else if(token='STYLE') then
               begin
                    gettoken;
                    SETst:=TSet.create(prev,eld,'setlinestyle',maxlinestyle,11062)
               end
            else if(token='WIDTH') then
               begin
                    gettoken;
                    SETst:=TSet.create(prev,eld,'setlinewidth',maxint,11062)
               end
        end
    else if (token='POINT') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     SETst:=TSet.createColor(prev,eld,'setpointcolor')
                 end
          else if(token='STYLE') then
               begin
                    gettoken;
                    SETst:=TSet.create(prev,eld,'setpointstyle',maxpointstyle,11056)
               end
        end
    else if (token='AREA') then
        begin
           gettoken;
           if (token='COLOR') then
              begin
                 gettoken;
                 SETst:=TSet.createColor(prev,eld,'setareacolor')
              end

           else if(token='STYLE') then
              begin
                gettoken;
                if token='INDEX' then
                   begin
                      gettoken;
                      SETst:=TSet.create(prev,eld,'SetAreaStyleIndex',MaxAreaStyleIndex,11000)
                   end
                else
                    SETst:=TSetAreaStyle.create(prev,eld)
              end

        end
    else if (token='TEXT') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     SETst:=TSet.createColor(prev,eld,'settextcolor')
                 end

           else if(token='JUSTIFY') then
               begin
                    gettoken;
                    SETst:=SetTextJustifySt(prev,eld);
               end
           else if(token='HEIGHT') then
               begin
                    gettoken;
                    SETst:=TSetTextHeight.create(prev,eld);
               end
           else if(token='ANGLE') then
               begin
                    gettoken;
                    confirmedDegrees;
                    SETst:=TSetTextAngle.create(prev,eld);
               end
           else if(token='FONT') then
               begin
                    gettoken;
                    SETst:=TSetTextFont.create(prev,eld);
               end

           else if(token='BACKGROUND') then
               begin
                    gettoken;
                    SETst:=TSetTextBk.create(prev,eld);
               end

        end
    else if (token='COLOR')  then
        begin
           gettoken;
           if token='MIX' then
              begin
                 gettoken;
                 SETst:=TSetColorMix.create(prev,eld)
              end
           else if token='MODE' then
              begin
                 gettoken;
                 SETst:=TSetColorMode.create(prev,eld)
              end
           else
              SETst:=TSet.createColor(prev,eld,'setallcolor');
        end
    else if (token='DRAW')  then
        begin
           gettoken;
           checkToken('MODE',0);
           SETst:=TSetDrawMode.create(prev,eld);
        end
    else if (token='AXIS') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     SETst:=TSet.createColor(prev,eld,'setaxiscolor')
                 end
        end
    else if (token='BITMAP') then
        begin
           gettoken;
           if (token='SIZE')  then
                 begin
                     gettoken;
                     SETst:=TSetBitMapSize.create(prev,eld)
                 end
        end
    else if (token='BEAM')  then
        begin
           gettoken;
           checkToken('MODE',0);
           SETst:=TSetBeamMode.create(prev,eld);
        end
    else
        SETst:=SetAsk.SETst(prev,eld);
end;


{**************}
{ASK statements}
{**************}


destructor TaskStatus.destroy;
begin
    status.free;
    inherited destroy;
end;


type
  TAskWindow=class(TaskStatus)
    exp1,exp2,exp3,exp4:TVariable;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function askCode:ansistring;override;
    function AskFuncName:ansistring;virtual;
   end;


constructor TAskWindow.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=nvariable;
   check(',',IDH_WINDOW);
   exp2:=nvariable;
   check(',',IDH_WINDOW);
   exp3:=nvariable;
   check(',',IDH_WINDOW);
   exp4:=nvariable;

    if exp1 is TSubstance then
         TSubstance(exp1).AddQueryInteger(nil); //Integer不適格
    if exp2 is TSubstance then
         TSubstance(exp2).AddQueryInteger(nil); //Integer不適格
    if exp3 is TSubstance then
         TSubstance(exp3).AddQueryInteger(nil); //Integer不適格
    if exp4 is TSubstance then
         TSubstance(exp4).AddQueryInteger(nil); //Integer不適格

end;

destructor TAskWindow.destroy;
begin
    exp1.free;
    exp2.free;
    exp3.free;
    exp4.free;
    inherited destroy;
end;

type
   TAskViewport=class(TAskWindow)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
   end;

type
   TAskDeviceWindow=class(TAskWindow)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
   end;


type
   TAskDeviceViewport=class(TAskWindow)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
   end;



type
    getfunction=function:integer;

function getlinecolor:integer;
begin
    //getlinecolor:=MyGraphSys.linecolor;
end;

function getlinestyle:integer;
begin
    //getlinestyle:=Integer(MyGraphSys.PenStyle) + 1;
end;

function getlinewidth:integer;
begin
    //getlinewidth:=MyGraphSys.linewidth;
end;

function getpointcolor:integer;
begin
    //getpointcolor:=MyGraphSys.pointcolor;
end;

function getpointstyle:integer;
begin
   // getpointstyle:=MyGraphSys.pointstyle;
end;

function getareacolor:integer;
begin
    //getareacolor:=MyGraphSys.areacolor;
end;

function gettextcolor:integer;
begin
    //gettextcolor:=MyGraphSys.textcolor;
end;

function getmaxcolor:integer;
begin
    //if mypalette.PaletteDisabled then
    //  result:=$ffffff
   // else
     // result:=GraphSys.maxcolor;
end;

function getaxiscolor:integer;
begin
   // getaxiscolor:=GraphSys.axescolor;
end;

function getMaxPointDevice:integer;
begin
  result:=1
end;

function getMaxMultiPointDevice:integer;
begin
  result:=1
end;

function getMaxChoiceDevice:integer;
begin
  result:=8
end;

function getMaxValueDevice:integer;
begin
  result:=1
end;

function getAreaStyleIndex:integer;
begin
  //result:=MyGraphSys.AreaStyleIndex;
end;




function getmaxlinestyle:integer;
begin
   //  getmaxlinestyle:=MaxLineStyle
end;

function getmaxpointstyle:integer;
begin
   //  getmaxpointstyle:=MaxPointStyle
end;


type
  TAsk=class(TaskStatus)
    exp:TVariable;
    get:getfunction;
    constructor create(prev,eld:TStatement; g:getfunction);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:ansistring;override;
    function AskFuncName:ansistring;virtual;
   end;

constructor TAsk.create(prev,eld:TStatement; g:getfunction);
begin
   inherited create(prev,eld);
   exp:=nvariable;
   get:=g;
   if exp is TSubstance then
         TSubstance(exp).AddQueryInteger(nil); //Integer不適格
end;

destructor TAsk.destroy;
begin
    exp.free;
    inherited destroy;
end;


type
  TAskTextHeight=class(TAsk)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
  end;

type
  TAskTextAngle=class(TAsk)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
  end;


type
  TAskPixelSize=class(TaskStatus)
    exp1,exp2,exp3,exp4:TPrincipal;
    var1,var2:TVariable;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:ansistring;override;
   end;

constructor TAskPixelSize.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   if token='(' then
      begin
        check('(',IDH_PIXEL_SIZE);
        exp1:=NExpression;
        check(',',IDH_PIXEL_SIZE);
        exp2:=NExpression;
        check(';',IDH_PIXEL_SIZE);
        exp3:=NExpression;
        check(',',IDH_PIXEL_SIZE);
        exp4:=NExpression;
        check(')',IDH_PIXEL_SIZE);
      end;
   var1:=NVariable;
   check(',',IDH_PIXEL_SIZE);
   var2:=NVariable;

   //var1,var2を一斉にinteger　or doubleにする.
   if var1 is TSubstance  then
        TSubstance(var1).AddQueryInteger(var2.queryInteger);
   if var2 is TSubstance then
        TSubstance(var2).AddQueryInteger(var1.queryInteger);
end;

destructor TAskPixelSize.destroy;
begin
   exp1.free;
   exp2.free;
   exp3.free;
   exp4.free;
   var1.free;
   var2.free;
   inherited destroy;
end;


type
  TAskPixelValue=class(TaskStatus)
    exp1,exp2:TPrincipal;
    var1:TVariable;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function ASkCode:ansistring;override;
   end;

constructor TAskPixelValue.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   check('(',IDH_PIXEL);
   exp1:=NExpression;
   check(',',IDH_PIXEL);
   exp2:=NExpression;
   check(')',IDH_PIXEL);
   var1:=NVariable;
   if var1 is TSubstance then
        TSubstance(var1).AddQueryInteger(nil); //Integer不適格

end;

destructor TAskPixelValue.destroy;
begin
   exp1.free;
   exp2.free;
   var1.free;
   inherited destroy;
end;


type
  TAskDeviceSize=class(TaskStatus)
    exp1,exp2:TVariable;
    exp3:TStrVari;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:ansistring;override;
   end;


constructor TAskDeviceSize.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=nvariable;
   check(',',IDH_GRAPHICS);
   exp2:=nvariable;
   check(',',IDH_GRAPHICS);
   exp3:=Strvari;

   if exp1 is TSubstance then
        TSubstance(exp1).AddQueryInteger(nil); //Integer不適格
   if exp2 is TSubstance then
        TSubstance(exp2).AddQueryInteger(nil); //Integer不適格

end;

destructor TAskDeviceSize.destroy;
begin
    exp1.free;
    exp2.free;
    exp3.free;
    inherited destroy;
end;

type
  TAskBitmapSize=class(TaskStatus)
    exp1,exp2:TVariable;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:AnsiString;override;
   end;


constructor TAskBitmapSize.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=nvariable;
   check(',',IDH_GRAPHICS);
   exp2:=nvariable;

   if exp1 is TSubstance then
        TSubstance(exp1).AddQueryInteger(nil); //Integer不適格
   if exp2 is TSubstance then
        TSubstance(exp2).AddQueryInteger(nil); //Integer不適格

end;

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


type
  TAskPixelArray=class(TaskStatus)
    exp1,exp2:TPrincipal;
    mat1:TMatrix;
    exp3:TStrVari;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function ASkCode:ansistring;override;
   end;

constructor TAskPixelArray.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   check('(',IDH_PIXEL);
   exp1:=NExpression;
   check(',',IDH_PIXEL);
   exp2:=NExpression;
   check(')',IDH_PIXEL);
   mat1:=NMatrix;
   if mat1.idr.dim<>2 then seterrDimension(IDH_PIXEL);
   if test(',') then
         exp3:=StrVari;
end;

destructor TAskPixelArray.destroy;
begin
   exp1.free;
   exp2.free;
   mat1.free;
   exp3.free;
   inherited destroy;
end;
(*
procedure TAskPixelArray.exec;
var
   x1,y1:longint;
   i,j:longint;
   p:TArray;
   c:integer;
   text:ansistring;
begin
       StatusInit;
       x1:=MyGraphSys.DeviceX(exp1.evalX);
       y1:=MyGraphSys.DeviceY(exp2.evalX);
       TVar(p):=mat1.point;
       text:='PRESENT';
       if p<>nil then
          begin
             for i:=0 to p.size[1]-1 do
                 for j:=0 to p.size[2]-1 do
                     begin
                         c:=MyGraphSys.ColorIndexOf(x1+i,y1+j);
                         with p do ItemAssignLongint(i*size[2]+j,c);
                         if c=-1 then text:='ABSENT';
                     end;
             if exp3<>nil then
                exp3.substS(text);
          end
end;
*)

type
  TAskTextJustify=class(TaskStatus)
    exp1,exp2:TStrVari;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:Ansistring;override;
   end;


constructor TAskTextJustify.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=StrVari;
   check(',',IDH_TEXT);
   exp2:=StrVari;
end;

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

type
    TAskTextWidth=class(TaskStatus)
       Text:TPrincipal;
       Width:TVariable;
       constructor create(prev,eld:TStatement);
       destructor destroy;override;
       //procedure exec;override;
       function AskCode:AnsiString;override;
      end;

constructor TAskTextWidth.create(prev,eld:TStatement);
begin
    inherited create(prev,eld);
    Check('(',IDH_COLOR);
    Text:=SExpression;
    check(')',IDH_COLOR);
    Width:=NVariable;
   if Width is TSubstance then
        TSubstance(Width).AddQueryInteger(nil); //Integer不適格

end;

destructor TAskTextWidth.destroy;
begin
    Text.free;
    Width.free;
    inherited destroy
end;


type
    TAskColorMix=class(TaskStatus)
       ColorIndex:TPrincipal;
       Red,Green,Blue:TVariable;
       constructor create(prev,eld:TStatement);
       destructor destroy;override;
       //procedure exec;override;
       function AskCode:ansistring;override;
      end;

constructor TAskColorMix.create(prev,eld:TStatement);
begin
    inherited create(prev,eld);
    Check('(',IDH_COLOR);
    ColorIndex:=nexpression;
    check(')',IDH_COLOR);
    Red:=NVariable;
    check(',',IDH_COLOR);
    Green:=NVariable;
    check(',',IDH_COLOR);
    Blue:=NVariable;

   if Red is TSubstance then
        TSubstance(Red).AddQueryInteger(nil); //Integer不適格
   if Green is TSubstance then
        TSubstance(Green).AddQueryInteger(nil); //Integer不適格
   if Blue is TSubstance then
        TSubstance(Blue).AddQueryInteger(nil); //Integer不適格

end;

destructor TAskColorMix.destroy;
begin
    ColorIndex.free;
    Red.free;
    Green.free;
    Blue.free;
    inherited destroy
end;

{
procedure AskColorMix(cc:integer;var r,g,b:byte);
var
   col:TColor;
begin
   col:=MyPalette[cc];
   b:=(col and $ff0000) div $10000;
   g:=(col and $00ff00) div $100;
   r:=col and $0000ff;
end;
}

type
  TAskClip=class(TaskStatus)
    exp:TStrVari;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    destructor destroy;override;
    function AskCode:ansistring;override;
    function AskFuncName:ansistring;virtual;
   end;


constructor TAskClip.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp:=StrVari;
end;

destructor TAskClip.destroy;
begin
    exp.free;
    inherited destroy;
end;

type
  TAskAreaStyle=class(TAskClip)
     // procedure exec;override;
    function AskFuncName:ansistring;override;
  end;


type
  TAskColorMode=class(TAskClip)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
  end;

type
  TAskBeamMode=class(TAskClip)
    //procedure exec;override;
    function AskFuncName:ansistring;override;
  end;

type
  TAskTextBack=class(TAskClip)
      //procedure exec;override;
     function AskFuncName:ansistring;override;
  end;


type
  TAskTextFont=class(TaskStatus)
    exp1:TStrVari;
    exp2:TVariable;
    constructor create(prev,eld:TStatement);
    //procedure exec;override;
    function AskCode:Ansistring;override;
    destructor destroy;override;
   end;


constructor TAskTextFont.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=StrVari;
   check(',',IDH_TEXT);
   exp2:=NVariable;
end;

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


function  ASKst(prev,eld:TStatement):TAskStatus;
begin
    ASKst:=nil;
    if token='WINDOW' then
       begin
            gettoken;
            ASKst:=TAskWindow.create(prev,eld);
       end
    else if token='VIEWPORT' then
       begin
            gettoken;
            ASKst:=TAskViewport.create(prev,eld);
       end
    else if  (token='LINE') then
        begin
            gettoken;
            if  (token='COLOR')  then
                begin
                    gettoken;
                    ASKst:=TAsk.create(prev,eld,getlinecolor)
                end
            else if(token='STYLE') then
               begin
                    gettoken;
                    ASKst:=TAsk.create(prev,eld,getlinestyle)
               end
            else if(token='WIDTH') then
               begin
                    gettoken;
                    ASKst:=TAsk.create(prev,eld,getlinewidth)
               end
        end
    else if (token='POINT') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     askst:=TAsk.create(prev,eld,getpointcolor)
                 end
          else if(token='STYLE') then
               begin
                    gettoken;
                    ASKst:=TAsk.create(prev,eld,getpointstyle)
               end
        end
    else if (token='AREA') then
        begin
           gettoken;
           if (token='COLOR')  then
               begin
                  gettoken;
                  ASKst:=TAsk.create(prev,eld,getareacolor)
               end
           else if(token='STYLE') then
               begin
                  gettoken;
                  if token='INDEX' then
                     begin
                       gettoken;
                       ASKst:=TAsk.create(prev,eld,getAreaStyleIndex);
                     end
                  else
                     ASKst:=TAskAreaStyle.create(prev,eld)
                end
        end
    else if (token='TEXT') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     ASKst:=TASK.create(prev,eld,gettextcolor)
                 end
           else if (token='HEIGHT')  then
                 begin
                     gettoken;
                     ASKst:=TASKTextHeight.create(prev,eld,nil)
                 end
           else if (token='ANGLE')  then
                 begin
                     gettoken;
                     confirmedDegrees;
                     ASKst:=TASKTextAngle.create(prev,eld,nil);
                 end
           else if(token='JUSTIFY') then
               begin
                    gettoken;
                    ASKst:=TAskTextJustify.create(prev,eld)
               end
           else if(token='WIDTH') then
               begin
                    gettoken;
                    ASKst:=TAskTextWidth.create(prev,eld)
               end
           else if(token='BACKGROUND') then
              begin
                   gettoken;
                   ASKst:=TAskTextBack.create(prev,eld)
              end
          else if(token='FONT') then
              begin
                   gettoken;
                   ASKst:=TAskTextFont.create(prev,eld)
              end
        end
    else if token='MAX' then
       begin
            gettoken;
            if token='POINT' then
               begin
                   gettoken;
                   if token='STYLE' then
                     begin
                       gettoken;
                       ASKst:=TAsk.create(prev,eld,getmaxpointstyle);
                     end
                   else if token='DEVICE' then
                     begin
                       gettoken;
                       ASKst:=TAsk.create(prev,eld,getmaxpointdevice);
                     end
               end
            else if token='LINE' then
               begin
                   gettoken;
                   checktoken('STYLE',IDH_LINE);
                   ASKst:=TAsk.create(prev,eld,getmaxlinestyle);
               end
            else if token='COLOR' then
               begin
                   gettoken;
                   ASKst:=TAsk.create(prev,eld,getmaxcolor);
               end
            else if token='MULTIPOINT' then
               begin
                  gettoken;
                  CheckToken('DEVICE',IDH_LOCATE);
                  ASKst:=TAsk.create(prev,eld,getmaxMultipointdevice);
               end
            else if token='CHOICE' then
               begin
                  gettoken;
                  CheckToken('DEVICE',IDH_LOCATE);
                  ASKst:=TAsk.create(prev,eld,getmaxChoiceDevice);
               end
            else if token='VALUE' then
               begin
                  gettoken;
                  CheckToken('DEVICE',IDH_LOCATE);
                  ASKst:=TAsk.create(prev,eld,getmaxValueDevice);
               end
       end
    else if token='PIXEL' then
       begin
            gettoken;
            if token='SIZE' then
               begin
                   gettoken;
                   ASKst:=TAskPixelSize.create(prev,eld);
               end
            else if token='VALUE' then
               begin
                   gettoken;
                   ASKst:=TAskPixelValue.create(prev,eld);
               end
            else if token='ARRAY' then
               begin
                   gettoken;
                   ASKst:=TAskPixelArray.create(prev,eld);
               end;
       end
    else if token='DEVICE' then
       begin
            gettoken;
            if token='VIEWPORT' then
               begin
                   gettoken;
                   ASKst:=TAskDeviceViewport.create(prev,eld);
               end
            else if token='WINDOW' then
               begin
                   gettoken;
                   ASKst:=TAskDeviceWindow.create(prev,eld);
               end
            else if token='SIZE' then
               begin
                   gettoken;
                   ASKst:=TAskDeviceSize.create(prev,eld);
               end
       end
    else if token='CLIP' then
       begin
            gettoken;
            ASKst:=TAskClip.create(prev,eld);
       end
    else if (token='AXIS') then
        begin
           gettoken;
           if (token='COLOR')  then
                 begin
                     gettoken;
                     askst:=TAsk.create(prev,eld,getaxiscolor)
                 end
        end
    else if token='COLOR' then
       begin
            gettoken;
            if token='MIX' then
               begin
                   gettoken;
                   ASKst:=TAskColorMix.create(prev,eld);
               end
            else if token='MODE' then
               begin
                   gettoken;
                   ASKst:=TAskColorMode.create(prev,eld);
               end
       end
    else if token='PIXELS' then
       begin
            gettoken;
            ASKst:=TAskBitMapSize.create(prev,eld);
       end
    else if token='BITMAP' then
       begin
            gettoken;
            if token='SIZE' then
               begin
                   gettoken;
                   ASKst:=TAskBitMapSize.create(prev,eld);
               end
       end
    else if token='BEAM' then
       begin
            gettoken;
            if token='MODE' then
               begin
                   gettoken;
                   ASKst:=TAskBeamMode.create(prev,eld);
               end
       end
    else
       seterrIllegal(token,0);

    if token='STATUS' then
       begin
          gettoken;
          result.status:=nVariable;
          if result.status is TSubstance then
                 TSubstance(result.status).AddQueryInteger(nil); //Integer不適格

       end;
end;



{*************}
{PLOT or GRAPH}
{*************}



type
  TPlotItem=class
     exp1,exp2:TPrincipal;
     next:TPlotItem;
     PLOTstm:boolean;
    constructor create(plot:boolean; prev:TPlotItem);  //2011.3.5
    //procedure PutMark;
    //procedure PlotTo;
    //function eval(var x,y:double):boolean;
    destructor Destroy;override;
    function ItemCode:Ansistring;
   end;



constructor TPlotItem.create(plot:boolean; prev:TPlotItem);   //2011.3.5
begin
   inherited create;
   PLOTstm:=plot;
   exp1:=NExpression;
   if (programunit.Arithmetic<>PrecisionComplex)
      or (prev=nil) and (token=',')
      or (prev<>nil) and (prev.exp2<>nil) then
      begin
        check(',',IDH_GRAPHICS);
        exp2:=NExpression;
      end;
   if (token=';') and (nextTokenSpec<>tail) and (NextToken<>'ELSE') then
   begin
      gettoken;
      next:=TPlotItem.create(PLOTstm, self);
   end;
end;

destructor TPlotItem.Destroy;
begin
   next.free;
   exp2.free;
   exp1.free;
   inherited destroy;
end;



type
   TPlotPoints=class(TStatement)
       Items:TPlotItem;
       GRAPHst:Boolean;
          cont:Boolean;
     constructor create(prev,eld:TStatement; plot:boolean);
     constructor createnul(prev,eld:TStatement);  //PLOT LINES文で使う
     //procedure exec;override;
     destructor destroy;override;
     function Code:AnsiString;override;
   end;

   TPlotLines=class(TPlotPoints)
     constructor create(prev,eld:TStatement; plot:boolean);
     //procedure exec;override;
     function Code:AnsiString;override;
  end;

constructor TPlotPoints.create(prev,eld:TStatement; plot:boolean);
begin
   inherited create(prev,eld);
   Items:=TPlotItem.create(plot, nil);
end;

constructor TPlotLines.create(prev,eld:TStatement; plot:boolean);
begin
   inherited create(prev,eld,plot);
   if not plot then GRAPHst:=true;
   if plot and (token=';') then
      begin
        cont:=true;
        gettoken;
      end;
end;

constructor TPlotPoints.createnul(prev,eld:TStatement);
begin
    inherited Create(prev,eld);
    GRAPHst:=false;
    cont:=false;
end;


destructor TPlotPoints.destroy;
begin
  Items.free;
  inherited destroy
end;


type
   TPointArray=array[ 0..1023] of TPoint;
   PPointArray=^TPointArray;

type
   TCoordinate=Packed Record
               x,y:double;
           end;
   TCoordinateArray=Packed Array[0..1023] of TCoordinate;
   PCoordinateArray=^TCoordinateArray;

 {
 function NormalSegment(const x0,y0,x1,y1:double):boolean;
var
  a,b,s,t:double;
begin
  result:=true;
  if CurrentTransform=nil then exit;
  with CurrentTransform do
    begin
      a:=x1-x0;
      b:=y1-y0;
      s:=ox*a+oy*b;
      t:=-(ox*x0+oy*y0+oo);
      if s<>0 then
        begin
           t:=t/s;
           if (t>=0) and (t<=1) then
              result:=false;
        end
      else if t=0 then
        result:=false;
    end
end;
}
{
function TestNormalSegments(p:PCoordinateArray; count:integer):boolean;
var
   i:integer;
begin
   result:=true;
   for i:=0 to count-1 do
       result:=result and NormalSegment(p^[i].x, p^[i].y,
                           p^[(i+1)mod count].x, p^[(i+1)mod count].y);
end;
}
type
   TPlotOrg=class(TStatement)
       pointpairs:TObjectList;
       limit:TPrincipal;
       mat,mat2:TMatrix;
       GRAPHst :boolean;
     constructor create(prev,eld:TStatement; plot:boolean);
     constructor createmat(prev,eld:TStatement; plot:boolean);
     destructor destroy;override;
     //function evalLimit:integer;
     //function MakeList(p:PPointArray; lim:integer):integer; //結果は点の個数
     //procedure MakeCoordinateList(p:PCoordinateArray; lim:integer); //変換前の座標
     //function ReMakeList(p:PCoordinateArray; q:PPointArray; count:integer):integer; //結果は点の個数
     //procedure PlotProjectiveLine(lim:integer);
     {Code Gen}
     function PointCode:Ansistring;
   end;

   TMatPlotPoints=class(TPlotOrg)
     //procedure exec;override;
     function Code:Ansistring;override;
   end;

   TMatPlotLines=class(TPlotOrg)
        cont:boolean;
     constructor create(prev,eld:TStatement; plot:boolean);
     //constructor createnul(prev,eld:TStatement);
     //procedure exec;override;
     function Code:Ansistring;override;
   end;

   TPlotArea=class(TPlotOrg)
     constructor create(prev,eld:TStatement; plot:boolean);
     //procedure exec;override;
     //procedure ProjectivePolygon(lim:integer);
     function Code:Ansistring;override;
   end;

   TPlotBezier=class(TStatement)
       expx: array[0..3]of TPrincipal;
       expy: array[0..3]of TPrincipal;
       GRAPHst :boolean;
     constructor create(prev,eld:TStatement; plot:boolean);
     //procedure exec;override;
     destructor destroy;override;
   end;

    TPlotColorPoints=class(TplotPoints)
       color:Tprincipal;
       constructor create(prev,eld:TStatement; plot:boolean);
       function Code:Ansistring;override;
    end;



   function PLOTst(prev,eld:TStatement):TStatement;
   var
      plot:boolean;
   begin
      PLOTst:=nil;
      GraphMode:=true;
      plot:=(prevToken='PLOT');
      //ver. 8.1.3.3
      if token='POINTS' then
           begin
               gettoken;
               checktoken(':',IDH_GRAPHICS);
               PLOTst:=TPlotPoints.create(prev,eld,plot)
           end
      else if (token='LINES') then
         begin
          gettoken;
          if ( ((tokenspec=tail) or (token='ELSE'))
              or ((token=':') and (nexttoken='') ))
              and plot then
              PLOTst:=TPlotLines.createnul(prev,eld)
          else
             begin
              checktoken(':',IDH_LINE);
              PLOTst:=TPlotLines.create(prev,eld,plot)
             end
         end
      else if token='AREA' then
         begin
             gettoken;
             checktoken(':',IDH_AREA);
             PLOTst:=TPLotArea.create(prev,eld,plot)
         end
      else if (token='TEXT') or (token='LABEL') or plot and (token='LETTERS') then
         begin
             PLOTst:=PlotTextst(prev,eld)
         end
      else if token='BEZIER' then
         begin
             gettoken;
             checktoken(':',IDH_AREA);
             PLOTst:=TPLotBezier.create(prev,eld,plot)
         end
      else if plot and not DisableAbbreviatedPLOT
           and ((tokenspec=tail) or (token='ELSE'))  then
              PLOTst:=TPlotLines.createnul(prev,eld)
      else if plot and not DisableAbbreviatedPLOT
           and (nexttoken <>':') then
          begin
            StatusMes.add(token+s_CantBelongHere);
            PLOTst:=TPlotLines.create(prev,eld,plot)
          end
      else
         seterrIllegal(token,IDH_GRAPHICS);
   end;

constructor TPlotOrg.create(prev,eld:TStatement; plot:boolean);     //2011.3.5
var
   exp:TPrincipal;
   flag:boolean;
Label
   L1;
begin
    inherited create(prev,eld);
    flag:=false;
    GRAPHst:=not plot;
    pointpairs:=TObjectList.create(4);
    repeat
        exp:=nexpression;
        pointpairs.add(exp);
        if ((programunit.Arithmetic<>PrecisionComplex) or (token=',')) and not flag then
           begin
              check(',',IDH_GRAPHICS);
              exp:=nexpression;
           end
        else
           begin
              exp:=nil;
              flag:=true;
           end;
        pointpairs.add(exp);
        if (token=';') and (nexttokenspec<>tail) and (nexttoken<>'ELSE') then
            gettoken
        else
            goto L1;
   until false;
 L1:
end;



constructor TPlotOrg.createmat(prev,eld:TStatement; plot:boolean); //2011.3.5
begin
    graphmode:=true;
    inherited create(prev,eld);
    GRAPHst:=not plot;
    gettoken; {POINTS, etc.}
    if test(',') and (token='LIMIT') then
       begin
          gettoken;
          limit:=NExpression;
          {if limit=nil then fail}
       end;
    checktoken(':',IDH_MAT_PLOT);
    try
       mat:=Nmatrix;      {nilでも可}
       if (mat<>nil) and (mat.idr.dim=1)
          and ((programunit.Arithmetic<>precisionComplex) or (token=',')) then
           begin
             check(',',IDH_MAT_PLOT);
             mat2:=Nmatrix;
           end;
    except
       on ERecompile do raise;
       else;
    end;
    if (mat<>nil) and (mat.idr.dim=1) and (mat2<>nil) and (mat2.idr.dim=1)
      or (mat<>nil) and (mat.idr.dim=1) and (programunit.Arithmetic=precisionComplex)
      or (mat<>nil) and (mat.idr.dim=2)then
    else
         begin seterrdimension(IDH_MAT);{done;fail} end;
end;

constructor TPlotColorPoints.create(prev,eld:TStatement; plot:boolean);
begin
  gettoken;//','
  gettoken;//'COLOR'
  color:=NExpression;
  checktoken(':',IDH_GRAPHICS);
  inherited create(prev,eld,plot);
end;

constructor TMatPlotLines.create(prev,eld:TStatement; plot:boolean);
begin
  inherited create(prev,eld,plot);
  if (token=';') and plot then
      begin
         gettoken;
         cont:=true;
      end
  else
      cont:=false;
end;

constructor TPlotArea.create(prev,eld:TStatement; plot:boolean);
begin
   inherited create(prev,eld,plot);
   if not (pointpairs.count>=2*3) then
        seterr('',IDH_AREA);
end;


destructor TPlotOrg.destroy;
begin
    pointpairs.free;
    limit.free;
    mat.free;
    inherited destroy
end;


constructor TPlotBezier.create(prev,eld:TStatement; plot:boolean);
var
   i:integer;
begin
    inherited create(prev,eld);
    GRAPHst:=not plot;
    for i:=0 to 3 do
    begin
       expx[i]:=NExpression;
       check(',',0);
       expy[i]:=NExpression;
       if i<3 then check(';',0);
    end;
end;

destructor TPlotBezier.destroy;
var
  i:integer;
begin
  for i:=3 downto 0 do
    begin
      expy[i].Free;
      expx[i].Free;
    end;
  inherited destroy;
end;



{*********}
{MAT CELLS}
{*********}
type
   TMatCells=class(TStatement)
       exp1,exp2,exp3,exp4:tPrincipal;
       mat1:TMatrix;
       GRAPHst:boolean;
     constructor create(prev,eld:TStatement);
     //procedure exec;override;
     destructor destroy;override;
     function Code:AnsiString;override;
   end;

constructor TMatCells.create(prev,eld:TStatement);
begin
  graphmode:=true;
  inherited create(prev,eld);
  GRAPHst:=not (PrevToken='PLOT');
  gettoken;  // CELLS
  CheckToken(',',IDH_MAT_CELLS);
  CheckToken('IN',IDH_MAT_CELLS);
  exp1:=Nexpression;
  CheckToken(',',IDH_MAT_CELLS);
  exp2:=Nexpression;
  CheckToken(';',IDH_MAT_CELLS);
  exp3:=Nexpression;
  CheckToken(',',IDH_MAT_CELLS);
  exp4:=Nexpression;
  CheckToken(':',IDH_MAT_CELLS);
  mat1:=NMatrix;
  if mat1.idr.dim<>2 then seterrDimension(IDH_MAT_CELLS);
end;

destructor TMatCells.destroy;
begin
   exp1.free;
   exp2.free;
   exp3.free;
   exp4.free;
   mat1.free;
   inherited destroy;
end;



function MATPLOTst(prev,eld:TStatement):TStatement;
var
   plot:boolean;
begin
   plot:=(PrevToken='PLOT');
   MATPLOTst:=nil;
   if token='POINTS' then
      MATPLOTst:=TMatPlotPoints.createmat(prev,eld,plot)
   else if token='LINES' then
      MATPLOTst:=TMatPlotLines.createmat(prev,eld,plot)
   else if token='AREA' then
      MATPLOTst:=TPLOTAREA.createmat(prev,eld,plot)
   else if token='CELLS' then
      MATPLOTst:=TMatCells.create(prev,eld)
   else
      seterr('',IDH_MAT_PLOT);
end;




{*****}
{mouse}
{*****}


type
  TGetPoint=class(TStatement)
    exp1,exp2:TVariable;
    LocateSt:boolean;
    NoBeamOff:boolean;
    dev1,exp3,exp4:TPrincipal;
    constructor create(prev,eld:TStatement; get:boolean);
    //procedure exec;override;
    destructor destroy;override;
    function Code:ansistring;override;
   end;


function  GETst(prev,eld:TStatement):TStatement;
begin
  if token='FROM' then
     Getst:=statemen.Getst(prev,eld)
  else
   begin
    graphmode:=true;
    GETst:=TGETPOINT.create(prev,eld,PrevToken='GET');
   end;
end;


constructor TGetPoint.create(prev,eld:TStatement; get:boolean);
begin
   inherited create(prev,eld);
   LocateSt:=not get;
   checktoken('POINT',IDH_GET);
  if test('(') then
     begin
       dev1:=NExpression;
       check(')',IDH_LOCATE)
     end;
  if (token=',') and (nexttoken='AT') then
     begin
       gettoken;
       gettoken;
       exp3:=NExpression;
       check(',',IDH_GET);
       exp4:=NExpression;
     end;
   if (token=',') and (nexttoken='NOBEAMOFF') then
       begin
          Gettoken;
          Gettoken;
          NoBeamOff:=true;
       end;
   checktoken(':',IDH_GET);
   exp1:=nvariable;
   check(',',IDH_GET);
   exp2:=nvariable;

   if exp1 is TSubstance then
        TSubstance(exp1).AddQueryInteger(nil); //Integer不適格
   if exp2 is TSubstance then
        TSubstance(exp2).AddQueryInteger(nil); //Integer不適格

end;


destructor TGetPoint.destroy;
begin
    exp1.free;
    exp2.free;
    dev1.free;
    exp3.free;
    exp4.Free;
    inherited destroy;
end;
{
procedure PointAt(exp3,exp4:TPrincipal);
var
  x,y:double;
  vx,vy:integer;
begin
   x:=exp3.evalX;
   y:=exp4.evalX;
   if CurrentTransform.transform(x,y) then
     begin
      vx:=MyGraphSys.deviceX(x);
      vy:=MyGraphSys.deviceY(y);
      MyGraphSys.MoveMouse(vx,vy);
     end;
end;
}


function TGetPoint.Code:ansistring;
begin
   result:='';
   if exp3<>nil then
      result:='PointAt('+exp3.code+','+exp4.code+','+TruthLiteral(Locatest)+');';
   result:=result+'GetPoint('+exp1.code+','+exp2.code+','
                 +truthLiteral(NoBeamOff)+','+TruthLiteral(Locatest)+');'
end;





{**********}
{MOUSE POLL}
{**********}

type
   TMousePoll=class(TStatement)
        exp1,exp2,exp3,exp4:TVariable;
     constructor create(prev,eld:TStatement);
     //procedure exec;override;
     destructor destroy;override;
     function Code:ansistring;override;
    end;


function MOUSEst(prev,eld:TStatement):Tstatement;
begin
    MOUSEst:=nil;
    checktoken('POLL',IDH_EXTENSION);
    MOUSEst:=TmousePoll.create(prev,eld);
    graphmode:=true;
end;

constructor TMOusePoll.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1:=nvariable;
   check(',',IDH_EXTENSION);
   exp2:=nvariable;
   check(',',IDH_EXTENSION);
   exp3:=nvariable;
   check(',',IDH_EXTENSION);
   exp4:=nvariable;

   if exp1 is TSubstance then
        TSubstance(exp1).AddQueryInteger(nil); //Integer不適格
   if exp2 is TSubstance then
        TSubstance(exp2).AddQueryInteger(nil); //Integer不適格
   if exp3 is TSubstance then
        TSubstance(exp3).AddQueryInteger(nil); //Integer不適格
   if exp4 is TSubstance then
        TSubstance(exp4).AddQueryInteger(nil); //Integer不適格

end;

destructor TMousePoll.destroy;
begin
   exp1.free;
   exp2.free;
   exp3.free;
   exp4.free;
   inherited destroy
end;



function TMousePoll.Code:ansistring;
begin
   result:='MousePoll('+exp1.Code+','+exp2.Code+','+exp3.code+','+exp4.Code+');'
end;


{***************}
{CLEAR statement}
{***************}

type
   TCLEAR=class(TSTATEMENT)
     //procedure exec;override;
     function Code:ansistring;override;
   end;

function CLEARst(prev,eld:TStatement):TStatement;
begin
    CLEARst:=TCLEAR.create(prev,eld);
end;

{********}
{GLOAD st}
{********}

type
     TGLoad=class(TStatement)
          exp1:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
        function Code:AnsiString;override;
      end;

constructor TGLoad.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1 :=SExpression;
end;

destructor TGLoad.destroy;
begin
   exp1.free;
   inherited destroy
end;


function TGLoad.Code:AnsiString;
begin
   Result:='GLOAD('+exp1.Code+');'
end;


function GLOADst(prev,eld:TStatement):TStatement;
begin
    graphMode:=true;
    GLOADst:=TGLoad.create(prev,eld);
end;

type
     TGSave=class(TStatement)
          exp1,exp2:TPrincipal;
        constructor create(prev,eld:TStatement);
        //procedure exec;override;
        destructor destroy;override;
        function Code:AnsiString;override;
      end;

constructor TGSave.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   exp1 :=SExpression;
   if token=',' then
   begin
     gettoken;
     exp2:=SExpression;
   end;
end;

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



function TGSave.Code:ansistring;
begin
   if exp2=nil then
      result:='GSAVE('+exp1.Code+','''');'
   else
      result:='GSAVE('+exp1.Code+','+exp2.code+');'
end;



function GSAVEst(prev,eld:TStatement):TStatement;
begin
    GSAVEst:=TGSave.create(prev,eld);
end;




{*******}
{GDEVICE}
{*******}

function  GRAPHICSst(prev,eld:TStatement):TStatement;
begin
   if token='DEVICE' then
     begin
       gettoken ;
       {
       if token='PRINTER' then
       begin
         gettoken;
         result:=TStatement.create(prev,eld);
         //NextGraphMode:=PRTDirectMode;
       end
       }
       {
       else if token='METAFILE' then
       begin
         gettoken;
         result:=TStatement.create(prev,eld);
         //NextGraphMode:=PRTMetaFileMode;
       end;
       }
     end;

end;

{******}
{LOCATE}
{******}
type
  TLocate=class(TStatement)
      dev1, exp1, exp2, exp3:TPrincipal;
      nvar1:tVariable;
      sary1:TMatrix;
      NoWait:boolean;
     constructor create(prev,eld:TStatement);
     destructor destroy;override;
  end;

  TLocateChoice=class(TLocate)
     //procedure exec;override;
     function Code:AnsiString;override;
  end;

  TLocateValue=class(TLocate)
     //procedure exec;override;
     function Code:AnsiString;override;
  end;

constructor TLocate.create(prev,eld:TStatement);
var
  Valuest:boolean;
begin
  inherited create(prev,eld);
  Valuest:=false;
  if token='VALUE' then
    begin
     valuest:=true;
     if Nexttoken='NOWAIT' then
        begin
           NoWait:=true;
           gettoken;
        end;
    end;
  gettoken;
  if test('(') then
     begin

       if tokenspec=sidf then
          sary1:=SMatrixDim(1)
       else
          dev1:=NExpression;
       check(')',IDH_LOCATE)
     end;
  if Valuest and (token=',') and (nextToken='RANGE') then
    begin
      gettoken;
      gettoken;
      exp1:=NExpression;
      check('TO',IDH_LOCATE);
      exp2:=NExpression;
    end;
  if test(',') then
     begin
       check('AT',IDH_LOCATE);
       exp3:=NExpression;
     end;
  check(':',idh_locate);
  nvar1:=NVariable;
  if nvar1 is TSubstance then
       TSubstance(nvar1).AddQueryInteger(nil); //Integer不適格

end;

destructor TLocate.destroy;
begin
  dev1.Free;
  sary1.Free;
  exp1.Free;
  exp2.Free;
  exp3.Free;
  nvar1.Free;
  inherited destroy;
end;

function TLocateChoice.Code:ansistring;
begin
  result:='LocateChoice(';
  if dev1<>nil then
     begin
       result:=result+Dev1.Code+',';
       if exp3<>nil then
          result:=result+exp3.code+','
     end
  else if sary1<>nil then
     result:=result+sary1.code+',';
  result:=result+nvar1.Code+');'
end;

function TlocateValue.Code:AnsiString;
var
  name0:ansistring;
begin
  if nvar1 is TSubstance then
      Name0:=TSubstance(nvar1).idr.name
  else
      Name0:='';
  if nowait then
    result:='LocateValueNowait('
  else
    result:='LocateValue(';
  if dev1<>nil then
       result:=result+Dev1.Code+','
  else
       result:=result+'1,' ;
  if exp1<>nil then
       result:=result+exp1.code+','+exp2.code+',';
  if exp3<>nil then
          result:=result+exp3.code+',';
  result:=nvar1.Code+':='+result+''''+Name0+''');'
end;


function  LOCATEst(prev,eld:TStatement):TStatement;
begin
 if token='POINT' then
   LOCATEst:=GETst(prev,eld)
 else if token='CHOICE' then
   LOCATEst:=TLocateChoice.create(prev,eld)
 else if token='VALUE' then
   LOCATEst:=TLocateValue.create(prev,eld)
end;


{**********}
{MAT LOCATE}
{**********}

type
   TMatLocate=class(TStatement)
      mat1,mat2:TMatrix;
      redim1,redim2:TMatRedim;
      dev1,exp3,exp4:TPrincipal;
      dim:byte;
      varilen:boolean;
      locatest:boolean;
     constructor create(prev,eld:TStatement);
     destructor destroy;override;
     //procedure exec;override;
     function Code:Ansistring;override;
  end;

destructor TmatLocate.destroy;
begin
  mat1.Free;
  mat2.Free;
  redim1.free;
  redim2.Free;
  exp3.Free;
  exp4.Free;
  dev1.free;
  inherited destroy
end;

constructor TmatLocate.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   graphmode:=true;
   locatest:=(PrevToken='LOCATE');
   CheckToken('POINT',IDH_GET);
   if test('(') then    //選択機構
   begin
      dev1:=NExpression;
      check(')',IDH_LOCATE)
   end;
   if test(',') then    //開始点
     begin
       check('AT',IDH_LOCATE);
       exp3:=NExpression;
       check(',',IDH_GET);
       exp4:=NExpression;
     end;

   check(':',IDH_GET);

   mat1:=NMatrix;
   //if mat1=nil then raise ESyntaxError.create('');
   dim:=Mat1.idr.dim;
   if dim>=3 then seterrdimension(Idh_GET);
   if token='(' then
      if nexttoken='?' then
         begin
           gettoken;
           gettoken;
           varilen:=true;
           if dim=2 then
                    check(',',IDH_GET);
           check(')',IDH_GET);
         end
      else
         redim1:=TMatRedim.create(mat1,false);

   if dim=1 then
     begin
        check(',',IDH_GET);
        mat2:=NMatrixDim(1);
        if varilen then
           begin
              check('(',IDH_GET);
              check('?',IDH_GET);
              check(')',IDH_GET);
           end
        else if token='(' then
           redim2:=TMatredim.create(mat2,false);
     end;

end;

function TmatLocate.Code:ansistring;
begin
   if exp3<>nil then
      result:='PointAt('+exp3.code+','+exp4.code+','+truthLiteral(LocateSt)+');'
   else
      result:='';
   if redim1<>nil then result:=result+redim1.code;
   if redim2<>nil then result:=result+redim2.code;

   if varilen then
      result:=result+'MatGetPointVarilen('
   else
      result:=result+'MatGetPoint(';

   result:=result+mat1.code;
   if dim=1 then result:=result+',' + mat2.code;

   result:=result+','+TruthLiteral(LocateSt)+');'
end;


function MATLOCATEst(prev,eld:TStatement):TStatement;
begin
   MATLOCATEst:=TMatLocate.create(prev,eld);
end;

function PixelX(x:double):double;
begin
  //with MyGraphSys do
  //  result:=DeviceX(x) - DeviceX(left);
end;

function PixelY(x:double):double;
begin
  //with MyGraphSys do
  //  result:=DeviceY(bottom) - DeviceY(x)
end;

function WindowX(x:double):double;
begin
 // with MyGraphSys do
 //   result:=VirtualX( DeviceX(left) +
 //           LongIntRound(x) )
end;

function WindowY(x:double):double;
begin
  //with MyGraphSys do
  //  result:=VirtualY( DeviceY(bottom) -
  //    LongIntRound(x))
end;

{*********}
{Microsoft}
{*********}

function  OnlyMSst(prev,eld:TStatement):TStatement;
begin
   Seterr(PrevToken + s_MSmodeOnly, IDH_SYNTAX_MICROSOFT)  ;
end;


function  MSLINEst(prev,eld:TStatement):TStatement;
begin
   result:=OnLyMSst(prev,eld);
end;






type
   TFLOOD=class(TStatement)
       exp1,exp2:TPrincipal;
       constructor create(prev,eld:TStatement);
       destructor destroy;override;
       //procedure exec;override;
       function Code:ansistring;override;
      end;


constructor TFLOOD.create(prev,eld:TStatement);
begin
    graphmode:=true;
    inherited create(prev,eld);
    exp1:=nexpression;
    check(',',IDH_FLOOD);
    exp2:=nexpression;
end;

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


function  FLOODst(prev,eld:TStatement):TStatement;
begin
   result:=TFLOOD.create(prev,eld);
end;

type
   TFLOODFILL=class(TFlood)
       //procedure exec;override;
       function Code:ansistring;override;
   end;


function  FLOODFILLst(prev,eld:TStatement):TStatement;
begin
   result:=TFLOODFILL.create(prev,eld);
end;


{*************}
{Code Generate}
{*************}
function TCustomSetWindow.codesub:ansistring;
begin
  result:='('+x1.code+','+x2.code+','+y1.code+','+y2.code+','+TruthLiteral(insideofWhen)+');'
end;


function TSetWindow.Code:AnsiString;
begin
  result:='SetWindow'+codesub
end;

function TSetDeviceViewPort.Code:AnsiString;
begin
  result:='SetDeviceViewport'+codesub
end;

function TSetDeviceWindow.Code:AnsiString;
begin
  result:='SetDeviceWindow'+codesub
end;

function TSetViewPort.Code:AnsiString;
begin
  result:='SetViewport'+codesub
end;

function TSetColorMix.code:Ansistring;
begin
  result:='SetColorMix('+ColorIndex.Code+','+Red.Code+','+Green.Code+','+Blue.Code
                        +','+TruthLiteral(insideofWhen)+');';
end;


function TSet.code:ansistring;
begin
  result:=SetPrc+'('+exp.code+','+truthLiteral(insideofwhen)+');';
end;


function TSetDrawMode.Code:ansistring;
begin
  result:='SetDrawMode('''+mode+''');';
end;

function TSetTextHeight.code:ansistring;
begin
   result:='SetTextHeight(' + exp.code + ',' + truthLiteral(insideofwhen)+');';
end;

function TSetTextAngle.code:ansistring;
begin
   result:='SetTextAngle(' + exp.code + ',' + truthLiteral(PUnit.Angledegrees)+');';
end;

function TSetClip.code:ansistring;
begin
   result:='GraphLib.SetClip(' + exp.code + ',' + truthLiteral(insideofwhen)+');';
end;

function TSetTextFont.Code:ansistring;
begin
  if exp2<>nil then                                      //2013.12.21
     result:='SetTextFont('+exp1.code+','+exp2.code+');'
  else
     result:='SetTextFont('+exp1.code+',0);';
end;


function TSetTextBk.code:ansistring;
begin
   result:='GraphLib.SetTextBackGround(' + exp.code + ');';
end;

function TSetAreaStyle.code:ansistring;
begin
   result:='GraphLib.SetAreaStyle(' + exp.code + ');';
end;

function TSetBitmapSize.code:ansistring;
begin
   result:='SetBitMapSize('+exp1.code+','+exp2.code+');'
end;

function TSetColorMode.code:ansistring;
begin
  result:='MyGraphSys.setcolormode('+exp1.code+');'
end;

function TSetBeamMode.Code:AnsiString;
begin
  result:='MyGraphSys.setBeamMode('+ exp1.Code + ');'
end;

{*************}

function TClear.Code:ansistring;
begin
   result:='Clear;';
end;



{*************}
{PLOT or GRAPH}
{*************}

function TPlotItem.ItemCode:ansistring;
begin
  result:= exp1.code;
  if exp2<>nil then
     result:=result+',' + exp2.code;
  if next <>nil then
     result:=result+','+next.ItemCode
end;

function TPlotPoints.code:ansistring;
var
   OpName:ansistring;
begin
   if GRAPHst then
         OpName:='GraphPoints'
   else
         OpName:='PlotPoints';
   if Items.exp2=nil then
         OpName:=OpName+'Complex';
   result:= OpName + '([' +Items.ItemCode + ']);';
end;

function TPlotColorPoints.code:ansistring;
var
   OpName:ansistring;
begin
   if GRAPHst then
         OpName:='GraphColorPoints'
   else
         OpName:='PlotColorPoints';
   if Items.exp2=nil then
         OpName:=OpName+'Complex';
   result:= OpName + '([' +Items.ItemCode + '],'+color.code+');';
end;
function TPlotLines.code:ansistring;
var
   OpName:ansistring;
begin
   result:='';
   if items<>nil then
      begin
        if GRAPHst then
           OpName:='GraphLines'
        else
           if cont then
              OpName:='PlotLines'
           else
              opName:='PlotLinesBeamOff';
        if Items.exp2=nil then
              OpName:=OpName+'Complex';
        result:= OpName + '([' +Items.ItemCode + ']);';
      end
   else if not cont then
     result:= 'BeamOff;'        ;
end;

function TPlotorg.PointCode:ansistring;
var
   i:integer;
begin
  result:='[';
  with pointpairs do
   if (count>0) and (items[1]<>nil) then
     for i:=0 to count -1 do
       begin
         if i>0 then result:=result+',';
         result:=result+TPrincipal(items[i]).Code
       end
   else                                     // complex
     for i:=0 to count div 2 -1 do
       begin
         if i>0 then result:=result+',';
         result:=result+TPrincipal(items[i*2]).Code
       end
     ;
  result:=result+']'
end;


function TPlotArea.Code:ansistring;
begin
  if mat=nil then
     if pointpairs.items[1]<>nil then
          result:='PLOTAREA('+PointCode+');'
     else
          result:='PLOTAREAComplex('+PointCode+');'
  else if limit=nil then
      if mat2=nil then
        result:='MatPlotArea('+mat.code+');'
      else
        result:='MatPlotArea('+mat.code+','+mat2.Code+');'
  else
      if mat2=nil then
        result:='MatPlotAreaLimit('+limit.Code+','+mat.code+');'
      else
        result:='MatPlotAreaLimit('+limit.Code+','+mat.code+','+mat2.Code+');'
end;

function TMatPlotPoints.Code:Ansistring;
begin
  if limit=nil then
      if mat2=nil then
        result:='MatPlotPoints('+mat.code+');'
      else
        result:='MatPlotPoints('+mat.code+','+mat2.Code+');'
  else
      if mat2=nil then
        result:='MatPlotPointsLimit('+limit.Code+','+mat.code+');'
      else
        result:='MatPlotPointsLimit('+limit.Code+','+mat.code+','+mat2.Code+');'

end;

function TMatPlotLines.Code:Ansistring;
begin
   if limit=nil then
      if mat2=nil then
        result:='MatPlotLines('+mat.code+');'
      else
        result:='MatPlotLines('+mat.code+','+mat2.Code+');'
   else
      if mat2=nil then
        result:='MatPlotLinesLimit('+limit.Code+','+mat.code+');'
      else
        result:='MatPlotLinesLimit('+limit.Code+','+mat.code+','+mat2.Code+');'

end;

function TMatCells.Code:ansistring;
begin
  if GRAPHst then
     result:='MatGraphCells('
  else
     result:='MatPlotCells(';
  result:=result+mat1.code+','+exp1.code+','+exp2.code+','+exp3.code+','+exp4.code
           +','+TruthLiteral(insideofWhen)+');'
end;


{*************}
{ASK statemnts}
{*************}
function TAskStatus.Code:ansistring;
begin
  if status<>nil then
    result:=Status.code +':=' + AskCode
  else
    result:=AskCode;
end;

function TAskWindow.askCode:ansistring;
begin
   result:=AskFuncName+'('+exp1.code+','+exp2.code+','+exp3.code+','+exp4.code+');'
end;

function TAskWindow.AskFuncName:ansistring;
begin
  result:='AskWindow'
end;

function TAskViewport.AskFuncName:ansistring;
begin
  result:='AskViewport'
end;

function TAskDeviceWindow.AskFuncName:ansistring;
begin
   result:='AskDeviceWindow'
end;

function TAskDeviceViewport.AskFuncName:ansistring;
begin
  result:='AskDeviceViewport'
end;


function TAskPixelSize.ASkCode:ansistring;
begin
  result:='AskPixelsize(';
  if exp1<>nil then
     result:=result+exp1.code+','+exp2.code+','+exp3.code+','+exp4.code+',';
  result:=result+var1.code+','+var2.code+');'
end;

function TAskPixelValue.ASkCode:ansistring;
begin
  result:='AskPixelValue('+exp1.code+','+exp2.code+','+var1.code+');'
end;

function TAskPixelArray.AskCode:ansistring;
begin
   result:='AskPixelArray('+exp1.code+','+exp2.code+','+mat1.code;
   if exp3<>nil then
     result:=result+','+exp3.code;
   result:=result+');'
end;

function TAsk.AskFuncName:ansistring;
begin
  if @get=@getlinecolor then
     result:='getlinecolor'
 else if @get=@getlinestyle then
     result:='getlinestyle'
 else if @get=@getlinewidth then
     result:='getlinewidth'
 else if @get=@getpointcolor then
     result:='getpointcolor'
 else if @get=@getpointstyle then
     result:= 'getpointstyle'
 else if @get=@getareacolor then
     result:= 'getareacolor'
 else if @get=@gettextcolor then
     result:= 'gettextcolor'
 else if @get=@getmaxcolor then
     result:= 'getmaxcolor'
 else if @get=@getaxiscolor then
     result:= 'getaxiscolor'
 else if @get=@getMaxPointDevice then
     result:= 'getMaxPointDevice'
 else if @get=@getMaxMultiPointDevice then
     result:= 'getMaxMultiPointDevice'
 else if @get=@getMaxChoiceDevice then
     result:= 'getMaxChoiceDevice'
 else if @get=@getMaxValueDevice then
     result:= 'getMaxValueDevice'
 else if @get=@getAreaStyleIndex then
     result:= 'getAreaStyleIndex'
 else if @get=@getmaxlinestyle then
     result:= 'getmaxlinestyle'
 else if @get=@getmaxpointstyle then
     result:= 'getmaxpointstyle' ;
end;

function Task.AskCode:Ansistring;
begin
  result:=AskFuncName+'('+exp.code+');'
end;

function TAskTextHeight.AskFuncName:ansistring;
begin
  result:='ASkTextHeight'
end;

function TAskTextAngle.AskFuncName:ansistring;
begin
  if Punit.AngleDegrees then
    result:='ASkTextAngle'
  else
    result:='AskTextAngleRad'
end;

function TAskDeviceSize.AskCode:ansistring;
begin
  result:='AskDeviceSize('+exp1.code+','+exp2.code+','+exp3.code+');'
end;

function TAskBitmapSize.AskCode:AnsiString;
begin
  result:='AskBitmapSize('+exp1.code+','+exp2.code+');'
end;

function TAskTextJustify.AskCode:Ansistring;
begin
  result:='AskTextJustify('+exp1.code+','+exp2.code+');'
end;


function TAskTextWidth.AskCode:AnsiString;
begin
   result:='AskTextWidth('+text.code+','+width.code+');'
end;


function TAskColorMix.AskCode:ansistring;
begin
   result:='AskColorMix('+ColorIndex.Code+','+Red.Code+','+Green.Code+','+Blue.Code+');'
end;

function TAskTextFont.AskCode:ansistring;
begin
  result:='AskTextFont('+exp1.code+','+exp2.code+');'
end;



function TAskClip.AskCode:ansistring;
begin
   result:=AskFuncName+'('+exp.code+');'
end;

function TAskClip.AskFuncName:ansistring;
begin
  result:='AskClip'
end;

function TAskAreaStyle.AskFuncName:ansistring;
begin
  result:='ASkAreaStyle'
end;

function TAskColorMode.AskFuncName:ansistring;
begin
  result:='ASkColorMode'
end;


function TAskBeamMode.AskFuncName:ansistring;
begin
   result:='AskBeamMode'
end;

function TAskTextBack.AskFuncName:ansistring;
begin
   result:='AskTextBack'
end;




function TFlood.code:ansistring;
begin
  result:='Flood('+exp1.code+','+exp2.code+');'
end;

function TFloodFill.code:ansistring;
begin
  result:='FloodFill('+exp1.code+','+exp2.code+');'
end;
{**********}
{initialize}
{**********}

procedure statementTableinit;
begin
    StatementTableInitImperative('SET',SETst);
    StatementTableInitImperative('GET',GETst);
    StatementTableInitImperative('LOCATE',LOCATEst);
    StatementTableInitImperative('PLOT',PLOTst);
    StatementTableInitImperative('GRAPH',PLOTst);
    StatementTableInitImperative('CLEAR',CLEARst);
    StatementTableInitImperative('MOUSE',MOUSEst);
    StatementTableInitImperative('GLOAD',GLOADst);
    StatementTableInitImperative('GSAVE',GSAVEst);
   {$IFDEF Windows}
    StatementTableInitImperative('FLOOD',FLOODst);
    StatementTableInitImperative('PAINT',FLOODFILLst);
   {$ENDIF}
end;



begin

    tableInitProcs.accept(statementTableinit) ;
end.
