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; insideofwhen:boolean);  overload;
procedure GraphText(x,y:double; const s:string);                           overload;
procedure GraphTextUsing(x,y:double; const form:string; a:array of const; insideofwhen:boolean); overload;
procedure PlotLabel(x,y:double; const s:string);                           overload;
procedure PlotLabelUsing(x,y:double; const form:string; a:array of const; insideofwhen:boolean); overload;
procedure GraphLabel(x,y:double; const s:string);                          overload;
procedure GraphLabelUsing(x,y:double; const form:string; a:array of const; insideofwhen:boolean); overload;
procedure PlotLetters(x,y:double; const s:string);                          overload;
procedure PlotLettersUsing(x,y:double; const form:string; a:array of const; insideofwhen:boolean); 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(x,y: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: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;



{*************}
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;


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 or not JISSetWindow,ercodeColor,'SET POINT COLOR');
 MyGraphSys.PointColor:=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 or not JISSetWindow,ercodeColor,'SET LINE COLOR');
 MyGraphSys.SetLineColor(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 or not JISSetWindow,ercodeColor,'SET AREA COLOR');
 MyGraphSys.areaColor:=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 or not JISSetWindow,ercodeColor,'SET TEXT COLOR');
 MyGraphSys.textcolor:=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 or not JISSetWindow,ercodeColor,'SET COLOR');
 MyGraphSys.PointColor:=c;
 MyGraphSys.SetLineColor(c);
 MyGraphSys.areaColor:=c;
 MyGraphSys.textcolor:=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 or not JISSetWindow, 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
            MyGraphSys.PointColor:=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
             SetLineColor(c,InsideOfWhen);
     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
           MyGraphSys.AreaColor:=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
             settextcolor(c,InsideofWhen);
     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
            SetAllColor(c,InsideOfWhen);
     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 or not JISSetWindow ,11051, 'SET statement with width zero, or height zero');
         end
      else
         result:=true;
end;

procedure SetWindow(l,r,b,t:double; insideofWhen:boolean);
begin
  if CoordinateTest(l,r,b,t,insideofwhen)then
     MyGraphSys.setWindow(l,r,b,t);
end;



function TestInterval(const l,r,b,t:double):boolean;
begin
   result:=(0<=l) and (r<=1) and (0<=b) and (t<=1)
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
        MyGraphSys.SetViewport(l,r,b,t)
     else //if InsideOfWhen or not JISSetWindow then
          //    setexception(11052);
       ReportException(insideofwhen  or not JISSetWindow ,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  or not JISSetWindow ,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  or not JISSetWindow ,11054,'SET DEVICE VIEWPORT');

end;



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

constructor tClear.create;
begin
  inherited create;
end;

procedure TClear.execute;
begin
  if GraphBase<>nil then GraphBase.clear;
  RepaintRequest:=true;
end;

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

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

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

procedure SetColorMixSub(c:byte;r,g,b:byte);
var
   col:TColor;
begin
  col:=r+g*DWord($100)+b*DWord($10000) ;
  with MyGraphSys do
    begin
       MyPalette[c]:=col ;
       setlinecolor(linecolor);
       settextcolor(textcolor);
    end;
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  or not JISSetWindow ,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  or not JISSetWindow ,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;




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

end;

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

constructor TSetStyle.create(c0:LongInt);
begin
  inherited create;
  c:=c0;
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;
    MyGraphSys.SetLineStyle(s)
  end
  else
    //if insideofwhen  or not JISSetWindow then
    //         setexception(11062)
    ReportException(insideofwhen  or not JISSetWindow ,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  or not JISSetWindow ,11000,'SET AREA STYLE INDEX');

end;

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


procedure setLineWidth(x:double; InsideOfWhen:boolean);
var
   c:LongInt;
begin
   c:=system.Round(x);
   if c>0 then
      MyGraphSys.setlinewidth(c)
   else //if insideofwhen then
        //{setexception(数値未定)};
        ReportException(insideofwhen  or not JISSetWindow ,11000,'SET LINE WIDTH');
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 );
   MyGraphSys.textangle:=a;
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);
   MyGraphSys.SetAreaStyle(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
        MyGraphSys.Hjustify:=tjHorizontal(longint(h))
     else //if insideofwhen or not JISSetWindow then
          //setexception(4102) ;
       ReportException(insideofwhen  or not JISSetWindow ,4102,'SET TEXT JUSTIFY');

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


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

type
  TSetTextBack=class(TGraphCommand)
    BKMode:integer;
    constructor create(bk0:integer);
    procedure execute;override;
  end;

constructor TSetTextBack.create(bk0:integer);
begin
  inherited create;
  BKmode:=bk0
end;

procedure TSetTextBack.execute;
begin
    GraphBase.SetTextBack(BKMode);
end;

procedure SetTextBackGround(const s:string);
var
  BKmode:integer;
begin
   if UpperCase(s)='TRANSPARENT' then BKmode:=TRANSPARENT
   else if UpperCase(s)='OPAQUE' then BKmode:=OPAQUE
   else setexception(11000);
   addQueue(TSetTextBack.create(BKmode));
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':  GraphBase.setHiddenDrawMode(false);
   'H':  GraphBase.setHiddenDrawMode(true) ;
   'N':  GraphBase.setRasterMode(pmNotXor) ;
   'O':  GraphBase.setRasterMode(pmCopy)   ;
   'A':  GraphBase.setRasterMode(pmMask)   ;
   'M':  GraphBase.setRasterMode(pmMerge) ;
   'X':  GraphBase.setRasterMode(pmXor) ;
   end;
end;

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





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



procedure SetBitmapSize(x,y:double);
begin
    MyGraphSys.SetBitmapSize(LongIntRound(x),LongIntRound(y));
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;



procedure GraphPoints(const a: array of double);
var
   i:integer;
  // p:PPointArray;
   x,y:double;
begin
   //GetMem(p,sizeof(double)*Length(a));
   //try
      for i:=0 to High(a) div 2 do
          begin
            x:=a[2*i];
            y:=a[2*i+1];
            MyGraphSys.putMark(x,y);
          end;
   //finally
        //FreeMem(p, sizeof(double)*Length(a));
   //end;
end;


procedure PlotPoints(const a: array of double);
var
   i:integer;
   //p:PPointArray;
   x,y:double;
begin
   with MyGraphSys do
     if BeamMode=bmRigorous then beam:=false;

   //GetMem(p,sizeof(double)*Length(a));
   //try
      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.putMark(x,y);
          end;
   //finally
        //FreeMem(p, sizeof(double)*Length(a));
   //end;

end;

procedure GraphColorPoints(const a:array of double; c:double);
begin
  SetPointColor(c,false);
  GraphPoints(a);
end;

procedure PlotColorPoints(const a:array of double; c:double);
begin
  SetPointColor(c,false);
  PlotPoints(a);
end;

procedure GraphLines(const a: array of double);
var
   i:integer;
   //p:PPointArray;
   x,y:double;
begin
   MyGraphSys.beam:=false;
   //GetMem(p,sizeof(double)*Length(a));
   //try
        for i:=0 to High(a) div 2 do
           begin
             x:=a[2*i];
             y:=a[2*i+1];
             MyGraphSys.PlotTo(x,y);
           end;
    //finally
        //FreeMem(p, sizeof(double)*Length(a));
   //end;
  MyGraphSys.beam:=false;

end;

procedure PlotLines(const a: array of double);
var
   i:integer;
   //p:PPointArray;
   x,y:double;
begin
   //GetMem(p,sizeof(double)*Length(a));
   //try
      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;
    //finally
        //FreeMem(p, sizeof(double)*Length(a));
   //end;

end;


procedure PlotLinesBeamOff(const a: array of double);
begin
   PlotLines(a); BeamOff;
end;



procedure BeamOff;
begin
   MyGraphSys.beam:=false;
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;

type
 TPutPixel=Class(TGraphCommand)
    a,b:integer;
    c:TColor;
   constructor create( a0,b0:integer; c0:TColor);
   procedure execute;override;
 end;

constructor TPutPixel.create(a0,b0:integer; c0:TColor);
begin
  inherited create;
  a:=a0; b:=b0; c:=c0
end;

procedure TPutPixel.execute;
begin
  with GraphBase do PutPixel(a,b,c);
  RepaintRequest:=true;
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 with GraphBase 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);
                         addQueue(TPutPixel.create(a,b,MyPalette[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 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;

procedure PlotArea(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 GraphArea(const a: array of double);
var
   i:integer;
   p:PPointArray;
   x,y:double;
begin
   BeamOff;
   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;

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

procedure GraphText(x,y:double; const s:string);
begin
   MyGraphSys.beam:=false;
   MyGraphSys.PutText(x,y,s);

end;

procedure PlotText(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotText(x,y,s);

end;

function TextUsing(const form:string; a:array of const; insideofwhen:boolean):String;
var
  i,code,c:integer;
  s:string;
  //t: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);
        if code<>0 then
           REportException(insideofwhen,code);
      end;
    result:=s;
end;

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

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

procedure GraphLabel(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   MyGraphSys.PutText(x,y,s);

end;

procedure PlotLabel(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
       MyGraphSys.PutText(x,y,s);

end;

procedure PlotLetters(x,y:double; const s:string);
begin
   with MyGraphSys do
      if BeamMode=bmRigorous then beam:=false;
   if currenttransform.transform(x,y) then
      MyGraphSys.PlotLetters(x,y,s);

end;

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

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


procedure PlotLettersUsing(x,y:double; const form:string; a:array of const; insideofwhen:boolean);
begin
   PlotLetters(x,y,TextUsing(form,a,insideofwhen));
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
   BeamOff;
   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
   BeamOff;
   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;
      PlotArea(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);
   PlotArea(slice(m.elements^,n*2))
end;


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

procedure MatPlotPoints(const m:TArray2N);overload;
begin
    MatPlotPointsSub(m.Size1, m)
end;

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

procedure MatPlotLines(const m:TArray2N);overload;
begin
   MatPlotLinesSub(m.size1, m)
end;

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


procedure MatPlotArea(const m:TArray2N);overload;
begin
   MatPlotAreaSub(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
         MatPlotPointsSub(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
         MatPlotPointsSub(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
         MatPlotLinesSub(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
         MatPlotLinesSub(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
         MatPlotAreaSub(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
         MatPlotAreaSub(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
   f:=false;
   PaletteDisabled:=MyPalette.PaletteDisabled;  //2023.09.17

   if p.size=0 then exit;

   if (MyGraphSys is TScreenBMPGraphSys)
     and ((CurrentTransform=nil)
       or CurrentTransform.IsAffine and (abs(CurrentTransform.det)>1/1024)) then
     begin
         //PaletteDisabled:=MyPalette.PaletteDisabled;
         svDrawMode:=GraphSys.HiddenDrawMode;
         GraphBase.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  with GraphBase 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);
        GraphBase.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  with GraphBase 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}
{************}

procedure PointAt(x,y:Double; LocateSt:boolean);
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 GetPoint(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
    else
      setexception(-3009)
end;

procedure MousePoll(var x,y,l,r:Double);
var
   vx,vy:integer;
   left,right:boolean;
begin
   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);
     procedure execute;override;
    end;

constructor TLocateChoiceN.create(n0,i00:integer; var x0:Double);
begin
  inherited create;
  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
  dev0,ini0:integer;
begin
  dev0:=SysIntRound(n);
  ini0:=SysIntRound(i0);
  if (dev0>255) or (dev0<=0) then
      setexception(11140);
  addQueueWait(TLocateChoiceN.create(dev0,ini0,x));
end;

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

constructor TLocateChoiceS.create( const a0:TArray1S;  var x0:Double);
begin
  inherited create;
  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);
  addQueueWait(TLocateChoiceS.create(a,x));
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);
      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);
begin
  inherited create;
  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
  extype0:integer;
begin
  extype0:=0;
  addQueueWait(TLocateValue.create(n,vr,vi,nowait,left0,right0,ini0,Name0,result,extype0));
  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 GraphBase 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 GraphBase 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
  WaitReady;
  result:=0;
  var1:=GraphBase.GWidth;
  var2:=GraphBase.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: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;


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

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

procedure TAskPixelValue.execute;
begin
  v^:=GraphBase.ColorIndexOf(x,y);
  //inherited execute;
end;

function AskPixelValue(x,y:double; var var1:double):integer;
begin
  addQueueWait(TAskPixelValue.create(MyGraphSys.DeviceX(x),MyGraphSys.DeviceY(y),var1));
  result:=0;
end;

type
   TAskPixelArray=class(TReSetBoolean)
     x1,y1:integer;
     a:TArray2N;
     r:PBoolean;
   constructor create(x0,y0:integer; a0:TArray2N;  var r0:boolean);
   procedure execute;override;
 end;

function AskPixelArraySub(x1,y1:integer; a:Tarray2N):boolean;
var
   i,j:NativeInt;
   c:integer;
begin
       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:=GraphBase.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:integer; a0:TArray2N;  var r0:boolean);
begin
  inherited create;
  x1:=x0; y1:=y0;
  a:=a0;
  r:=@r0;
end;

procedure TAskPixelArray.execute;
begin
   r^:= AskPixelArraySub(x1,y1,a);
   //inherited execute;
end;

function AskPixelArray(x,y:double; a:Tarray2N):integer; overload;
var
   r:boolean;
   x1,y1:Integer;
begin
  x1:=MyGraphSys.DeviceX(x);
  y1:=MyGraphSys.DeviceY(y);
  addQueueWait(TAskPixelArray.create(x1,y1,a,r));
  result:=0;
end;

function AskPixelArray(x,y:double; a:Tarray2N; s:TStrVar):integer; overload;
var
   r:boolean;
   x1,y1:Integer;
begin
  x1:=MyGraphSys.DeviceX(x);
  y1:=MyGraphSys.DeviceY(y);
  addQueueWait(TAskPixelArray.create(x1,y1,a,r));
  result:=0;
  if r then
      s.str:= 'ABSENT'
  else
      s.str:='PRESENT';
  s.free
end;


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

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

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

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

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

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

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

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

function getaxiscolor(var x:double):integer;
begin
    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:=GraphBase.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
  result:=0;
  x:=MyGraphSys.AskTextHeight;
end;

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

function AskTextAngleRad(var x:double):integer;
begin
   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;
   s:='';
end;

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

function AskTextJustify(h,v:TStrVar):integer;
begin
  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
   result:=0;
   with MyGraphSys do  with GraphBase do
     begin
       width:=VirtualX(textwidth(s))-VirtualX(0);
       //if TextProblemCoordinate then                                           // ver.1.2.2
       //   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
  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
   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 GraphBase.clip then s:='ON' else s:='OFF';
   svar.str:=s;
   svar.free;
   s:='';
end;

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

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

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

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

type
  TFLOOD=class(TGraphCommand)
    a,b:integer;
    c:TColor;
    constructor create(a0,b0:integer; c0:TColor);
    procedure execute;override;
  end;
  TFLOODFILL=class(TFLOOD)
     procedure execute;override;
 end;

constructor TFLOOD.create(a0,b0:integer; c0:TColor);
begin
  inherited create;
  a:=a0;b:=b0;c:=c0;
end;

procedure TFLOOD.execute;
begin
   GraphBase.FLOOD(a,b,c);
   RepaintRequest:=true;
end;

procedure TFLOODFill.execute;
begin
   GraphBase.FLOODFill(a,b,c);
   RepaintRequest:=true;
end;



procedure FLOOD( x,y:double);
var
  a,b:Integer;
  c:TColor;
begin
 if currenttransform.transform(x,y) then
   begin
     a:=MyGraphSys.deviceX(x);
     b:=MyGraphSys.deviceY(y);
     c:=MyPalette[MyGraphSys.areacolor] ;
     AddQueue(TFLOOD.create(a,b,c));
    end;
end;

procedure FLOODFill( x,y:double);
var
  a,b:Integer;
  c:TColor;
begin
  if currenttransform.transform(x,y) then
    begin
     a:=MyGraphSys.deviceX(x);
     b:=MyGraphSys.deviceY(y);
     c:=MyPalette[MyGraphSys.areacolor] ;
     AddQueue(TFLOODFill.create(a,b,c));
    end;
end;


{***********}
{Grid & Axes}
{***********}

procedure drawaxes0(x,y:double);
begin
   gridaxes.drawaxes0(x,y);
end;

procedure drawgrid0(x,y:double);
begin
  gridaxes.drawGrid0(x,y);
end;

procedure drawaxes2(x,y:double);
begin
  gridaxes.drawaxes2(x,y);
end;


procedure drawgrid2(x,y:double);
begin
  gridaxes.drawGrid2(x,y);
end;


procedure drawcircle(x,y:double);
begin
  gridaxes.drawCircle(x,y);
end;


procedure drawDisk(x,y:double);
begin
  gridaxes.drawDisk(x,y);
end;


{*****}
{GSAVE}
{*****}


procedure GLOAD(const fname:string);
var
  extype0:integer;
begin
  if currenttransform<>nil then
           setexception(11004);     //2011.11.18追加
  MyGraphSys.OpenFile(fname);
end;




Procedure GSAVE(const fname,pf:string);
begin
  MyGraphSys.SaveFile(fname);
end;


{****}
{Draw}
{****}
{Transform}

procedure PushTransform;
begin
    with TAffine.create do push
end;

procedure mlt(a:TArray2N);
begin
  currenttransform.mlt(a);
end;

procedure shift(x,y:double);
begin
   currenttransform.shift(x,y);
end;

procedure scale1(x:double);
begin
  currenttransform.scale1(x);
end;

procedure scale(x,y:double);
begin
    currenttransform.scale(x,y);
end;


procedure rotate2(x,y:double);
begin
   currenttransform.rotate2(x,y);
end;



procedure rotate(x:double);
begin
  currenttransform.rotate(x)
end;


procedure shear(x:double);
begin
 currenttransform.shear(x)
end;


procedure mlt_next;
begin
      with currenttransform do
     if next<>nil then mlt(next)
end;


procedure PopTransform;
begin
    pop
end;



procedure BeamManage;
begin
  with MyGraphSys do beam:=beam and (BeamMode=bmImmortal);
end;




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

procedure MSScreen(c:integer);
begin
   case c of
     2,3,87:
      setBitMapSize(640,400);
     11,12:
      setBitMapSize(640,480);
   end;

   if c in [3,12,87] then
    begin
       case c of
        3 :MyPalette.PaletteNumber:=2;
        12,87:MyPalette.PaletteNumber:=1;
       end;
       clear;
       setlinecolor(7,false);
    end;
end;



initialization

finalization

end.
