unit graphlib;
{$IFDEF FPC}
  {$MODE Delphi}{$H+}
{$ENDIF}

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

{********}
interface
{********}
uses Graphics,
     arrays,baslib;

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

procedure SetColorMix(cc:double; er,eg,eb:double; InsideofWhen:boolean); overload;
procedure SetWindow(l,r,b,t:double; insideofWhen:boolean);          overload;
procedure SetViewPort(l,r,b,t:double; insideofWhen:boolean);        overload;
procedure SetDeviceWindow(l,r,b,t:double; insideofWhen:boolean);    overload;
procedure SetDeviceViewport(l,r,b,t:double; insideofWhen:boolean);  overload;

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

procedure SetPointColor(x:double; InsideOfWhen:boolean); overload;
procedure setLineColor(x:double; InsideOfWhen:boolean);  overload;
procedure setAreaColor(x:double; InsideOfWhen:boolean);  overload;
procedure setTextColor(x:double; InsideOfWhen:boolean);  overload;
procedure setAllColor(x:double; InsideOfWhen:boolean);   overload;
procedure SetPointColor(const s:string; InsideOfWhen:boolean);overload;
procedure setLineColor(const s:string; InsideOfWhen:boolean);overload;
procedure setAreaColor(const s:string; InsideOfWhen:boolean);overload;
procedure setTextColor(const s:string; InsideOfWhen:boolean);overload;
procedure setAllColor(const s:string; InsideOfWhen:boolean); overload;
procedure SetAxisColor(x:double; InsideOfWhen:boolean);      overload;
procedure SetAxisColor(const s:string; InsideOfWhen:boolean);overload;


procedure setPointStyle(x:double; InsideOfWhen:boolean); overload;
procedure setLineStyle(x:double; InsideOfWhen:boolean);  overload;
procedure setLineWidth(x:double; InsideOfWhen:boolean);  overload;
procedure setAreaStyle(const s:string);
procedure setAreaStyleIndex(x:double; InsideOfWhen:boolean); overload;
procedure setTextHeight(x:double; InsideOfWhen:boolean);     overload;
procedure setTextAngle(x:double; AngleDegrees:boolean);      overload;
procedure setTextJustify( s1,s2:string; InsideOfWhen:boolean);

procedure SetDrawMode(mode:char);

function ColorOfName(s:string; insideofWhen:boolean):TColor;
function ColorIndex(r,g,b:double):TColor;                    overload;

procedure Clear;
procedure SetClip(const s:string; insideofwhen:boolean);
procedure SetTextFont(const s:string; x:double);              overload;
procedure SetTextBackGround(const s:string);
procedure SetBitmapSize(x,y:double);                          overload;

procedure GraphPoints(const a:array of double);
procedure GraphLines(const a:array of Double);
procedure BeamOff;
procedure PlotPoints(const a:array of double);
procedure PlotLines(const a:array of Double);
procedure PlotLinesBeamOff(const a: array of double);
procedure GraphArea(const a: array of double);
procedure PlotArea(const a:array of double);

procedure GraphColorPoints(const a:array of double; c:double);
procedure PlotColorPoints(const a:array of double; c:double);


procedure PlotText(x,y:double; const s:string);                            overload;
procedure PlotTextUsing(x,y:double; const form:string; a:array of const);  overload;
procedure GraphText(x,y:double; const s:string);                           overload;
procedure GraphTextUsing(x,y:double; const form:string; a:array of const); overload;
procedure PlotLabel(x,y:double; const s:string);                           overload;
procedure PlotLabelUsing(x,y:double; const form:string; a:array of const); overload;
procedure GraphLabel(x,y:double; const s:string);                          overload;
procedure GraphLabelUsing(x,y:double; const form:string; a:array of const); overload;
procedure PlotLetters(x,y:double; const s:string);                          overload;
procedure PlotLettersUsing(x,y:double; const form:string; a:array of const); overload;

procedure MatPlotPoints(const x,y:TArray1N);overload;
procedure MatPlotPoints(const m:TArray2N);overload;
procedure MatPlotLines(const x,y:TArray1N);overload;
procedure MatPlotLines(const m:TArray2N);overload;
procedure MatPlotArea(const x,y:TArray1N);overload;
procedure MatPlotArea(const m:TArray2N);overload;

procedure MatPlotPointsLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotPointsLimit(n:double; const m:TArray2N);overload;
procedure MatPlotLinesLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotLinesLimit(n:double; const m:TArray2N);overload;
procedure MatPlotAreaLimit(n:double; const x,y:TArray1N);overload;
procedure MatPlotAreaLimit(n:double; const m:TArray2N);overload;

procedure MatPlotCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);  overload;
procedure MatGraphCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean); overload;

{GET & LOCATE}
procedure PointAt(x0,y0:Double; LocateSt:boolean);                        overload;
procedure GetPoint(var x,y:Double; NoBeamOff:boolean; Locatest:boolean);  overload;
procedure MousePoll(var x,y,l,r:Double);                                  overload;
procedure MatGetPointVarilen(m:TArray2N; Locatest:boolean); overload;     overload;
procedure MatGetPointVarilen(m1,m2:TArray1N; Locatest:boolean); overload; overload;
procedure MatGetPoint(m1,m2:TArray1N; Locatest:boolean); overload;        overload;
procedure MatGetPoint(m:TArray2N; Locatest:boolean);overload;             overload;


Procedure LocateChoice( var x:Double);overload;
Procedure LocateChoice(n:Double; var x:Double);overload;
Procedure LocateChoice(n,i0:Double; var x:Double);overload;
Procedure LocateChoice(const a:TArray1S; var x:Double);overload;

function LocateValue(n:Double;  name0:ansistring):double;overload;
function LocateValue(n:Double; left0,right0:double; name0:ansistring):double;overload;
function LocateValue(n:Double; left0,right0,ini0:double; name0:ansistring):double;overload;
function LocateValueNowait(n:Double;  name0:ansistring):double;overload;
function LocateValueNowait(n:Double; left0,right0:double;  name0:ansistring):double;overload;
function LocateValueNowait(n:Double; left0,right0,ini0:double;  name0:ansistring):double;overload;
function LocateValue(n:Double; ini0:double; name0:ansistring):double;overload;
function LocateValueNowait(n:Double; ini0:double;  name0:ansistring):double;overload;


{ASK Statements}
function ASkWindow(var x1,x2,y1,y2:double):integer;                   overload;
function ASkViewport(var x1,x2,y1,y2:double):integer;                 overload;
function ASkDeviceWindow(var x1,x2,y1,y2:double):integer;             overload;
function ASkDeviceViewport(var x1,x2,y1,y2:double):integer;           overload;

function  AskPixelSize( var var1,var2:double):integer;                  overload;
//function  AskPixelSize( var var1,var2:integer):integer;                 overload;
function  AskPixelSize( var var1,var2:int64):integer;                   overload;
function  AskPixelSize(n1,n2,n3,n4:double; var var1,var2:double):integer;overload;
function  AskPixelSize(n1,n2,n3,n4:double; var var1,var2:int64):integer;overload;
function  AskPixelValue(x,y:double; var var1:double):integer;            overload;
function  AskPixelArray(x,y:double; a:Tarray2N):integer;                 overload;
function  AskPixelArray(x,y:double; a:Tarray2N; s:TStrVar):integer;      overload;

function getlinecolor(var x:double):integer;            overload;
function getlinestyle(var x:double):integer;            overload;
function getlinewidth(var x:double):integer;            overload;
function getpointcolor(var x:double):integer;           overload;
function getpointstyle(var x:double):integer;           overload;
function getareacolor(var x:double):integer;            overload;
function gettextcolor(var x:double):integer;            overload;
function getmaxcolor(var x:double):integer;             overload;
function getaxiscolor(var x:double):integer;            overload;
function getMaxPointDevice(var x:double):integer;       overload;
function getMaxMultiPointDevice(var x:double):integer;  overload;
function getMaxChoiceDevice(var x:double):integer;      overload;
function getMaxValueDevice(var x:double):integer;       overload;
function getAreaStyleIndex(var x:double):integer;       overload;
function getmaxlinestyle(var x:double):integer;         overload;
function getmaxpointstyle(var x:double):integer;        overload;

function ASkTextHeight(var x:double):integer;                      overload;
function AskTextAngle(var x:double):integer;                       overload;
function AskTextAngleRad(var x:double):integer;                    overload;
function AskDeviceSize(var x,y:double; t:TStrVar):integer;         overload;
function AskBitmapSize(var x,y:double):integer;                    overload;
function AskTextJustify(h,v:TStrVar):integer;                      overload;
function AskTextWidth(const s:string; var width:double):integer;   overload;
function AskTextFont(s:TStrVar;var x:double):integer;                 overload;
function AskColorMix(ColorIndex:double; var red,green,blue:double):integer; overload;
function AskClip(svar:TStrvar):integer;
function AskColorMode(svar:TStrvar):integer;
function AskBeamMode(svar:TStrvar):integer;
function AskTextBack(svar:TStrvar):integer;


procedure FLOOD( x,y:double);
procedure FLOODFill( x,y:double);


procedure drawaxes0(x,y:double);
procedure drawgrid0(x,y:double);
procedure drawaxes2(x,y:double);
procedure drawgrid2(x,y:double);
procedure drawcircle(x,y:double);
procedure drawdisk(x,y:double);

procedure GLOAD(const fname:string);
Procedure GSAVE(const fname,pf:string);

{Transform}
procedure PushTransform;
procedure mlt(a:TArray2N);  overload;
procedure shift(x,y:double);overload;
procedure scale1(x:double);
procedure scale(x,y:double);
procedure rotate2(x,y:double);
procedure rotate(x:double);
procedure shear(x:double);
procedure mlt_next;
procedure PopTransform;
procedure BeamManage;

procedure WaitReady;


{*************}
implementation
{*************}
uses
  Forms, Classes, SysUtils,  math, GraphType, Dialogs,Controls,
  MyUtils,SConsts, base,base2,affine,graphsys,format,LocateFrm,locatech,GraphQue,
  gridaxes,mythread,textfile;



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

function PixelY(x:double):Integer;
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;

{*********}
{SET COLOR}
{*********}
const
   idxColorMax=255;
   ercodeColor=11085;

type
    TSetColor=class(TGraphCommand)
      c:TColor;
      constructor create(c1:tColor);
    end;

constructor TSetColor.create(c1:tColor);
begin
  inherited create;
  c:=c1;
end;

type
    TSetpointcolor=class(TSetColor)
      procedure execute;override;
    end;

procedure TSetPointcolor.execute;
begin
  MyGraphSys.PointColor:=c;
end;

procedure SetPointColor(x:double; InsideOfWhen:boolean); overload;
var
   c:TColor;
begin
 c:=system.Round(x) and $ffffff;
 if not MyPalette.PaletteDisabled and ((c<0) or (c>idxColorMax)) then
     ReportException( InsideOfWhen ,ercodeColor,'SET POINT COLOR');
 addQueue(TSetPointColor.create(c));
end;

type
    TSetLineColor=class(TSetColor)
      procedure execute;override;
    end;

procedure TSetLineColor.execute;
begin
  MyGraphSys.SetLineColor(c);
end;

procedure setLineColor(x:double; InsideOfWhen:boolean); overload;
var
   c:TColor;
begin
 c:=system.Round(x) and $ffffff;
 if not MyPalette.PaletteDisabled and ((c<0) or (c>idxColorMax)) then
    ReportException( InsideOfWhen ,ercodeColor,'SET LINE COLOR');
 addQueue(TSetLineColor.create(c));
end;

type
    TSetAreaColor=class(TSetColor)
      procedure execute;override;
    end;

procedure TSetAreaColor.execute;
begin
  MyGraphSys.areaColor:=c;
end;

procedure setAreaColor(x:double; InsideOfWhen:boolean); overload;
var
   c:TColor;
begin
 c:=system.Round(x) and $ffffff;
 if not MyPalette.PaletteDisabled and ((c<0) or (c>idxColorMax)) then
    ReportException( InsideOfWhen ,ercodeColor,'SET AREA COLOR');
 addQueue(TSetAreaColor.create(c));
end;

type
    TSetTextColor=class(TSetColor)
      procedure execute;override;
    end;

procedure TSetTextColor.execute;
begin
   MyGraphSys.SetTextColor(c)
end;


procedure setTextColor(x:double; InsideOfWhen:boolean); overload;
var
   c:TColor;
begin
 c:=system.Round(x) and $ffffff;
 if not MyPalette.PaletteDisabled  and ((c<0) or (c>idxColorMax)) then
    ReportException( InsideOfWhen ,ercodeColor,'SET TEXT COLOR');
 addQueue(TSetTextColor.create(c));
end;

type
    TSetAllColor=class(TSetColor)
      procedure execute;override;
    end;

procedure TSetAllColor.execute;
begin
   MyGraphSys.PointColor:=c;
   MyGraphSys.SetLineColor(c);
   MyGraphSys.AreaColor:=c;
   MyGraphSys.SetTextColor(c);
end;

procedure setAllColor(x:double; InsideOfWhen:boolean); overload;
var
   c:TColor;
begin
 c:=system.Round(x) and $ffffff;
 if not MyPalette.PaletteDisabled and ((c<0) or (c>idxColorMax)) then
     ReportException( InsideOfWhen ,ercodeColor,'SET COLOR');
 addQueue(TSetAllColor.create(c));
end;


function ColorOfName(s:string; insideofWhen:boolean):TColor;
var
   i:integer;
begin
          for i:=1 to length(s) do s[i]:=upcase(s[i]);
          if (s='BLACK') or (s='黒') then
             result:=Black
          else if (s='BLUE')or (s='青')  then
             result:=Blue
          else if (s='RED') or (s='赤') then
             result:=Red
          else if s='MAGENTA' then
             result:=Magenta
          else if (s='GREEN') or (s='緑') then
             result:=Green
          else if s='CYAN' then
             result:=cyan
          else if (s='YELLOW') or (s='黄') then
             result:=Yellow
          else  if (s='WHITE') or (s='白') then
             result:=White
          else if s='GRAY' then
             result:=clGray
          else if s='NAVY' then
             result:=clNAVY
          else if s='SILVER' then
             result:=clSILVER
          else if s='LIME' then
             result:=clGREEN
          else
             begin
               result:=-1;
               //if insideofwhen or not JISSetWindow then
               //                  setexception(11085);
               ReportException( insideofwhen , 11085, 'color index out of range');
             end;
end;

function ColorIndex(r,g,b:double):TColor;
begin
   result:= MyPalette.colorindex(Integer(System.Round(r*255))
                                +Integer(System.Round(g*255)*$100)
                                +Integer(System.Round(b*255)*$10000));
end;

procedure SetPointColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
       if c>=0 then
            addQueue(TSetPointColor.create(c));
     end
end;

procedure setLineColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
       if c>=0 then
             addQueue(TSetLineColor.create(c));
     end
end;

procedure setAreaColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
       if c>=0 then
           addQueue(TSetAreaColor.create(c));
     end
end;

procedure setTextColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
             addQueue(TSetTextColor.create(c));
     end
end;

procedure setAllColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
             addQueue(TSetAllColor.create(c));
     end
end;

procedure SetAxisColor(x:double; InsideOfWhen:boolean);overload;
var
   c:TColor;
begin
   c:=system.Round(x);
   if c>=0 then
      GraphSys.axescolor:=c
end;

procedure SetAxisColor(const s:string; InsideOfWhen:boolean);overload;
var
   c:TColor;
   color:TColor;
begin
   color:=GraphLib.ColorOfName(s,insideofWhen);
   if color>=0 then
     begin
       c:=MyPalette.ColorIndex(color);
         if c>=0 then
            SetAxisColor(c,InsideOfWhen);
     end
end;

function CoordinateTest(var l,r,b,t:double; insideofwhen:boolean):boolean;
begin
    if currenttransform<>nil then
               setexception(11004);
    if ((l=r) or (b=t)) then
         //if InsideOfWhen or not JISSetWindow then
         //     setexception(11051)
         //else
         //     result:=false
         begin
           result:=false;
           ReportException(InsideOfWhen ,11051, 'SET statement with width zero, or height zero');
         end
      else
         result:=true;
end;

type
    TSetWindow=class(TGraphCommand)
      l,r,b,t:double;
      constructor create(l0,r0,b0,t0:double);
      procedure execute; override;
    end;

constructor TSetWindow.create(l0,r0,b0,t0:double);
begin
  inherited create;
  l:=l0;
  r:=r0;
  b:=b0;
  t:=t0;
end;

procedure TSetWindow.execute;
begin
      MyGraphSys.setWindow(l,r,b,t);
end;

procedure SetWindow(l,r,b,t:double; insideofWhen:boolean);
begin
  WaitReady;
  if CoordinateTest(l,r,b,t,insideofwhen)then
    addQueue(TSetWindow.create(l,r,b,t));
  WaitReady;
end;

function TestInterval(const l,r,b,t:double):boolean;
begin
   result:=(0<=l) and (r<=1) and (0<=b) and (t<=1)
end;

type
    TSetViewPort=Class(TSetWindow)
      procedure execute;override;
    end;
procedure TSEtViewport.execute;
begin
   MyGraphSys.setViewport(l,r,b,t);

end;

procedure SetViewPort(l,r,b,t:double; InsideOfWhen:boolean);
begin
  WaitReady;
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if testInterval(l,r,b,t) then
       begin
        addQueue(TSetViewport.create(l,r,b,t));
        WaitReady;
       end
      else //if InsideOfWhen or not JISSetWindow then
       //    setexception(11052);
        ReportException(insideofwhen ,11052,'SET VIEWPORT');
end;

procedure SetDeviceWindow(l,r,b,t:double; InsideOfWhen:boolean);
begin
  WaitReady;
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if testInterval(l,r,b,t) then
         MyGraphSys.setDeviceWindow(l,r,b,t)
     else //if InsideOfWhen or not JISSetWindow then
          //    setexception(11053);
      ReportException(insideofwhen ,11053,'SET DEVICE WINDOW');
end;

procedure SetDeviceViewPort(l,r,b,t:double; InsideOfWhen:boolean);
begin
  WaitReady;
  if CoordinateTest(l,r,b,t, InsideOfWhen)then
     if (l<r) and (b<t) then
          MyGraphSys.setDeviceViewport(l,r,b,t)
     else //if InsideOfWhen or not JISSetWindow then
          //    setexception(11054);
       ReportException(insideofwhen  ,11054,'SET DEVICE VIEWPORT');
end;

TYpe
    TClear=class(TGraphCommand)
     procedure execute;override;
    end;

procedure TClear.execute;
begin
  if MyGraphSys<>nil then MyGraphSys.clear;
end;

procedure Clear;
begin
  addQueue(TClear.create);
end;

{*********}
{SET COLOR}
{*********}

{*************}
{SET COLOR MIX}
{*************}

//var
   //ColorMixCriticalSection:TRTLCriticalSection;
 type
     TSetColorMix=class(TGraphCommand)
        c:byte;
        col:TColor;
       constructor create(c0:byte; col0:TColor);
       procedure execute;override;
     end;

constructor TSetColorMix.create(c0:byte; col0:TColor);
begin
    c:=c0;
    col:=col0;
end;

procedure TSetColorMix.execute;
begin
  with MyGraphSys do
    begin
       MyPalette[c]:=col ;
       setlinecolor(linecolor);
       settextcolor(textcolor);
    end;
end;

 procedure SetColorMixSub(c:byte;r,g,b:byte);
var
   col:TColor;
begin
  col:=r+g*DWord($100)+b*DWord($10000) ;
  addQueue(TSetColorMix.create(c,col));
end;



procedure SetColorMix(cc:double; er,eg,eb:double; InsideofWhen:boolean);
var
   c,r,g,b:byte;
begin
  if (cc<0) or (cc>maxColor) or MyPalette.PaletteDisabled then
     // if InsideOfWhen or not JISSetWindow then
     //       setexception(11085);
     ReportException(insideofwhen ,11085,'SET COLOR MIX');

  if (er<0) or (er>1) or (eg<0) or (eg>1) or (eb<0) or (eb>1) then
     // if InsideOfWhen or not JISSetWindow then
     //       setexception(11088);
      ReportException(insideofwhen ,11088,'SET COLOR MIX');

     c:=system.Round(cc);
     r:=system.Round(er*255);
     g:=system.Round(eg*255);
     b:=system.Round(eb*255);
     setcolormixsub(c,r,g,b);
end;

type
  TSetStyle=class(TGraphCommand)
    c:LongInt;
    constructor create(c0:LongInt);
  end;

constructor TSetStyle.create(c0:LongInt);
begin
  inherited create;
  c:=c0;
end;

type
  TSetPointStyle=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetPointStyle.execute;
begin
      MyGraphSys.pointstyle:=c
end;

procedure setPointStyle(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
  c:=system.Round(x);
  if (c>0) and (c<=maxpointstyle) then
    addQueue(TSetPointStyle.create(c))
  else //if insideofwhen  or not JISSetWindow then
       //    setexception(11056) ;
      ReportException(insideofwhen  ,11056,'SET POINT STYLE');
end;


type
  TSetLineStyle=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetLineStyle.execute;
begin
    MyGraphSys.setPenStyle(TPenStyle(c));
end;

procedure setLineStyle(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
   s:TPenStyle;
begin
  c:=system.Round(x);
  if (c>0) and (c<=5) then
  begin
    case c of
      1:  s:=psSolid;
      2:  s:=psDash;
      3:  s:=psDot;
      4:  s:=psDashDot;
      5:  s:=psDashDotDot;
    end;
    addQueue(TSetLineStyle.create(LongInt(s)))
  end
  else
    //if insideofwhen  or not JISSetWindow then
    //         setexception(11062)
    ReportException(insideofwhen  ,11062,'SET LINE STYLE');
end;

type
  TSetAreaStyleIndex=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetAreaStyleIndex.execute;
begin
      MyGraphSys.SetAreaStyleIndex(c)
end;
procedure setAreaStyleIndex(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
  c:=system.Round(x);
  if (c>0) and (c<=6) then
    AddQueue(TSetAreaStyleIndex.create(c))
  else //if insideofwhen  or not JISSetWindow then
       //    setexception(11000) ;
       ReportException(insideofwhen  ,11000,'SET AREA STYLE INDEX');
end;

type
  TsetReal=class(TGraphCommand)
    x:double;
    constructor create(x0:double);
  end;

 constructor TSetReal.create(x0:double);
 begin
   inherited create;
   x:=x0;
 end;

type
  TSetTextHeight=class(TsetReal)
    procedure execute;override;
  end;

procedure TSetTextHeight.execute;
begin
      MyGraphSys.SetTextHeight(x)
end;

procedure setTextHeight(x:double; InsideOfWhen:boolean);
begin
   if x>0 then
        addQueue(TSetTextHeight.create(x))
   else //if insideofWhen or not JISSetWindow then
         //setexception(11073);
        ReportException(insideofwhen  ,11073,'SET TEXT HEIGHT');
end;

type
  TSetLineWidth=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetLineWidth.execute;
begin
      MyGraphSys.setlinewidth(c)
end;
procedure setLineWidth(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
   c:=system.Round(x);
   if c>0 then
      AddQueue(Tsetlinewidth.create(c))
   else //if insideofwhen then
        //{setexception(数値未定)};
        ReportException(insideofwhen  ,11000,'SET LINE WIDTH');
end;

type
  TSetTextAngle=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetTextAngle.execute;
begin
      MyGraphSys.textangle:=c;
end;
procedure setTextAngle(x:double; AngleDegrees:boolean);
function floor(x:double):double;
begin
   result:=Int(x);
   if (x<0) and (x<result) then
      result:=result-1.
end;
var
  a:LongInt;
begin
  if not Angledegrees then
      x:=x * 180. / PI;
   a:=System.Round(x - floor(x/360.0 ) * 360.0 );
   AddQueue(TSettextangle.create(a));
end;

type
  TSetAreaStyle=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetAreaStyle.execute;
begin
      MyGraphSys.SetAreaStyle(TAreaStyle(c));
end;
procedure setAreaStyle(const s:string);
var
   c:TAreaStyle;
begin
   if UpperCase(s)='HOLLOW' then c:=asHollow
   else if UpperCase(s)='SOLID' then c:=asSolid
   else if UpperCase(s)='HATCH' then c:=asHatch
   else setexception(11000);
   AddQueue(TSetAreaStyle.create(LongInt(c)));
end;

type
  TSetHJustify=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetHJustify.execute;
begin
    MyGraphSys.Hjustify:=tjHorizontal((c));
end;

type
  TSetVJustify=class(TsetStyle)
    procedure execute;override;
  end;

procedure TSetVJustify.execute;
begin
    MyGraphSys.Vjustify:=tjVirtical((c));
end;

procedure setTextJustify( s1,s2:string; InsideOfWhen:boolean);
 var
   h:tjHorizontal;
   v:tjVirtical;
  begin
    s1:=ansiUpperCase(s1);
    s2:=ansiUpperCase(s2);

     h:=tjLEFT;
     while (h<=tjRIGHT) and (Hjustification[h]<>s1) do inc(h);
     if system.ord(h)<=system.ord(tjRIGHT) then
        addQueue(TsetHjustify.create(longint(h)))
     else //if insideofwhen or not JISSetWindow then
          //setexception(4102) ;
       ReportException(insideofwhen ,4102,'SET TEXT JUSTIFY');

    v:=tjTOP;
    while (v<=tjBOTTOM) and (Vjustification[v]<>s2) do inc(v);
    if system.ord(v)<=system.ord(tjBOTTOM) then
       addQueue(TSetVjustify.create(Longint(v)))
    else //if insideofwhen  or not JISSetWindow then
         //setexception(4102) ;
       ReportException(insideofwhen ,4102,'SET TEXT JUSTIFY');
end;

type
  TSetTextFont=class(TsetStyle)
    s:string;
    constructor create(s0:string; c0:longint);
    procedure execute;override;
  end;
constructor TSetTextFont.create(s0:string; c0:longint);
begin
  inherited create(c0);
  s:=s0;
end;

procedure TSetTextFont.execute;
begin
    MyGraphSys.SetTextFont(s, c);
end;

procedure SetTextFont(const s:string; x:double);
begin
    AddQueue(TSetTextFont.create(s, LongIntRound(x)));
end;

procedure SetTextBackGround(const s:string);
begin
  WaitReady;
  if UpperCase(s)='TRANSPARENT' then iBKmode:=TRANSPARENT
   else if UpperCase(s)='OPAQUE' then iBKmode:=OPAQUE
   else setexception(11000);
end;

(*
procedure setpointcolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.PointColor:=c;
end;

procedure setlinecolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.setlinecolor(c);
end;

procedure setareacolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.areacolor:=c ;
end;

procedure settextcolor(c:integer);
begin
    c:=c and $ffffff;
    MyGraphSys.settextcolor(c);
end;
*)
type
  TSetDrawMode=class(TGraphCommand)
    mode:char;
    constructor create(mode0:char);
    procedure execute;override;
  end;
constructor TSetDrawMode.create(mode0:char);
begin
  inherited create;
  mode:=mode0;
end;

procedure TSetDrawMode.execute;
begin
  case mode of
   'E':  MyGraphSys.setHiddenDrawMode(false);
   'H':  MyGraphSys.setHiddenDrawMode(true) ;
   'N':  MyGraphSys.setRasterMode(pmNotXor) ;
   'O':  MyGraphSys.setRasterMode(pmCopy)   ;
   'A':  MyGraphSys.setRasterMode(pmMask)   ;
   'M':  MyGraphSys.setRasterMode(pmMerge) ;
   'X':  MyGraphSys.setRasterMode(pmXor) ;
   end;
end;

procedure SetDrawMode(mode:char);
begin
  addQueue(TSetDrawMode.create(mode))
end;



type
  TsetClip=class(TGraphCommand)
     OnOff:Boolean;
     constructor create(s:boolean);
     procedure execute;override;
   end;

constructor TSetClip.create(s:boolean);
begin
  inherited create;
  OnOff:=s;
end;

procedure TSetClip.execute;
begin
    MyGraphSys.setclip(OnOff)
end;

procedure SetClip(const s:string; insideofwhen:boolean);
begin
   //with MyGraphSys do
   if Uppercase(s)='ON' then addQueue(TSetclip.create(true))
   else if Uppercase(s)='OFF' then addQueue(TSetclip.create(false))
   else //if InsideOfWhen or not JISSetWindow then
        //                setexception(4101);
      ReportException(InsideOfWhen  ,4101, 'SET CLIP');
end;

type
  TSetBitMapSize=class(TGraphCommand)
     x,y:double;
     constructor create(x0,y0:double);
     procedure execute;override;
  end;

constructor TSetBitMapSize.create(x0,y0:double);
begin
  inherited create;
  x:=x0;
  y:=y0;
end;

procedure TSetBitMapSize.execute;
begin
   try
     MyGraphSys.setBitmapSize(LongIntRound(x),LongIntRound(y))
   except
     setexception(9050);
   end;
end;

procedure SetBitmapSize(x,y:double);
begin
    AddQueue(TsetBitmapSize.create(x,y));
    WaitReady;
end;

{*************************}
{PLOT POINT and PLOT LINES}
{*************************}
var
   x0,y0:double;

procedure ProjectivePlotTo(const x1,y1:double);
var
  a,b,s,t,u,x,y:double;
label
  Retry1,Retry2;
begin
  with CurrentTransform do
    begin
      if MyGraphSys.beam=true then
        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 - 1e-14) and (t<=1 + 1e-14) then
                 begin

                   u:=t;
                 Retry1:
                   u:=u-0.0001;
                   if u>0 then
                     begin
                       x:=a*u+x0;
                       y:=b*u+y0;
                       if transform(x,y) then
                          MyGraphSys.PlotTo(x,y)
                       else
                          GOTO Retry1;
                     end;

                   MyGraphSys.beam:=false;

                   u:=1-t;
                 Retry2:
                   u:=u-0.0001;
                   if u>0 then
                     begin
                       x:=a*(1-u)+x0;
                       y:=b*(1-u)+y0;
                       if transform(x,y) then
                          MyGraphSys.PlotTo(x,y)
                       else
                          GOTO Retry2;
                     end;
                 end;
            end;
        end;

      x:=x1;
      y:=y1;
      if transform(x,y) then
         MyGraphSys.PlotTo(x,y);
      x0:=x1;
      y0:=y1;
      MyGraphSys.beam:=true;
    end;
end;

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

type
   TGraphPoint=class(TGraphCommand)
      x,y:double;
     constructor create(x1,y1:double);
     procedure execute;override;
   end;

type
   TGraphPoint2=class(TGraphCommand2)
     x,y:double;
     constructor create(x1,y1:double; p:TGraphCommand);
     procedure execute;override;
   end;

constructor TGraphPoint.create(x1,y1:double);
   begin
       inherited create;
       x:=x1;
       y:=y1;
   end;

procedure TGraphPoint.execute;
   begin
     MyGraphSys.beam:=false;
     MyGraphSys.putMark(x,y);
     RepaintRequest:=true;
   end;

constructor TGraphPoint2.create(x1,y1:double; p:TGraphCommand);
begin
    inherited create;
    prev:=p;
    x:=x1;
    y:=y1;
end;

procedure TGraphPoint2.execute;
begin
  if prev<>nil then prev.execute;
  MyGraphSys.putMark(x,y);
  RepaintRequest:=true;
end;

type
   TPlotPoint=class(TGraphPoint)
     procedure execute;override;
   end;

procedure TPlotPoint.execute;
begin
  if currenttransform.transform(x,y) then
      with MyGraphSys do
      begin
        if  BeamMode=bmRigorous then
            beam:=false;
         putMark(x,y);
         RepaintRequest:=true;
      end;
end;
type
   TPlotPoint2=class(TGraphPoint2)
     procedure execute;override;
   end;

procedure TPlotPoint2.execute;
begin
  if prev<>nil then prev.execute;
  if currenttransform.transform(x,y) then
     MyGraphSys.putMark(x,y);
  RepaintRequest:=true;
end;

type
   TBeamOff=class(TGraphCommand2)
       procedure execute;override;
   end;

procedure TBeamoff.execute;
begin
  if prev<>nil then prev.execute;
  MyGraphSys.beam:=false;
end;

procedure GraphPoints(const a: array of double);
var
   i:integer;
   p:TGraphCommand;
begin
  p:=nil;
  for i:=0 to High(a) div 2 do
        p:=TGraphPoint2.create(a[2*i],a[2*i+1],p);
  addQueue(p);
end;

procedure PlotPoints2(const a: array of double);
var
   i:integer;
   x,y:double;
   p:TGraphCommand;
begin

   p:=nil;
   if  MyGraphSys.BeamMode=bmRigorous then
       addQueue(TBeamOff.create);
   for i:=0 to High(a) div 2 do
        p:=TPlotPoint2.create(a[2*i],a[2*i+1],p);
   addQueue(p);
end;

procedure PlotPoints(const a: array of double);
begin
  if  High(a)=1 then
     addQueue(TPlotPoint.create(a[0],a[1]))
  else
     PlotPoints2(a)
end;

procedure GraphColorPoints(const a:array of double; c:double);
var
   i:integer;
   p:TGraphCommand;
begin
  p:=TSetPointColor.create(system.Round(c) and $ffffff);
  for i:=0 to High(a) div 2 do
        p:=TGraphPoint2.create(a[2*i],a[2*i+1],p);
  addQueue(p);
end;

procedure PlotColorPoints(const a:array of double; c:double);
var
   i:integer;
   x,y:double;
   p:TGraphCommand;
begin
   p:=TSetPointColor.create(system.Round(c) and $ffffff);
   if  MyGraphSys.BeamMode=bmRigorous then
       addQueue(TBeamOff.create);
   for i:=0 to High(a) div 2 do
        p:=TPlotPoint2.create(a[2*i],a[2*i+1],p);
   addQueue(p);
end;

{***********}
{Graph Lines}
{***********}
{
type
   TGraphLine=class(TGraphPoint2)
     procedure execute;override;
   end;

procedure TGraphLine.execute;
begin
   if prev<>nil then prev.execute;
   MyGraphSys.PlotTo(x,y);
end;

procedure GraphLines(const a: array of double);
var
   i:integer;
   p:TGraphCommand;
begin
   p:=TBeamOff.create;
   for i:=0 to High(a) div 2 do
       p:=TGraphLine.create(a[2*i],a[2*i+1],p);
   addQueue(TbeamOff.create(p));
end;
}
type
  TGraphLines=Class(TGraphCommand)
    a: array of double;
    constructor Create(const a0: array of double);
    procedure execute;override;
  end;

constructor TGraphLines.create(const a0: array of double);
var
  i:integer;
begin
 inherited create;
 SetLength(a,length(a0));
 for i:=0 to High(a0)
     do a[i]:=a0[i];
end;

procedure TGraphLines.execute;
var
   i:integer;
begin
  with MyGraphSys do
    begin
       Beam:=false;
       for i:=0 to High(a) div 2 do
            PlotTo(a[2*i],a[2*i+1]);
       Beam:=false;
    end;
  RepaintRequest:=true;
end;

procedure GraphLines(const a: array of double);
begin
  AddQueue(TGraphLines.create(a));
end;

type
 TPlotLines=Class(TGraphLines)
    procedure execute;override;
 end;

type
   TPlotLinesBeamOff=class(TPlotLines)
      procedure execute;override;
   end;


procedure TPlotLines.execute;
var
  i:integer;
  x,y:double;
begin
   if (CurrentTransform=nil) or CurrentTransform.IsAffine then
     for i:=0 to High(a) div 2 do
        begin
          x:=a[2*i];
          y:=a[2*i+1];
          if currenttransform.transform(x,y) then
             MyGraphSys.PlotTo(x,y);
        end
   else
     for i:=0 to High(a) div 2 do
        begin
          x:=a[2*i];
          y:=a[2*i+1];
          ProjectivePlotTo(x,y)
        end;
   RepaintRequest:=true;
end;

procedure TPlotLinesBeamoff.execute;
begin
 inherited execute;
 MyGraphSys.beam:=false;
end;

procedure PlotLines(const a: array of double);
begin
   addQueue(TPlotLines.create(a));
end;

procedure PlotLinesBeamOff(const a: array of double);
begin
   addQueue(TPlotLinesBeamoff.create(a));
end;


procedure BeamOff;
begin
  addQueue(TBeamOff.create);
end;

{*********}
{PLOT AREA}
{*********}

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;


function Inner(x,y:double; p:PCoordinateArray; count:integer):boolean;
var
  i:integer;
  x0,y0,x1,y1,y2:double;
  xt:double;
begin
  if (p^[0].x = p^[count-1].x) and (p^[0].y = p^[count-1].y) then dec(count);

  result:=false;

  for i:=0 to count -1 do
    begin
       x0:=p^[i].x;
       y0:=p^[i].y;
       x1:=p^[(i+1) mod count].x;
       y1:=p^[(i+1) mod count].y;
       y2:=p^[(i+2) mod count].y;

       if (y0 - y) * (y - y1) >0 then
          begin
             xt:=(x1-x0)/(y1-y0)*(y-y0)+x0;
             if x=xt then begin result:=true; exit end
             else if x<xt then result:=not result;
          end
       else if y=y1 then
          begin
            if (y0=y1) then
               begin
                 if ((x -x0)*(x - x1)<=0) then
                    begin result:=true ; exit end ;
               end
            else if (y=y1) and ((y0 - y1)*(y1 - y2)>0) then
               begin
                 if x<x1 then result:= not result
               end
          end
    end;
end;

function ReMakeList(p:PCoordinateArray; q:PPointArray; count:integer; GRAPHst:boolean):integer; //結果は点の個数
var
  i,index:integer;
  x,y:double;
begin
  result:=0;
  for i:=0 to count-1 do
    begin
      x:=p^[i].x;
      y:=p^[i].y;
      if GRAPHst or currenttransform.transform(x,y) then
         begin
           q^[result].x:=restrict(MyGraphSys.deviceX(x));
           q^[result].y:=restrict(MyGraphSys.deviceY(y));
           inc(result)
        end
    end;
end;


procedure ProjectivePolygonSub(p:PCoordinateArray; lim:integer);
var
   q:PPointArray;
   a,b:integer;
   x,y,yy:double;
begin
     if TestNormalSegments(p,lim) then
       begin
         GetMem(q,lim*sizeof(TPoint));
         try
           MyGraphSys.Polygon(slice(q^,ReMakeList(p,q,lim,false)));
         finally
           Freemem(q,lim*sizeof(TPoinT));
         end
       end
     else
       with MyGraphSys do
         for b:=ClipRect.top to Cliprect.Bottom do
           begin
             yy:=virtualY(b);
             for a:=ClipRect.Left to Cliprect.Right do
                begin
                   x:=virtualX(a);
                   y:=yy;
                   if currenttransform.invtransform(x,y) then
                       if inner(x,y,p,lim) then
                          PutColor(a,b,areacolor);
                end;
           end;
end;

procedure PlotAreaProjective(Const a:Array of double);
var
   P:PCoordinateArray;
   i:integer;
   count:integer;
begin
   count:=Length(a) div 2;
   GetMem(p, count*SizeOf(TCoordinate));
   try
      for i:=0 to count -1 do
         begin
            p^[i].x:=a[2*i];
            p^[i].y:=a[2*i+1];
         end;
      ProjectivePolygonSub(p,count);
   finally
      FreeMem(p, count*SizeOf(TCoordinate));
   end;
end;

procedure PlotAreaNormal(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   GetMem(p,sizeof(TPoint)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            if not affine.currenttransform.transform(x,y) then exit;
            p^[i].x:=restrict(MyGraphSys.deviceX(x));
            p^[i].y:=restrict(MyGraphSys.deviceY(y));
          end;
      MyGraphSys.Polygon(Slice(p^,Length(a) div 2));
   finally
      FreeMem(p, sizeof(TPoint)*Length(a));
   end;
end;

type
  TGraphArea=class(TGraphLines)
    procedure execute;override;
  end;

type
  TPlotArea=Class(TGraphArea)
     procedure execute;override;
  end;

procedure PlotArea(const a: array of double);
begin
  AddQueue(TPlotArea.create(a))
end;

procedure DoPlotArea(const a: array of double);
begin
      with MyGraphSys do
     if BeamMode=bmRigorous then beam:=false;
   if (CurrentTransform=nil) or CurrentTransform.IsAffine then
      PlotAreaNormal(a)
    else
      PlotAreaProjective(a);
end;

procedure TPlotArea.execute;
begin
   DoPlotArea(a);
   RepaintRequest:=true;
end;

procedure DoGraphArea(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   GetMem(p,sizeof(TPoint)*Length(a));
   try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            p^[i].x:=restrict(MyGraphSys.deviceX(x));
            p^[i].y:=restrict(MyGraphSys.deviceY(y));
          end;
      MyGraphSys.Polygon(Slice(p^,Length(a) div 2));
   finally
      FreeMem(p, sizeof(TPoint)*Length(a));
   end;
end;

procedure TGraphArea.execute;
begin
    MyGraphSys.beam:=false;
    DoGraphArea(a);
    RepaintRequest:=true;
end;

procedure GraphArea(const a: array of double);
begin
    AddQueue(TGraphArea.create(a));
end;

{*********}
{PLOT TEXT}
{*********}

Type
  TGraphText=Class(TGraphCommand)
    x,y:double;
    s:string;
    constructor create(x0,y0:double; s0:string);
    procedure execute;override;
  end;

  TPlotText=Class(TGraphText)
      procedure execute;override;
    end;

constructor TGraphText.create(x0,y0:double; s0:string);
begin
  inherited create;
  x:=x0;
  y:=y0;
  s:=s0;
end;

procedure TGraphText.execute;
begin
   with MyGraphSys do beam:=false;
   MyGraphSys.PutText(x,y,s);
   RepaintRequest:=true;
end;

procedure GraphText(x,y:double; const s:string);
begin
  addQueue(TGraphText.create(x,y,s))
end;

procedure TPlotText.execute;
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotText(x,y,s);
   RepaintRequest:=true;
end;

procedure PlotText(x,y:double; const s:string);
begin
  addQueue(TPlotText.create(x,y,s))
end;



function TextUsing(const form:string; a:array of const):String;
var
  i,code,c:integer;
  s:string;
begin
   i:=1;
   s:=literals(form,i);
   for c:=0 to High(a) do
      begin
        with a[c] do
          case VType of
            vtInteger:   s:=s + formatEx(VInteger,form,i,code);
            vtInt64:     s:=s + formatEx(VINT64^,form,i,code);
            vtExtended:  s:=s + formatEx(VExtended^,form,i,code);
            vtchar:      s:=s + formatStr(VChar,form,i,code);
            vtString:    s:=s + formatStr(VString^,form,i,code);
            vtAnsiString:s:=s + formatStr(string(VAnsiString),form,i,code);
          end;
        s:=s +literals(form,i)
      end;
    result:=s;
end;

procedure PlotTextUsing(x,y:double; const form:string; a:array of const);
begin
   PlotText(x,y,TextUsing(form,a));
end;

procedure GraphTextUsing(x,y:double; const form:string; a:array of const);
begin
   GraphText(x,y,TextUsing(form,a));
end;

type
  TGraphLabel=Class(TGraphText)
    procedure execute;override;
  end;

  TPlotLabel=Class(TGraphLabel)
    procedure execute;override;
  end;

   TPlotLetters=Class(TGraphlabel)
    procedure execute;override;
  end;

procedure  TGraphLabel.execute;
begin
  with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   MyGraphSys.PutText(x,y,s);
   RepaintRequest:=true;
end;

procedure TPlotLabel.execute;
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
       MyGraphSys.PutText(x,y,s);
   RepaintRequest:=true;
end;

 procedure TPlotLetters.execute;
 begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotLetters(x,y,s);
       RepaintRequest:=true;
end;

procedure GraphLabel(x,y:double; const s:string);
begin
  addQueue(TGraphLabel.create(x,y,s))
end;

procedure PlotLabel(x,y:double; const s:string);
begin
    addQueue(TPlotLabel.create(x,y,s))
end;

procedure PlotLetters(x,y:double; const s:string);
begin
  addQueue(TPlotLetters.create(x,y,s))
end;

procedure GraphLabelUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLabel(x,y,TextUsing(form,a));
end;

procedure PlotlabelUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLabel(x,y,TextUsing(form,a));
end;


procedure PlotLettersUsing(x,y:double; const form:string; a:array of const);
begin
   PlotLetters(x,y,TextUsing(form,a));
end;


{********}
{MAT PLOT}
{********}


procedure MatPlotPointsSub(n:integer; const m1,m2:TArray1N);overload;
var
   i:integer;
   x,y:double;
begin
   for i:=0 to n-1 do
      begin
         x:=m1.elements[i];
         y:=m2.elements[i];
         if currenttransform.transform(x,y) then
            MyGraphSys.putMark(x,y);
      end;
end;

procedure MatPlotPointsSub(n:integer; const m:TArray2N);overload;
var
   i:integer;
   s:integer;
   x,y:double;
begin
   s:=m.size2;
   if s<=1 then
      setexception(6401);

   for i:=0 to n-1 do
      begin
         x:=m.elements[i*s];
         y:=m.elements[i*s+1];
         if currenttransform.transform(x,y) then
            MyGraphSys.putMark(x,y);
      end;
end;


function SetCoordinate(p:PPointArray; n:integer; x,y:TArray1N):boolean;overload;
var
   i:integer;
   xx,yy:double;
begin
   result:=false;
   for i:=0 to n-1 do
     begin
        xx:=x.elements[i];
        yy:=y.elements[i];
        if not currenttransform.transform(xx,yy) then exit;
        p^[i].x:=restrict(MyGraphSys.deviceX(xx));
        p^[i].y:=restrict(MyGraphSys.deviceY(yy));
     end;
   result:=true;
end;

function SetCoordinate(p:PPointArray; n:integer; m:TArray2N):boolean;overload;
var
   i:integer;
   s:integer;
   xx,yy:double;
begin
   result:=false;
   s:=m.Size2;
   if s<=1 then
      setexception(6401);

   for i:=0 to n-1 do
     begin
        xx:=m.elements[i*s];
        yy:=m.elements[i*s+1];
        if not currenttransform.transform(xx,yy) then exit;
        p^[i].x:=restrict(MyGraphSys.deviceX(xx));
        p^[i].y:=restrict(MyGraphSys.deviceY(yy));
     end;
   result:=true;
end;


procedure MatPlotLinesSub(n:integer; const x,y:TArray1N);overload;
var
   p:PPointArray;
begin
   MyGraphSys.beam:=false;
   Getmem(p,n*sizeof(TPoint));
   try
      if SetCoordinate(p,n,x,y) then
         MyGraphSys.PolyLine(slice(p^,n));
   finally
      Freemem(p,n*sizeof(TPoint));
   end;
   MyGraphSys.beam:=false;

end;

procedure MatPlotLinesSub(n:integer; const m:TArray2N);overload;
var
   p:PPointArray;
begin
   MyGraphSys.beam:=false;
   Getmem(p,n*sizeof(TPoint));
   try
      if SetCoordinate(p,n,m) then
         MyGraphSys.PolyLine(slice(p^,n));
   finally
      Freemem(p,n*sizeof(TPoint));
   end;
   MyGraphSys.beam:=false;

end;

procedure MatPlotAreaSub(n:integer; const x,y:TArray1N);overload;
var
   p:PDoubleArray;
   i:integer;
begin
   if n<3 then setexception(11100);
   Getmem(p,2*n*sizeof(Double));
   try
      for i:=0 to n-1 do
         begin
           p^[2*i]:=x.elements^[i];
           p^[2*i+1]:=y.elements^[i];
         end;
      DoPlotArea(slice(p^,2*n))
   finally
      Freemem(p,2*n*sizeof(Double));
   end;

end;

procedure MatPlotAreaSub(n:integer; const m:TArray2N);overload;
begin
   if n<3 then setexception(11100);
   DoPlotArea(slice(m.elements^,n*2))
end;

type
   TMatPlotPoints1N=class(TGraphCommand)
     nn:NativeInt;
     x,y:TArray1N;
     constructor create(n0:NativeInt; x0,y0:TArray1N);
     procedure execute;override;
     destructor destroy;override;
   end;

   TMatPlotPoints2N=class(TGraphCommand)
     nn:NativeInt;
     m:TArray2N;
     constructor create(n0:NativeInt; m0:TArray2N);
     procedure execute;override;
     destructor destroy;override;
   end;

constructor TmatPlotPoints1N. create(n0:NativeInt; x0,y0:TArray1N);
begin
  inherited create;
  nn:=n0;
  x:=x0.NewCopy;
  y:=y0.NewCopy;
end;

destructor TmatPlotPoints1N.destroy;
begin
  x.free;
  y.free;
end;

constructor TmatPlotPoints2N. create(n0:NativeInt; m0:TArray2N);
begin
  inherited create;
  nn:=n0;
  m:=m0.newcopy;
end;

destructor TmatPlotPoints2N.destroy;
begin
  m.free;
end;

procedure TMatPlotPoints1N.execute;
begin
  MatPlotPointsSub(nn, x, y);
  RepaintRequest:=true;
end;

procedure TMatPlotPoints2N.execute;
begin
   MatPlotPointsSub(nn, m);
   RepaintRequest:=true;
end;


procedure MatPlotPoints(const x,y:TArray1N);overload;
begin
   if x.Size=y.Size then
     addQueue(TMatPlotPoints1N.create(x.size,x,y))
   else
      SetException(6401);
end;

procedure MatPlotPoints(const m:TArray2N);overload;
begin
   addQueue(TMatPlotPoints2N.create(m.size1,m))
end;

type
   TMatPlotLines1N=class(TMatPlotPoints1N)
     procedure execute;override;
   end;

   TMatPlotLines2N=class(TMatPlotPoints2N)
     procedure execute;override;
   end;

procedure TMatPlotLines1N.execute;
begin
   MatPlotLinesSub(nn, x, y);
   RepaintRequest:=true;
end;

procedure TMatPlotLines2N.execute;
begin
   MatPlotLinesSub(nn, m) ;
   RepaintRequest:=true;
end;

procedure MatPlotLines(const x,y:TArray1N);overload;
begin
   if (x.Size=y.Size) then
       addQueue(TMatPlotLines1N.create(x.size,x,y))
   else
      SetException(6401);
end;

procedure MatPlotLines(const m:TArray2N);overload;
begin
    addQueue(TMatPlotLines2N.create(m.size1,m))
end;

type
   TMatPlotArea1N=class(TMatPlotPoints1N)
     procedure execute;override;
   end;

   TMatPlotArea2N=class(TMatPlotPoints2N)
     procedure execute;override;
   end;

procedure TMatPlotArea1N.execute;
begin
   MatPlotAreaSub(x.Size, x, y);
   RepaintRequest:=true;
end;

procedure TMatPlotArea2N.execute;
begin
   MatPlotAreaSub(nn, m);
   RepaintRequest:=true;
end;

procedure MatPlotArea(const x,y:TArray1N);overload;
begin
   if (x.Size=y.Size) then
      addQueue(TMatPlotArea1N.create(x.size, x,y))
   else
      SetException(6401);
end;


procedure MatPlotArea(const m:TArray2N);overload;
begin
   addQueue(TMatPlotArea2N.create(m.size1, m))
end;

procedure MatPlotPointsLimit(n:double; const x,y:TArray1N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>=0) and (nn<=x.size1) and (nn<=y.size1) then
         addQueue(TMatPlotPoints1N.create(nn, x,y))
      else
         SetException(6402)
end;

procedure MatPlotPointsLimit(n:double; const m:TArray2N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>=0) and (nn<=m.size1)  then
         addQueue(TMatPlotPoints2N.create(nn, m))
      else
         SetException(6402)
end;


procedure MatPlotLinesLimit(n:double; const x,y:TArray1N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>0) and (nn<=x.size1) and (nn<=y.size1) then
         addQueue(TMatPlotLines1N.create(nn, x,y))
      else
         SetException(6402)
end;

procedure MatPlotLinesLimit(n:double; const m:TArray2N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>0) and (nn<=m.size1)  then
         addQueue(TMatPlotLines2N.create(nn, m))
      else
         SetException(6402)
end;

procedure MatPlotAreaLimit(n:double; const x,y:TArray1N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>0) and (nn<=x.size1) and (nn<=y.size1) then
         addQueue(TMatPlotArea1N.create(nn, x,y))
      else
         SetException(6402)
end;


procedure MatPlotAreaLimit(n:double; const m:TArray2N);overload;
var
   nn:NativeInt;
begin
   nn:=SysIntRound(n);
   if (nn>0) and (nn<=m.size1)  then
         addQueue(TMatPlotArea2N.create(nn, m))
      else
         SetException(6402)
end;


{**************}
{MAT PLOT CELLS}
{**************}
 type TPixelData=array[0..3]of byte;
     PPixeldata=^TPixelData;
procedure MatCells(p:TArray2N; const x1,y1,x2,y2:double; GRAPHst:boolean; var f:boolean);
var
   a,b:integer;
   i,j:NativeInt;
   color:TColor;
   x,y,w,h:double;
   xx,yy,dx,dy:double;
   RowPtr:PByte;
   PixelPtr:PPixelData;
   Points:array[1..4]of TPoint;
   a1,b1,a2,b2,a3,b3,a4,b4:double;
   RawImage:TRawImage;
   BytePerPixel: Integer;
   red,green,blue:byte;
   redix,greenix,blueix:byte;
   PixFormat:TPixelFormat;
   svDrawMode:boolean;
   PaletteDisabled:boolean;
begin
   if p.size=0 then exit;

   f:=false;
   if (MyGraphSys is TScreenBMPGraphSys)
     and ((CurrentTransform=nil)
       or CurrentTransform.IsAffine and (abs(CurrentTransform.det)>1/1024)) then
     begin
         PaletteDisabled:=MyPalette.PaletteDisabled;
         svDrawMode:=GraphSys.HiddenDrawMode;
         MyGraphSys.SetHiddenDrawMode(true);

          x:=MyGraphSys.virtualX(0);
          y:=MyGraphSys.virtualY(0);
         dx:=MyGraphSys.virtualX(1);
         dy:=MyGraphSys.virtualY(1);
         if not GRAPHst then
            begin
              currenttransform.invtransform(x,y);
              currenttransform.invtransform(dx,dy);
            end;
         dx:=dx-x;
         dy:=y-dy;

         if (x2-x1)*dx<0 then
             dx:=-dx;
         if (y2-y1)*dy<0 then
             dy:=-dy;
         w:=p.size1/(x2-x1+dx);
         h:=p.size2/(y2-y1+dy);

         //EnterCriticalSection(PixelCriticalSection);
         with TScreenBMPGraphSys(MyGraphSys) do
           begin
             repeat until bitmap1.Canvas.tryLock;
             PixFormat:=Bitmap1.PixelFormat;
             if (PixFormat=pf24bit) and (bitmap1.Canvas.Pen.Mode=pmCopy) then
               begin
                   Bitmap1.BeginUpdate(false);
                   RawImage := Bitmap1.RawImage;
                   BytePerPixel := RawImage.Description.BitsPerPixel div 8;
                   case pixformat of
                      pf24bit:
                        with RawImage.Description do
                        begin
                            redix:=redshift div 8;
                            greenix:=greenshift div 8;
                            blueix:=blueshift div 8;
                            if ByteOrder=riboMSBFirst then
                               begin
                                 RedIx:=BytePerPixel-1-RedIx;
                                 GreenIx:=BytePerPixel-1-GreenIx;
                                 BlueIx:=BytePerPixel-1-BlueIx;
                               end;
                         end;
                   end;
                   RowPtr:=PByte(RawImage.Data);
                   for b:=0 to Bitmap1.Height-1 do
                     begin
                       PixelPtr:=PPixelData(RowPtr);
                       y:=virtualY(b);
                       yy:=y;
                       for a:=0 to Bitmap1.Width-1 do
                          begin
                             if (a>=ClipRect.Left) and (a<=ClipRect.Right)
                             and (b>=ClipRect.top) and (b<=ClipRect.Bottom) then
                                begin
                                    x:=virtualX(a);
                                    y:=yy;
                                    if not GRAPHst then
                                        currenttransform.invtransform(x,y);
                                    i:=math.floor(w*(x-x1)+1e-9 {計算誤差の補償});
                                    j:=math.floor(h*(y-y1)+1e-9 {計算誤差の補償});
                                    if  (i>=0) and (i<p.size1) and (j>=0) and (j<p.size2) then
                                       begin
                                         with p do color:=LongIntRound(elements^[i*size2+j]);
                                         if (color>=0) and ((color<=maxcolor) or PaletteDisabled) then
                                           begin
                                              if not PaletteDisabled then
                                                 color:=MyPalette[color];
                                              red:=byte(color);
                                              color:=color shr 8;
                                              green:=byte(color);
                                              color:=color shr 8;
                                              blue:=byte(color);
                                              PixelPtr^[redix]:=red;
                                              PixelPtr^[greenIx]:=green;
                                              PixelPtr^[BlueIx]:=Blue;
                                            end
                                         else
                                            f:=true;
                                       end;
                                  end;
                             inc(PByte(PixelPtr),BytePerPixel);
                          end;
                       Inc(RowPtr, RawImage.Description.BytesPerLine);
                     end;
                     Bitmap1.EndUpdate(False);
               end
           else
                begin
                     //Bitmap1.BeginUpdate(true);
                     for b:=ClipRect.top to Cliprect.Bottom do
                       begin
                         y:=virtualY(b);
                         yy:=y;
                         for a:=ClipRect.Left to Cliprect.Right do
                            begin
                                 x:=virtualX(a);
                                 y:=yy;
                                 if not GRAPHst then
                                    currenttransform.invtransform(x,y);
                                 i:=math.floor(w*(x-x1)+1e-9 {計算誤差の補償});
                                 j:=math.floor(h*(y-y1)+1e-9 {計算誤差の補償});

                                 if  (i>=0) and (i<p.size1) and (j>=0) and (j<p.size2) then
                                       begin
                                         with p do color:=LongIntRound(elements^[i*size2+j]);
                                         if (color>=0) and ((color<=maxcolor) or PaletteDisabled) then
                                           begin
                                             if not PaletteDisabled then
                                                 color:=MyPalette[color] ;
                                              bitmap1.canvas.pixels[a,b]:=color;
                                           end
                                         else
                                            f:=true;
                                       end;
                             end;
                       end;
                       //Bitmap1.EndUpdate(true);

                end  ;
                bitmap1.Canvas.Unlock;
           end;
          //LeaveCriticalSection(PixelCriticalSection);
        MyGraphSys.setHiddenDrawMode(SvDrawMode);
     end

   else if (CurrentTransform<>nil) and (abs(CurrentTransform.det)>1/1024) and
        ((MyGraphSys is TScreenBMPGraphSys) or
                                     not   (NormalSegment(x1,y1,x1,y2)
                                        and NormalSegment(x1,y2,x2,y2)
                                        and NormalSegment(x2,y2,x2,y1)
                                        and NormalSegment(x2,y1,x1,y1))) then
     begin
       w:=(p.size1-0.0001)/(x2-x1);
       h:=(p.size2-0.0001)/(y2-y1);

       with MyGraphSys do
         for b:=ClipRect.top to Cliprect.Bottom do
           begin
             yy:=virtualY(b);
             for a:=ClipRect.Left to Cliprect.Right do
                begin
                   x:=virtualX(a);
                   y:=yy;
                   if currenttransform.invtransform(x,y) then
                     try
                       i:=math.floor(w*(x-x1)+1e-9 {計算誤差の補償});
                       j:=math.floor(h*(y-y1)+1e-9 {計算誤差の補償});
                       if  (i>=0) and (i<p.size1) and (j>=0) and (j<p.size2) then
                         begin
                           with p do color:=LongIntRound(elements^[i*size2+j]);
                           if not ((color>=0) and (color<=maxcolor) or PaletteDisabled) then f:=true;
                           PutColor(a,b,color);
                         end;
                     except
                     end;
                end;
           end;
     end
   else
     begin
       w:=(x2-x1)/p.size1;
       h:=(y2-y1)/p.size2;
       x:=x1;
       y:=y1;
       for i:=0 to p.size1-1 do
        begin
          for j:=0 to p.size2-1 do
           begin
             with p do color:=LongIntRound(elements^[i*size2+j]);
             if not ((color>=0) and (color<=maxcolor) or PaletteDisabled) then f:=true;
             x:=x1+w*i; xx:=x+w;
             y:=y1+h*j; yy:=y+h;
             a1:=x; b1:=y;
             a2:=xx;b2:=y;
             a3:=xx;b3:=yy;
             a4:=x; b4:=yy;
             if GRAPHst or
                currenttransform.transform(a1,b1) and
                currenttransform.transform(a2,b2) and
                currenttransform.transform(a3,b3) and
                currenttransform.transform(a4,b4) then
               begin
                 with MyGraphSys do
                 begin
                   Points[1].x:=DeviceX(a1);  Points[1].y:=DeviceY(b1);
                   Points[2].x:=DeviceX(a2);  Points[2].y:=DeviceY(b2);
                   Points[3].x:=DeviceX(a3);  Points[3].y:=DeviceY(b3);
                   Points[4].x:=DeviceX(a4);  Points[4].y:=DeviceY(b4);
                 end;
                 MyGraphsys.ColorPolygon( Points, color);
               end;
           end;
         end;
     end;
end;

Type
    TMatPlotCells=class(TGraphCommand)
      p:TArray2N;
      x1,y1,x2,y2:double;
      Graphst:boolean;
      pf:PBoolean;
      constructor create(const p0:TArray2N; const x10,y10,x20,y20:double;
                                          Graphst0:boolean;var f:boolean);
      procedure execute;override;
      destructor destroy;override;
    end;

constructor TMatPlotCells.create(const p0:TArray2N; const x10,y10,x20,y20:double;
                                          Graphst0:boolean;var f:boolean);
begin
  inherited create;
  p:=TArray2N.createCopy(p0);
  x1:=x10;
  x2:=x20;
  y1:=y10;
  y2:=y20;
  Graphst:=Graphst0;
  pf:=@f; ;
end;

procedure TMatPlotCells.execute;
begin
  MatCells(p,x1,y1,x2,y2,Graphst,pf^);
  RepaintRequest:=true;
end;

destructor TMatPlotCells.destroy;
begin
  p.free;
  inherited destroy;
end;

procedure MatPlotCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);
var
    f:boolean;
begin
   f:=false;
   addQueue( TMatPlotCells.create(p,x1,y1,x2,y2,false,f));
   //if insideofwhen and f then setexception(11085);
   if f then
     REportException(insideofwhen,11085,'MAT PLOT CELLS');
   waitready;
end;

procedure MatGraphCells(const p:TArray2N; const x1,y1,x2,y2:double; insideofWhen:boolean);
var
    f:boolean;
begin
   f:=false;
   addQueue( TMatPlotCells.create(p,x1,y1,x2,y2,true,f));
   //if insideofwhen and f then setexception(11085);
   if f then
     ReportException(insideofwhen, 11085, 'MAT GRAPH CELLS');
   waitready;
end;






{************}
{GET & LOCATE}
{************}
Type
    TGetPoint=class(TReSetBoolean)
       px,py:PDouble;
       NoBeamOff:boolean;
       Locatest:boolean;
       constructor create(var b:boolean; var x,y:Double; NoBeamOff0:boolean; Locatest0:boolean);
       procedure execute;override;
    end;

constructor TGetPoint.create(var b:boolean; var x,y:Double; NoBeamOff0:boolean; Locatest0:boolean);
begin
  inherited create(b);
  px:=@x;
  py:=@y;
  NoBeamOff:=NoBeamOff0;
  Locatest:=Locatest0;
end;

type
    TPointAt=Class(TGraphCommand)
      x,y:Double;
      Locatest:boolean;
      constructor create(x0,y0:Double; Locatest0:boolean);
      procedure execute;override;
    end;

constructor TPointAt.create(x0,y0:Double; Locatest0:boolean);
begin
  inherited create;
  x:=x0;
  y:=y0;
  Locatest:=Locatest0;
end;

procedure TPointAt.execute;
var
  vx,vy:integer;
begin
   if LocateSt or CurrentTransform.transform(x,y) then
     begin
      vx:=MyGraphSys.deviceX(x);
      vy:=MyGraphSys.deviceY(y);
      MyGraphSys.MoveMouse(vx,vy);
     end;
end;

procedure PointAt(x0,y0:Double; LocateSt:boolean);
begin
    addQueue(TPointAt.create(x0,y0,Locatest));
end;

procedure GetPointSub(var x,y:Double; NoBeamOff:boolean; LocateSt:boolean);
var
  vx,vy:integer;
begin
    with MyGraphSys do
      beam:=beam and ((BeamMode=bmImmortal) or NoBeamOff);
    MyGraphSys.getpoint(vx,vy);
    x:=MyGraphSys.virtualX(vx);
    y:=MyGraphSys.virtualY(vy);
    if LOCATEst or currenttransform.invtransform(x,y) then
      begin
      end
    else
      setexception(-3009)
end;

procedure TGetPoint.execute;
begin
   GetPointSub(px^,py^,NoBeamOff,Locatest);
   inherited execute;
end;

procedure GetPoint(var x,y:Double; NoBeamOff:boolean; Locatest:boolean);
var
  b:boolean;
begin
   b:=true;
   addQueue(TGetPoint.create(b,x,y,NoBeamOff,Locatest));
   while b do (TThread.CurrentThread).Yield  ;
end;

procedure MousePoll(var x,y,l,r:Double);
var
   vx,vy:integer;
   left,right:boolean;
begin
   WaitReady;
   MyGraphSys.MousePol(vx,vy,left,right);
   x:=MyGraphSys.virtualX(vx);
   y:=MyGraphSys.virtualY(vy);
   if currenttransform.invtransform(x,y) then
      begin
         l:=byte(left);
         r:=byte(right);
      end
   else
      setexception(-3009)
end;



Procedure LocateChoice( var x:Double);
begin
  LocateChoice(8,x)
end;

Procedure LocateChoice(n:Double; var x:Double);
begin
  if n=1 then n:=8;
  LocateChoice(n,0,x)
end;



type
    TLocateChoiceN=Class(TResetBoolean)
      n,i0:integer;
      x:PDouble;
     constructor create(n0,i00:integer; var x0:Double; var b:boolean);
     procedure execute;override;
    end;

constructor TLocateChoiceN.create(n0,i00:integer; var x0:Double; var b:boolean);
begin
  inherited create(b);
  n:=n0; i0:=i00;
  x:=@x0;
end;

procedure TLocateChoiceN.execute;
var
  i:integer;
begin
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
   with  LocateChoiceForm do
   begin
       dev0:=n;
       ini0:=i0;
       capts:=TStringList.create;
       for i:=1 to dev0 do
              Capts.Add(inttostr(i));
       execute;
       x^:=Choice;
       capts.free
   end;
   with MyGraphsys do
      if beamMode=bmRigorous then beam:=false;
   inherited execute;
end;

Procedure LocateChoice(n,i0:Double; var x:Double);
var
  b:boolean;
  dev0,ini0:integer;
begin
  dev0:=SysIntRound(n);
  ini0:=SysIntRound(i0);
  if (dev0>255) or (dev0<=0) then
      setexception(11140);
  b:=true;
  addQueue(TLocateChoiceN.create(dev0,ini0,x,b));
  while b do (TThread.CurrentThread).Yield  ;
end;

type
    TLocateChoiceS=Class(TResetBoolean)
      a:TArray1S;
      x:PDouble;
     constructor create(const a0:TArray1S;  var x0:Double; var b:boolean);
     procedure execute;override;
    end;

constructor TLocateChoiceS.create(const a0:TArray1S;  var x0:Double; var b:boolean);
begin
  inherited create(b);
  a:=a0;
  x:=@x0;
end;

procedure TLocateChoiceS.execute;
var
  i:integer;
begin
  with MyGraphsys do
     if beamMode=bmRigorous then beam:=false;
  with  LocateChoiceForm do
    begin
      ini0:=0;
      capts:=TStringList.create;
      with a do
              begin
                for i:=0 to size-1 do
                   capts.add(elements^[i]);
              end;
      execute;
      x^:=Choice;
      capts.free
    end;
  with MyGraphsys do
     if beamMode=bmRigorous then beam:=false;
  inherited execute;
end;

Procedure LocateChoice(const a:TArray1S; var x:Double);
var
  b:boolean;
begin
  if (a.Size1>255) or (a.Size1<=0) then
     setexception(11140);
  b:=true;
  addQueue(TLocateChoiceS.create(a,x,b));
  while b do (TThread.CurrentThread).Yield  ;
end;





type
    TLocateValue=class(TReSetBoolean)
      n:integer;
      vr,vi,nowait:boolean;
      left0,right0,ini0:double;
      Name0:Ansistring;
      r:PDouble;
      e:PInteger;
      constructor create(n0:integer; vr0,vi0,nowait0:boolean;
                           left00,right00,ini00:double;Name00:Ansistring;
                           var r0:double; var extype0:integer; var b:boolean);
      procedure execute;override;
    end;

constructor TLocateValue.create(n0:integer; vr0,vi0,nowait0:boolean;
                         left00,right00,ini00:double;Name00:Ansistring;
                         var r0:double; var extype0:integer; var b:boolean);
begin
  inherited create(b);
  n:=n0;
  vr:=vr0; vi:=vi0;
  nowait:=nowait0;
  left0:=left00; right0:=right00; ini0:=ini00;
  Name0:=Name00;
  r:=@r0;
  e:=@extype0;
end;

procedure TLocateValue.execute;
begin
  r^:=LocateForm.Value(n,vr,vi,nowait,left0,right0,ini0,name0,e^);
  inherited execute;
end;

function LocateValueSub(n:integer; vr,vi,nowait:boolean;
                         left0,right0,ini0:double;Name0:Ansistring):double;
var
  b:boolean;
  extype0:integer;
begin
  extype0:=0;
  b:=true;
  addQueue(TLocateValue.create(n,vr,vi,nowait,left0,right0,ini0,Name0,result,extype0,b));
  while b do (TThread.CurrentThread).Yield;
  if extype0<>0 then setexception(extype0);
end;

function LocateValue(n:Double;  name0:ansistring):double;overload;
begin
   result:=LocateValueSub(SysIntRound(n),false,false,false,0,1,0.5,name0);
end;

function LocateValue(n:Double; left0,right0:double;  name0:ansistring):double;overload;
begin
   result:=LocateValueSub(SysIntRound(n),true,false,false,left0,right0,0.5,name0);
end;

function LocateValue(n:Double; left0,right0,ini0:double; name0:ansistring):double;overload;
begin
  result:=LocateValueSub(SysIntRound(n),true,true,false,left0,right0,ini0,name0);
end;

function LocateValue(n:Double; ini0:double; name0:ansistring):double;overload;
begin
  result:=LocateValueSub( SysIntRound(n), false,true,false,0,0,ini0,name0);
end;

function LocateValueNowait(n:Double;  name0:ansistring):double;overload;
begin
   result:=LocateValueSub(SysIntRound(n),false,false,true,0,0,0,name0);
end;

function LocateValueNowait(n:Double; left0,right0:double;  name0:ansistring):double;overload;
begin
  result:=LocateValueSub( SysIntRound(n), true,false,true,left0,right0,0,name0);
end;

function LocateValueNowait(n:Double; left0,right0,ini0:double;  name0:ansistring):double;overload;
begin
  result:=LocateValueSub(SysIntRound(n),true,true,true,left0,right0,ini0,name0);
end;

function LocateValueNowait(n:Double; ini0:double;  name0:ansistring):double;overload;
begin
  result:=LocateValueSub(SysIntRound(n),false,true,false,0,0,ini0,name0);
end;

procedure MatGetPointVarilen(m:TArray2N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:NativeInt;
   x,y:double;
   i:NativeInt;
   left,right:boolean;
begin
  MyGraphsys.beam:=false;
       vx0:=low(integer);
       vy0:=low(integer);

       maxlen:=m.MaxSize div 2;
       m.size2:=2;

       repeat
           sleep(10);
           MyGraphSys.MousePol(vx,vy,left,right)
       until left=false;
       repeat
           sleep(10);
           MyGraphSys.MousePol(vx,vy,left,right)
       until left=true;
       i:=0;
       while (i<maxlen) and (left=true) do
         begin
           if (vx<>vy0)or(vy<>vy0) then
             begin
               x:=MyGraphsys.virtualX(vx);
               y:=MyGraphsys.VirtualY(vy);
               if Locatest or CurrentTransform.InvTransform(x,y) then
                 with m do
                   begin
                     elements^[i*size2]:=x;
                     elements^[i*size2+1]:=y;
                   end
               else
                 setexception(-3009)  ;
             end;
           inc(i);
           sleep(20);
           MyGraphSys.MousePol(vx,vy,left,right)
         end;
       if i=maxlen then beep;

       m.size1:=i;
end;

procedure MatGetPointVarilen(m1,m2:TArray1N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:NativeInt;
   x,y:double;
   i:NativeInt;
   left,right:boolean;
begin
   MyGraphsys.beam:=false;
   vx0:=low(integer);
   vy0:=low(integer);

   maxlen:=min(m1.MaxSize,m2.MaxSize);

   repeat
       sleep(10);
       MyGraphSys.MousePol(vx,vy,left,right)
   until left=false;
   repeat
       sleep(10);
       MyGraphSys.MousePol(vx,vy,left,right)
   until left=true;

   i:=0;
   while (i<maxlen) and (left=true) do
     begin
       if (vx<>vy0)or(vy<>vy0) then
         begin
           x:=MyGraphsys.virtualX(vx);
           y:=MyGraphsys.VirtualY(vy);
           if Locatest or CurrentTransform.InvTransform(x,y) then
              begin
                 m1.elements^[i]:=x;
                 m2.elements^[i]:=y;
              end
           else
             setexception(-3009)  ;
         end;
       inc(i);
       sleep(20);
       MyGraphSys.MousePol(vx,vy,left,right)
     end;
   if i=maxlen then beep;

   m1.size1:=i;
   m2.size1:=i;
end;

procedure MatGetPoint(m1,m2:TArray1N; Locatest:boolean); overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:NativeInt;
   x,y:double;
   i:NativeInt;
   left,right:boolean;

begin
   maxlen:=m1.size1;
   if maxlen<>m2.size1 then  setexception(6401);

   MyGraphsys.beam:=false;

   for i:=0 to maxlen-1 do
     begin
        MyGraphsys.getpoint(vx,vy);
        x:=MyGraphsys.virtualX(vx);
        y:=MyGraphsys.VirtualY(vy);
        if Locatest or CurrentTransform.InvTransform(x,y) then
             begin
               m1.elements^[i]:=x;
               m2.elements^[i]:=y;
             end
        else
           setexception(-3009) ;
     end;
end;

procedure MatGetPoint(m:TArray2N; Locatest:boolean);overload;
var
   vx,vy,vx0,vy0:integer;
   maxlen:NativeInt;
   x,y:double;
   i:NativeInt;
   left,right:boolean;
begin
   if m.size2<2 then
       setexception(6401);
   maxlen:=m.size1;

   MyGraphsys.beam:=false;

   for i:=0 to maxlen-1 do
     begin
        MyGraphsys.getpoint(vx,vy);
        x:=MyGraphsys.virtualX(vx);
        y:=MyGraphsys.VirtualY(vy);
        if Locatest or CurrentTransform.InvTransform(x,y) then
           with m do
             begin
                elements^[i*size2]:=x;
                elements^[i*size2+1]:=y;
             end
        else
           setexception(-3009) ;
     end;
end;

{**************}
{ASK Statements}
{**************}
function ASkWindow(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=left;
      x2:=right;
      y1:=bottom;
      y2:=top;
    end;
end;

function ASkViewport(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=VPleft;
      x2:=VPright;
      y1:=VPbottom;
      y2:=VPtop;
    end;
end;

function ASkDeviceWindow(var x1,x2,y1,y2:double):integer;
begin
  result:=0;
  with MyGraphsys do
    begin
      x1:=DWleft;
      x2:=DWright;
      y1:=DWbottom;
      y2:=DWtop;
    end;
end;

function ASkDeviceViewport(var x1,x2,y1,y2:double):integer;
var
   l,r,b,t:double;
begin
  result:=0;
   MyGraphSys.AskDeviceViewPort(l,r,b,t);
   x1:=l;
   x2:=r;
   y1:=b;
   y2:=t;
end;


function AskPixelSize( var var1,var2:double):integer;overload;
begin
  result:=0;
  var1:=MyGraphSys.GWidth;
  var2:=MyGraphSys.GHeight
end;


function AskPixelSize(n1,n2,n3,n4:double; var var1,var2:double):integer;overload;
    {$IFDEF CPU386}
    function Floor(x:double):double; assembler;
    asm
        FLD x
        FLDCW RoundNins
        FRNDINT
        FLDCW ControlWord
    end;
    function Ceil(x:double):double; assembler;
    asm
        FLD x
        FLDCW RoundPlus
        FRNDINT
        FLDCW ControlWord
    end;
    {$ENDIF}

const eps=1e-14;
var
   t:double;
   x1,x2,y1,y2:double;
begin
    result:=0;
    with MyGraphSys do
    if (n1-n3)*(right-left)>0 then begin t:=n3; n3:=n1; n1:=t end;    //2011.11.6
    with MyGraphSys do
    if (n2-n4)*(top-bottom)<0 then begin t:=n4; n4:=n2; n2:=t end;    //2011.11.6

    x1:=ceil(MyGraphSys.DeviceX(n1)-eps);
    x2:=floor(MyGraphSys.DeviceX(n3)+eps);
    y1:=ceil(MyGraphSys.DeviceY(n2)-eps);
    y2:=floor(MyGraphSys.DeviceY(n4)+eps);
    var1:=x2-x1+1;
    var2:=y2-y1+1;
end;

{
function AskPixelSize( var var1,var2:integer):integer;overload;
var
   x1,x2:double;
begin
  result:=AskPixelsize(x1,x2);
  var1:=System.Round(x1);
  var2:=System.Round(x2);
end;
}

function AskPixelSize( var var1,var2:int64):integer;overload;
var
   x1,x2:double;
begin
  result:=AskPixelsize(x1,x2);
  var1:=System.Round(x1);
  var2:=System.Round(x2);
end;


function AskPixelSize(n1,n2,n3,n4:double; var var1,var2:int64):integer;overload;
var
   x1,x2:double;
begin
  result:=AskPixelsize(n1,n2,n3,n4,x1,x2);
  var1:=System.Round(x1);
  var2:=System.Round(x2);
end;

procedure WaitReady;
var
  b:boolean;
begin
    b:=true;
    addQueue(TReSetBoolean.create(b));
    while b do (TThread.CurrentThread).Yield  ;
end;

type
    TAskPixelValue=class(TReSetBoolean)
      x,y:double;
      v:PDouble;
    constructor create(x0,y0:double; var var1:double; var b:boolean);
    procedure execute;override;
  end;

constructor TAskPixelValue.create(x0,y0:double; var var1:double; var b:boolean);
begin
  inherited create(b);
  x:=x0; y:=y0;
  v:=@var1;
end;

procedure TAskPixelValue.execute;
begin
  v^:=MyGraphSys.ColorIndexOf(MyGraphSys.DeviceX(x),MyGraphSys.DeviceY(y));
  inherited execute;
end;

function AskPixelValue(x,y:double; var var1:double):integer;
var
  b:boolean;
begin
  b:=true;
  addQueue(TAskPixelValue.create(x,y,var1,b));
  while b do (TThread.CurrentThread).Yield  ;
  result:=0;
end;

type
   TAskPixelArray=class(TReSetBoolean)
     x,y:double;
     a:TArray2N;
     r:PBoolean;
   constructor create(x0,y0:double; a0:TArray2N; var b:boolean; var r0:boolean);
   procedure execute;override;
 end;

function AskPixelArraySub(x,y:double; a:Tarray2N):boolean;
var
   x1,y1:Integer;
   i,j:NativeInt;
   c:integer;
begin
       x1:=MyGraphSys.DeviceX(x);
       y1:=MyGraphSys.DeviceY(y);
       result:=true;
       if a<>nil then
          begin
             for i:=0 to a.size1-1 do
                 for j:=0 to a.size2-1 do
                     begin
                         c:=MyGraphSys.ColorIndexOf(x1+i,y1+j);
                         with a do elements^[i*size2+j]:=c;
                         if c=-1 then result:=false;
                     end;
          end;

end;

constructor TAskPixelArray.create(x0,y0:double; a0:TArray2N; var b:boolean; var r0:boolean);
begin
  inherited create(b);
  x:=x0; y:=y0;
  a:=a0;
  r:=@r0;
end;

procedure TAskPixelArray.execute;
begin
   r^:= AskPixelArraySub(x,y,a);
   inherited execute;
end;

function AskPixelArray(x,y:double; a:Tarray2N):integer; overload;
var
   b,r:boolean;
begin
  b:=true;
  addQueue(TAskPixelArray.create(x,y,a,b,r));
  while b do (TThread.CurrentThread).Yield  ;
  result:=0;
end;

function AskPixelArray(x,y:double; a:Tarray2N; s:TStrVar):integer; overload;
var
   b,r:boolean;
begin
  b:=true;
  addQueue(TAskPixelArray.create(x,y,a,b,r));
  while b do (TThread.CurrentThread).Yield  ;
  result:=0;
  if r then
      s.str:= 'ABSENT'
  else
      s.str:='PRESENT';
  s.free
end;

function getlinecolor(var x:double):integer;
begin
    WaitReady;
    result:=0;
    x:=MyGraphSys.linecolor;
end;

function getlinestyle(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=Integer(MyGraphSys.PenStyle) + 1;
end;

function getlinewidth(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.linewidth;
end;

function getpointcolor(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.pointcolor;
end;

function getpointstyle(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.pointstyle;
end;

function getareacolor(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.areacolor;
end;

function gettextcolor(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.textcolor;
end;

function getmaxcolor(var x:double):integer;
begin
  WaitReady;
    result:=0;
    if mypalette.PaletteDisabled then
      x:=$ffffff
    else
      x:=GraphSys.maxcolor;
end;

function getaxiscolor(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=GraphSys.axescolor;
end;

function getMaxPointDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxMultiPointDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxChoiceDevice(var x:double):integer;
begin
    result:=0;
    x:=1
end;

function getMaxValueDevice(var x:double):integer;
begin
    result:=0;
    x:=20
end;

function getAreaStyleIndex(var x:double):integer;
begin
  WaitReady;
    result:=0;
    x:=MyGraphSys.AreaStyleIndex;
end;

function getmaxlinestyle(var x:double):integer;
begin
    result:=0;
    x:=MaxLineStyle
end;

function getmaxpointstyle(var x:double):integer;
begin
    result:=0;
    x:=MaxPointStyle
end;

function ASkTextHeight(var x:double):integer;
begin
  WaitReady;
  result:=0;
  x:=MyGraphSys.AskTextHeight;
end;

function AskTextAngle(var x:double):integer;
begin
  WaitReady;
   result:=0;
   x:=MyGraphSys.TextAngle;
end;

function AskTextAngleRad(var x:double):integer;
begin
  WaitReady;
   result:=0;
   x:=MyGraphSys.TextAngle/180.0*PI;
end;


function AskDeviceSize(var x,y:double; t:TStrVar):integer;
var
   w,h:double;
   s:string;
begin
   result:=0;
   MyGraphSys.AskDeviceSize(w,h,s);
   x:=w;
   y:=h;
   t.str:=s;
   t.free;
end;

function AskBitmapSize(var x,y:double):integer;
begin
   WaitReady;
   result:=0;
     x:=MyGraphSys.GWidth;
     y:=MyGraphSys.GHeight;
end;

function AskTextJustify(h,v:TStrVar):integer;
begin
  WaitReady;
  result:=0;
  with MyGraphSys do
    begin
      h.str:=HJustification[HJustify];
      v.str:=VJustification[VJustify];
      h.free;
      v.free;
    end;
end;

function AskTextWidth(const s:string; var width:double):integer;   //21013.12.21
begin
  WaitReady;
   result:=0;
   with MyGraphSys do
     begin
       width:=VirtualX(textwidth(s))-VirtualX(0);
       if TextProblemCoordinate then
          width:=width *((VirtualY(0)-VirtualY(1))/(VirtualX(1)-VirtualX(0)));
     end;
end;

function AskTextFont(s:TStrVar;var x:double):integer;
var
   name:ansistring;
   n:integer;
begin
  WaitReady;
  result:=0;
  MyGraphSys.AskTextFont(name,n);
  s.str:=name;
  x:=n;
  s.free;
end;

procedure AskColorMixSub(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;

function AskColorMix(ColorIndex:double; var red,green,blue:double):integer;
var
   cc:TColor;
   r,g,b:byte;
begin
  WaitReady;
   result:=0;
     cc:=LongIntRound(ColorIndex);
     if (cc<0) or (cc>maxcolor) and not MyPalette.paletteDisabled then
       begin
          red:=0;
          green:=0;
          blue:=0;
          result:=11086;
       end
     else
       begin
         askColorMixSub(cc,r,g,b);
         red:=r/255;
         green:=g/255;
         blue:=b/255;
       end;
end;

function AskClip(svar:TStrvar):integer;
var
   s:string;
begin
  WaitReady;
   result:=0;
   if MyGraphSys.clip then s:='ON' else s:='OFF';
   svar.str:=s;
   svar.free;
end;

function AskAreaStyle(svar:TStrvar):integer;
var
   s:string;
begin
  WaitReady;
   result:=0;
    case MyGraphSys.AreaStyle of
      asSolid: s:='SOLID';
      asHollow:s:='HOLLOW';
      asHATCH: s:='HATCH';
    end;
    svar.str:=s;
    svar.free;
end;

function AskColorMode(svar:TStrvar):integer;
begin
  WaitReady;
   result:=0;
   svar.str:=MyGraphSys.AskColorMode;
   svar.free;
end;

function AskBeamMode(svar:TStrvar):integer;
begin
  WaitReady;
   result:=0;
   svar.str:=MyGraphSys.AskBeamMode;
   svar.free;
end;

function AskTextBack(svar:TStrvar):integer;
begin
  WaitReady;
   result:=0;
   if iBKmode=TRANSPARENT then svar.str:='TRANSPARENT'
   else if iBKmode=OPAQUE then svar.str:='OPAQUE';
   svar.free;
end;

type
  TFLOOD=class(TGraphPoint)
    procedure execute;override;
  end;
  TFLOODFILL=class(TGraphPoint)
     procedure execute;override;
 end;

procedure TFLOOD.execute;
var
    a,b:Integer;
begin
   if currenttransform.transform(x,y) then
     begin
       a:=MyGraphSys.deviceX(x);
       b:=MyGraphSys.deviceY(y);
       MyGraphSys.FLOOD(a,b);
     end;
   RepaintRequest:=true;
  end;

procedure TFLOODFill.execute;
var
  a,b:Integer;
begin
  if currenttransform.transform(x,y) then
    begin
     a:=MyGraphSys.deviceX(x);
     b:=MyGraphSys.deviceY(y);
     MyGraphSys.FLOODFill(a,b);
    end;
  RepaintRequest:=true;
end;

procedure FLOOD( x,y:double);
begin
  addQueue(TFLOOD.create(x,y))
end;

procedure FLOODFill( x,y:double);
begin
  addQueue(TFLOODFill.create(x,y))
end;


{***********}
{Grid & Axes}
{***********}
type
  TDrawAxes0=Class(TGraphPoint)
    procedure execute;override;
  end;
procedure TDrawAxes0.execute;
begin
   gridaxes.drawaxes0(x,y);
   RepaintRequest:=true;
end;
procedure drawaxes0(x,y:double);
begin
   addQueue(TDrawAxes0.create(x,y))
end;


type
  TDrawGrid0=Class(TGraphPoint)
    procedure execute;override;
  end;
procedure TDrawGrid0.execute;
begin
   gridaxes.drawGrid0(x,y);
   RepaintRequest:=true;
end;
procedure drawgrid0(x,y:double);
begin
  addQueue(TDrawGrid0.create(x,y))
end;

type
  TDrawAxes2=Class(TGraphPoint)
    procedure execute;override;
  end;

procedure TDrawAxes2.execute;
begin
   gridaxes.drawaxes2(x,y);
   RepaintRequest:=true;
end;
procedure drawaxes2(x,y:double);
begin
  addQueue(TDrawAxes2.create(x,y))
end;

type
  TDrawGrid2=Class(TGraphPoint)
    procedure execute;override;
  end;
procedure TDrawGrid2.execute;
begin
   gridaxes.drawGrid2(x,y);
   RepaintRequest:=true;
end;
procedure drawgrid2(x,y:double);
begin
    addQueue(TDrawGrid2.create(x,y))
end;

type
  TDrawCircle=Class(TGraphPoint)
    procedure execute;override;
  end;
procedure TDrawCircle.execute;
begin
   gridaxes.drawCircle(x,y);
   RepaintRequest:=true;
end;
procedure drawcircle(x,y:double);
begin
  addQueue(TDrawCircle.create(x,y))
end;

type
  TDrawDisk=Class(TGraphPoint)
    procedure execute;override;
  end;
procedure TDrawDisk.execute;
begin
   gridaxes.drawDisk(x,y);
   RepaintRequest:=true;
end;
procedure drawDisk(x,y:double);
begin
  addQueue(TDrawDisk.create(x,y))
end;

{*****}
{GSAVE}
{*****}
type
  TGLoad=class(TGraphCommand)
    fname:string;
    extype0:PInteger;
    constructor create(fname0:string; var extype1:integer);
    procedure execute;override;
  end;
constructor TGload.create(fname0:string; var extype1:integer);
begin
  inherited create;
  fname:=fname0;
  extype0:=@extype1;
end;

procedure TGload.execute;
begin
  extype0^:=0;
  try
    if MyGraphSys.OpenFile(FName)then
    else
       extype0^:=9005
  except
    on E:EExtype do
       extype0^:=E.extype
    else
       extype0^:=9051
  end;
  RepaintRequest:=true;
end;

procedure GLOAD(const fname:string);
var
  extype0:integer;
begin
  extype0:=0;
   addQueue(TGload.create(fname,extype0));
   WaitReady;
   if extype0<>0 then setexception(extype0)
end;

type
  TGSave=class(TGLoad)
    procedure execute;override;
  end;

Procedure TGSave.execute;
begin
  extype0^:=0;
  try
      MyGraphSys.SaveFile(fname)    // pf shall be ignored.
  except
      On E:EExtype do
         extype0^:=E.Extype
      else
         extype0^:=9052
  end;
  if extype0^<>0 then
     if MessageDlg('SAVEFILE('+fname+') failed.',
                   mtError,mbOKCancel,0)=mrOk then
        CtrlBreakHit:=true;
end;


Procedure GSAVE(const fname,pf:string);
var
  extype0:integer;
begin
  extype0:=0;
  addQueue(TGSave.create(fname,extype0));
  WaitReady;
  if extype0<>0 then setexception(extype0)
end;

{****}
{Draw}
{****}
{Transform}
type
  TPushTransform=class(TGraphCommand)
    procedure execute;override;
  end;

procedure TPushTransform.execute;
begin
   with TAffine.create do push
end;

procedure PushTransform;
begin
   addQueue(TPushTransform.create)
end;

type
  Tmlt=class(TGraphCommand)
    a:TArray2N;
    constructor create(a0:TArray2N);
    procedure execute;override;
    destructor destroy;override;
  end;
constructor Tmlt.create(a0:TArray2N);
begin
  inherited create;
  a:=a0.NewCopy;
end;
procedure Tmlt.execute;
begin
   currenttransform.mlt(a);
end;
destructor TMlt.destroy;
begin
  a.free;
  inherited destroy;
end;

procedure mlt(a:TArray2N);
begin
  addQueue(Tmlt.create(a))
end;

type
  TShift=Class(TGraphCommand)
    x,y:double;
    constructor create(x0,y0:double);
    procedure execute;override;
  end;
constructor TShift.create(x0,y0:double);
begin
  inherited create;
  x:=x0;
  y:=y0
end;

procedure TShift.execute;
begin
    currenttransform.shift(x,y);
end;

procedure shift(x,y:double);
begin
   addQueue(TShift.create(x,y) )
end;

type
  TScale=Class(TShift)
    procedure execute;override;
  end;
procedure TScale.execute;
begin
    currenttransform.scale(x,y);
end;
procedure scale(x,y:double);
begin
   addQueue(TScale.create(x,y) )
end;

type
  TRotate2=Class(TShift)
    procedure execute;override;
  end;

procedure TRotate2.execute;
begin
    currenttransform.rotate2(x,y);
end;
procedure rotate2(x,y:double);
begin
   addQueue(TRotate2.create(x,y) )
end;

type
  TScale1=Class(TGraphCommand)
    x:double;
    constructor create(x0:double);
    procedure execute;override;
  end;
constructor TScale1.create(x0:double);
begin
  inherited create;
  x:=x0;
end;

procedure TScale1.execute;
begin
    currenttransform.scale1(x);
end;
procedure scale1(x:double);
begin
  addQueue(TScale1.create(x))
end;
type
  TRotate=Class(TScale1)
    procedure execute;override;
  end;
procedure TRotate.execute;
begin
    currenttransform.rotate(x)
end;
procedure rotate(x:double);
begin
  addQueue(TRotate.create(x))
end;

type
  TShear=Class(TScale1)
    procedure execute;override;
  end;
procedure TShear.execute;
begin
    currenttransform.shear(x)
end;
procedure shear(x:double);
begin
  addQueue(TShear.create(x))
end;

type
  Tmlt_next=class(TGraphCommand)
    procedure execute;override;
  end;
procedure Tmlt_next.execute;
begin
    with currenttransform do
     if next<>nil then mlt(next)
end;
procedure mlt_next;
begin
   addQueue(Tmlt_next.create);
end;

type
  TPopTransform=class(TGraphCommand)
    procedure execute;override;
  end;
procedure TPopTransform.execute;
begin
   pop
end;
procedure PopTransform;
begin
    addQueue(TPopTransform.create)
end;

type
  TBeamManage=class(TGraphCommand)
    procedure execute;override;
  end;
procedure TBeamManage.execute;
begin
    MyGraphSys.beam:=MyGraphSys.beam and (MyGraphSys.BeamMode=bmImmortal);
end;
procedure BeamManage;
begin
  addQueue(TBeamManage.create)
end;





initialization

finalization

end.
