Liren Large Software Subsidy 9/09.iso/l/l045/2.ddi/GSHELL.PAS

Pascal/Delphi Source File | 1987-12-23 | 31.0 KB | 1,128 lines

(********************************************************************)
(*                         GRAPHIX TOOLBOX 4.0                      *)
(*       Copyright (c) 1985, 87 by  Borland International, Inc.     *)
(********************************************************************)
unit GShell;

interface

{$I Float.inc}  { Determines what type Float means. }

uses
  Dos, Crt, GDriver, GKernel;

procedure DrawAxis(XDens, YDens, XLeft, YTop, XRight, YBottom,
                   XAxis, YAxis : integer; Arrows : boolean);

procedure ResetAxis;

procedure FindWorld(I : integer; A : PlotArray; NPoints : integer;
                    ScaleX, ScaleY : Float);

procedure DrawPolygon(A : PlotArray;I0, NPoints, Line, Scale, Lines : integer);

procedure RotatePolygonAbout(var A : PlotArray; NPoints : integer;
                             Theta, X0, Y0 : Float);

procedure RotatePolygon(var A : PlotArray; NPoints : integer; Theta : Float);

procedure TranslatePolygon(var A : PlotArray; N : integer;
                           DeltaX, DeltaY : Float);

procedure ScalePolygon(var A : PlotArray; N : integer;
                       ScaleX, ScaleY : Float);

procedure Hatch(X_1, Y_1, X_2, Y_2, Delta : Float);

procedure DrawHistogram(A :PlotArray; NPoints : integer;
                        Hatching : boolean; HatchStyle : integer);

procedure DrawCircleSegment(Xr0, Yr0 : Float; var Xr1, Yr1 : Float;
                            Inner, Outer, Phi, Area : Float;
                            Txt : WrkString; Option, Scale : byte);

procedure DrawCartPie(X1, Y1, X2, Y2, Inner, Outer : Float;
                      A : PieArray; N, Prior, Scale : integer);

procedure DrawPolarPie(X1, Y1, Radius, Angle, Inner, Outer : Float;
                       A : PieArray; N, Prior, Scale : integer);

procedure Spline(var AA : PlotArray; N : integer; X1, Xm : Float;
                 var BB : PlotArray; M : integer);

procedure Bezier(A : PlotArray; MaxContrPoints : integer;
                 var B : PlotArray; MaxIntPoints : integer);

implementation

procedure DrawAxis{(XDens, YDens, XLeft, YTop, XRight, YBottom,
                   XAxis, YAxis : integer; Arrows : boolean)};
var
  LineStyleLoc, Xk0, Yk0, Xk1, Yk1, Xk2, Yk2, NDiff, X2, Y2,
  MaxExponentX, MaxExponentY, I, Ys, Xs, Delta, NPoints : integer;
  Difference, Number, S, Fract : Float;
  X1RefLoc, X2RefLoc, Y1RefLoc, Y2RefLoc,
  X1RefLoc2, X2RefLoc2, Y1RefLoc2, Y2RefLoc2 : integer;
  ClippingLoc, DirectModeLoc, HeaderLoc : boolean;

function StringNumber(X1 : Float; MaxExponent : integer) : WrkString;
var
  Y : WrkString;
begin
  Str(X1 * Exp(-MaxExponent * Ln(10.0)):5:2, Y);
  StringNumber := Y;
end; { StringNumber }

function GetExponent(X1 : Float) : integer;
begin
  GetExponent := 0;
  if X1 <> 0.0 then
    if abs(X1) >= 1.0 then
      GetExponent := trunc(Ln(abs(X1)) / Ln(10.0))
    else
      GetExponent := -trunc(abs(Ln(abs(X1))) / Ln(10.0) + 1.0);
end; { GetExponent }

procedure DrawNum(X1, Y1, MaxExponent : integer; Number : Float);
var
  I         : integer;
  StrNumber : WrkString;
begin
  StrNumber := StringNumber(Number, MaxExponent);
  Y1 := Y1 - 3;
  for I := 1 to 5 do
    DrawAscii(X1, Y1, 1, Ord(StrNumber[I]));
end; { DrawNum }

function Balance : integer;
begin
  Balance := 0;
  S := S + Fract;
  if S >= 0 then
    begin
      S := S - 1.0;
      Balance := 1;
    end;
end; { Balance }

procedure DrawExponent(X1, Y1, MaxExponent : integer);
var
  I         : integer;
  StrNumber : WrkString;
begin
  Y1 := Y1 - 3;
  X1 := X1 + 1;
  DrawAscii(X1, Y1, 1, 49);
  DrawAscii(X1, Y1, 1, 48);
  Str(MaxExponent:3, StrNumber);
  Y1 := Y1 - 3;
  X1 := X1 - 7;
  for I := 1 to 3 do
    DrawAscii(X1, Y1, 1, Ord(StrNumber[I]));
end; { DrawExponent }

begin { DrawAxis }
  LineStyleLoc := LinestyleGlb;
  SetLineStyle(0);
  DirectModeLoc := DirectModeGlb;
  DirectModeGlb := true;
  with GrafWindow[WindowNdxGlb] do
  begin
    X1RefLoc := X1;
    X2RefLoc := X2;
    Y1RefLoc := Y1;
    Y2RefLoc := Y2;
    ReDefineWindow(WindowNdxGlb, X1 + XLeft, Y1 + YTop,
                   X2 - XRight, Y2 - YBottom);
    SelectWindow(WindowNdxGlb);
  end;
  if (XDens < 0) xor (YDens < 0) then
  begin
    HeaderLoc := HeaderGlb;
    HeaderGlb := false;
    DrawBorder;
    HeaderGlb := HeaderLoc;
  end;
  XDens := abs(XDens);
  YDens := abs(YDens);
  if XDens > 9 then
    XDens := 0;
  if YDens > 9 then
    YDens := 0;
  Xk0 := (X1RefGlb + 4) shl 3;
  Yk0 := Y2RefGlb - 14;
  Yk1 := Y1RefGlb + 6;
  Xk1 := Xk0;
  Yk2 := Yk0;
  Xk2 := (X2RefGlb - 2) shl 3 + 7;
  if (XAxis >= 0) or (YAxis >= 0) then
  begin
    ClippingLoc := ClippingGlb;
    ClippingGlb := true;
    with GrafWindow[WindowNdxGlb] do
    begin
      X1RefLoc2 := X1;
      X2RefLoc2 := X2;
      Y1RefLoc2 := Y1;
      Y2RefLoc2 := Y2;
    end;
    ReDefineWindow(WindowNdxGlb, X1RefLoc2 + 4, Y1RefLoc2 + 6,
                                 X2RefLoc2 - 2, Y2RefLoc2 - 14);
    SelectWindow(WindowNdxGlb);
    DirectModeGlb := false;
    if (XAxis >= 0) then
    begin
      SetLineStyle(XAxis);
      DrawLine(X1WldGlb, Y1WldGlb + Y2WldGlb, X2WldGlb, Y1WldGlb + Y2WldGlb);
      SetLineStyle(0);
    end;
    if (YAxis >= 0) then
    begin
      SetLinestyle(YAxis);
      DrawLine(0, Y1WldGlb, 0, Y2WldGlb);
      SetLineStyle(0);
    end;
    ClippingGlb := ClippingLoc;
    DirectModeGlb := true;
    ReDefineWindow(WindowNdxGlb, X1RefLoc2, Y1RefLoc2, X2RefLoc2, Y2RefLoc2);
    SelectWindow(WindowNdxGlb);
  end;

  DrawLine(Xk0, Yk0, Xk1, Yk1);
  if Arrows then
  begin
    DrawLine(Xk0, Yk1, Xk0 - 4, Yk1 + 4);
    DrawLine(Xk0, Yk1, Xk0 + 4, Yk1 + 4);
    DP(Xk0, Yk1 - 1);
  end;

  DrawLine(Xk0, Yk0, Xk2 + 1, Yk2);
  if Arrows then
  begin
    DrawLine(Xk2, Yk2, Xk2 - 4, Yk2 - 4);
    DrawLine(Xk2, Yk2, Xk2 - 4, Yk2 + 4);
  end;

  if (abs(Yk0 - Yk1) >= 35) and (abs(Xk2 - Xk1) >= 150) then
  begin
    DrawLine(Xk0, Yk0, Xk0 - 4, Yk0);
    DrawLine(Xk0, Yk0, Xk0, Yk0 + 4);
    Delta := Y2RefGlb - Y1RefGlb - 20;
    NPoints := Delta div 7;
    NDiff := Delta - (NPoints shl 3) + NPoints;
    if YDens >= 0 then
    begin
      if abs(Y2WldGlb) > abs(Y1WldGlb) then
        MaxExponentY := GetExponent(Y2WldGlb)
      else
        MaxExponentY := GetExponent(Y1WldGlb);
      DrawNum(X1RefGlb shl 3, Yk0 + 1, MaxExponentY, Y1WldGlb);
      if MaxExponentY <> 0 then
        DrawExponent(X1RefGlb shl 3 + 1, Yk1 + 2, MaxExponentY);
    end;
    Fract := NDiff / NPoints;
    S := -Fract;
    Ys := Yk0;
    Difference := (Y2WldGlb - Y1WldGlb) / NPoints;
    for I := 1 to NPoints do
    begin
      Ys := Ys - 7 - Balance;
      if (YDens >= 0) and (Ys > Y1RefGlb + 13) then
      begin
        Number := Y1WldGlb + I * Difference;
        DrawLine(Xk0, Ys, Xk0 - 4, Ys);
        if YDens >= 0 then
          if I mod (10 - YDens) = 0 then
            DrawNum(X1RefGlb shl 3, Ys + 1, MaxExponentY, Number);
      end;
    end;

    if XDens >= 0 then
    begin
      if abs(X2WldGlb) > abs(X1WldGlb) then
        MaxExponentX := GetExponent(X2WldGlb)
      else
        MaxExponentX := GetExponent(X1WldGlb);
      DrawNum(Xk0 - 14, Yk0 + 10, MaxExponentX, X1WldGlb);
      if MaxExponentX <> 0 then
        DrawExponent(Xk2 - 13, Yk0 + 10, MaxExponentX);
    end;
    Delta := abs(X2RefGlb - X1RefGlb) shl 3 - 41;
    NPoints := Delta div 30;
    NDiff := Delta - (NPoints shl 5) + (NPoints shl 1);
    Fract := NDiff / NPoints;
    S := -Fract;
    Xs := Xk0 - 1;
    Difference := (X2WldGlb - X1WldGlb) / NPoints;
    for I := 1 to NPoints do
    begin
      Xs := Xs + 30 + Balance;
      if (XDens >= 0) and (Xs < X2RefGlb shl 3 + 7 - 24) then
      begin
        Number := X1WldGlb + I * Difference;
        DrawLine(Xs, Yk0, Xs, Yk0 + 4);
        if XDens >= 0 then
          if I mod (10 - XDens) = 0 then
            DrawNum(Xs - 14, Yk0 + 10, MaxExponentX, Number);
      end;
    end;
  end;
  ReDefineWindow(WindowNdxGlb, X1RefLoc, Y1RefLoc, X2RefLoc, Y2RefLoc);
  SelectWindow(WindowNdxGlb);
  DirectModeGlb := DirectModeLoc;
  SetLineStyle(LineStyleLoc);
  AxisGlb := true;
  X1Glb := XLeft;
  X2Glb := XRight;
  Y1Glb := YTop;
  Y2Glb := YBottom;
end; { DrawAxis }

procedure ResetAxis;
begin
  AxisGlb := true;
end; { ResetAxis }

procedure FindWorld{(I : integer; A : PlotArray; NPoints : integer;
                    ScaleX, ScaleY : Float)};
var
  J : integer;
  Xmax, Ymax, Xmin, Ymin, Xmid, Ymid, Xdiff, Ydiff : Float;

begin
  NPoints := abs(NPoints);
  if NPoints >= 2 then
    if I in [1..MaxWorldsGlb] then
      begin
        Xmax := A[1, 1];
        Ymax := A[1, 2];
        Xmin := Xmax;
        Ymin := Ymax;
        for J := 2 to NPoints do
        begin
          if A[J, 1] > Xmax then
            Xmax := A[J, 1]
          else
            if A[J, 1] < Xmin then
              Xmin := A[J, 1];
          if A[J, 2] > Ymax then
            Ymax := A[J, 2]
          else
            if A[J, 2] < Ymin then
              Ymin := A[J, 2];
        end;

        if ScaleX <> 1.0 then
        begin
          ScaleX := abs(ScaleX);
          Xdiff := Xmax - Xmin;
          Xmid := (Xmax + Xmin) * 0.5;
          Xmax := Xmid + ScaleX * 0.5 * Xdiff;
          Xmin := Xmid - ScaleX * 0.5 * Xdiff;
        end;

        if ScaleY <> 1.0 then
        begin
          ScaleY := abs(ScaleY);
          Ydiff := Ymax - Ymin;
          Ymid := (Ymax + Ymin) * 0.5;
          Ymax := Ymid + ScaleY * 0.5 * Ydiff;
          Ymin := Ymid - ScaleY * 0.5 * Ydiff;
        end;

        DefineWorld(I, Xmin, Ymin, Xmax, Ymax);
        SelectWorld(I);
      end
    else
      Error(7, 2)
  else
    Error(7, 4);
end; { FindWorld }

procedure DrawPolygon{(A : PlotArray;I0, NPoints, Line, Scale, Lines : integer)};
var
  I, X1, X2, Y1, Y2, XOffset, YOffset,
  X1RefLoc, Y1RefLoc, X2RefLoc, Y2RefLoc,
  DeltaY, XOs1, XOs2, YOs1, YOs2 : integer;
  AutoClip, DirectModeLoc, PlotLine, PlotSymbol, Flipped : boolean;
  X1Loc, Y1Loc, X2Loc, Y2Loc : integer;
  Temp : Float;

procedure DrawPointClipped(X, Y : integer);
begin
  if (X1 > X1RefGlb shl 3) and (X2 < X2RefGlb shl 3 + 7) then
    if (Y1 > Y1RefGlb) and (Y2 < Y2RefGlb) then
      DP(X, Y);
end; { DrawPointClipped }

procedure DrawItem(X, Y : integer);
var
  LineStyleLoc : integer;
begin
  LineStyleLoc := LineStyleGlb;
  SetLineStyle(0);
  case Line of
    2    : DrawCrossDiag(X, Y, Scale);
    3, 4 : DrawSquareC(X - Scale, Y + Scale, X + Scale, Y - Scale, (Line = 4));
    5    : DrawDiamond(X, Y, Scale + 1);
    6    : DrawWye(X, Y, Scale + 1);
    1    : DrawCross(X, Y, Scale);
    8    : DrawCircleDirect(X, Y, Scale + 1, true);
    9    : begin
             PlotLine := false;
             if AutoClip then
               DrawPointClipped(X, Y)
             else
               DP(X, Y);
           end;
     7   : DrawStar(X, Y, Scale);
   end;
   SetLineStyle(LineStyleLoc);
 end; { DrawItem }

begin { DrawPolygon }
  if not AxisGlb then
    begin
      with World[WorldNdxGlb] do
      begin
        Temp := Y1;
        Y1 := Y2;
        Y2 := Temp;
      end;
      SelectWorld(WorldNdxGlb);
      SelectWindow(WindowNdxGlb);
      Flipped := true;
    end
  else
    Flipped := false;
  if (I0 <> 0) and (abs(NPoints - I0) >= 2) then
  begin
    X1Loc := X1Glb;
    Y1Loc := Y1Glb;
    X2Loc := X2Glb;
    Y2Loc := Y2Glb;
    DirectModeLoc := DirectModeGlb;
    DirectModeGlb := true;
    AutoClip := (NPoints < 0);
    NPoints := abs(NPoints);
    XOs1 := 1;
    XOs2 := 1;
    YOs1 := 6;
    YOs2 := 6;
    if AxisGlb then
    begin
      XOs1 := 4;
      XOs2 := 2;
      YOs1 := 6;
      YOs2 := 14;
      if (((X2RefGlb + 7 - XOs2 - X1RefGlb + XOs1) > (XOs1 + XOs2) shl 1) and
           (Y2RefGlb - YOs2 - Y1RefGlb + YOs1 > (YOs1 + YOs2) shl 1)) then
      begin
        X1RefLoc := X1RefGlb;
        X1 := X1RefGlb + XOs1 + X1Glb;
        Y1RefLoc := Y1RefGlb;
        Y1 := Y1RefGlb + YOs1 + Y1Glb;
        X2RefLoc := X2RefGlb;
        X2 := X2RefGlb - XOs2 - X2Glb;
        Y2RefLoc := Y2RefGlb;
        Y2 := Y2RefGlb - YOs2 - Y2Glb;
        ReDefineWindow(WindowNdxGlb, X1, Y1, X2, Y2);
        SelectWindow(WindowNdxGlb);
        AxisGlb := true;
      end;
    end;
    PlotLine := (Line >= 0);
    PlotSymbol := (Line <> 0);
    Line := abs(Line);
    Scale := abs(Scale);
    if Lines < 0 then
      DeltaY := Trunc(1.0 / (abs(Y1WldGlb) + abs(Y2WldGlb)) *
                             abs(Y1WldGlb) * abs(Y2RefGlb - Y1RefGlb)) + 1
    else
      DeltaY := 0;
    if (NPoints < 2) and MessageGlb then
      Writeln('<DrawPolygon>: too few data pairs  -> (NPoints) >= 2')
    else
      begin
        X1 := WindowX(A[I0, 1]);
        Y1 := Y2RefGlb + Y1RefGlb - WindowY(A[I0, 2]) - 1;
        DrawItem(X1, Y1);
        if Abs(Lines) = 1 then
          if AutoClip then
            DrawLineClipped(X1, Y2RefGlb - DeltaY, X1, Y1)
          else
            DrawLine(X1, Y2RefGlb - DeltaY, X1, Y1);
        for I:= I0 + 1 to NPoints do
        begin
          X2 := WindowX(A[I, 1]);
          Y2 := Y2RefGlb + Y1RefGlb - WindowY(A[I, 2]) - 1;
          DrawItem(X2, Y2);
          if Abs(Lines) = 1 then
            if AutoClip then
              DrawLineClipped(X2, Y2RefGlb - DeltaY, X2, Y2)
            else
              DrawLine(X2, Y2RefGlb - DeltaY, X2, Y2);
          if PlotLine then
            if AutoClip then
              DrawLineClipped(X1, Y1, X2, Y2)
            else
              DrawLine(X1, Y1, X2, Y2);
          X1 := X2;
          Y1 := Y2;
        end;
      end;
    if AxisGlb then
    begin
      ReDefineWindow(WindowNdxGlb, X1RefLoc, Y1RefLoc, X2RefLoc, Y2RefLoc);
      SelectWindow(WindowNdxGlb);
      X1Glb := X1Loc;
      Y1Glb := Y1Loc;
      X2Glb := X2Loc;
      Y2Glb := Y2Loc;
      AxisGlb := false;
    end;
    DirectModeGlb := DirectModeLoc;
  end
  else
    Error(18, 4);
  if Flipped then
  begin
    with World[WorldNdxGlb] do
    begin
      Temp := Y1;
      Y1 := Y2;
      Y2 := Temp;
    end;
    SelectWorld(WorldNdxGlb);
    SelectWindow(WindowNdxGlb);
  end;
end; { DrawPolygon }

procedure RotatePolygonAbout{(var A : PlotArray; NPoints : integer;
                             Theta, X0, Y0 : Float)};
var
  C, S, X, Ph : Float;
  I : integer;

begin
  if NPoints >= 2 then
    begin
      Ph := Pi / 180.0 * Theta;
      C := Cos(Ph);
      S := Sin(Ph);
      for I := 1 to NPoints do
      begin
        X := X0 + C * (A[I, 1] - X0) - S * (A[I, 2] - Y0);
        A[I, 2] := Y0 + S * (A[I, 1] - X0) + C * (A[I, 2] - Y0);
        A[I, 1] := X;
      end;
    end
  else
    Error(8, 4);
end; { RotatePolygonAbout }

procedure RotatePolygon{(var A : PlotArray; NPoints : integer; Theta : Float)};
var
  X0, Y0 : Float;
  I : integer;

begin
  X0 := 0.0;
  Y0 := 0.0;
  for I := 1 to NPoints do
  begin
    X0 := X0 + A[I, 1];
    Y0 := Y0 + A[I, 2];
  end;
  RotatePolygonAbout(A, NPoints, Theta, X0 / NPoints, Y0 / NPoints);
end; { RotatePolygon }

procedure TranslatePolygon{(var A : PlotArray; N : integer;
                           DeltaX, DeltaY : Float)};
var
  I : integer;

begin
  N := abs(N);
  if N >= 2 then
    for I := 1 to N do
    begin
      A[I, 1] := A[I, 1] + DeltaX;
      A[I, 2] := A[I, 2] + DeltaY;
    end
  else
    Error(9, 4);
end; { TranslatePolygon }

procedure ScalePolygon{(var A : PlotArray; N : integer;
                       ScaleX, ScaleY : Float)};
var
  I : integer;

begin
  N := abs(N);
  if N >= 2 then
    for I := 1 to N do
    begin
      A[I, 1] := A[I, 1] * ScaleX;
      A[I, 2] := A[I, 2] * ScaleY;
    end
  else
    Error(10, 4);
end; { ScalePolygon }

procedure Hatch{(X_1, Y_1, X_2, Y_2, Delta : Float)};
var
  X1, Y1, X2, Y2 : integer;
  DirectModeLoc, Dummy : boolean;

procedure HatchDirect(X1, Y1, X2, Y2 : integer; Delta : longint);
var
  I, Count : integer;
  Yst, Yen : longint;
  X1RefLoc, X2RefLoc, Y1RefLoc, Y2RefLoc : integer;
  DirectModeLoc, ClippingLoc : boolean;
  X1D, Y1D, X2D, Y2D : integer;

begin { HatchDirect }
  if Delta <> 0 then
  begin
    HatchGlb := true;
    DirectModeLoc := DirectModeGlb;
    DirectModeGlb := true;
    ClippingLoc := ClippingGlb;
    ClippingGlb := true;
    X1RefLoc := X1RefGlb;
    X1RefGlb := X1;
    X2RefLoc := X2RefGlb;
    X2RefGlb := X2;
    Y1RefLoc := Y1RefGlb;
    Y1RefGlb := Y1;
    Y2RefLoc := Y2RefGlb;
    Y2RefGlb := Y2;
    Yst := Y1 + Delta;
    Yen := Y1 - X2 + X1 + Delta;
    if Delta < 0 then
    begin
      Delta := -Delta;
      I := Yst;
      Yst := Yen;
      Yen := I;
    end;
    Count := (Y2 - Y1 + X2 - X1 + X2 - X1) div Delta;
    for I := 1 to Count-1 do
    begin
      X1D := X1;
      Y1D := Yst;
      X2D := X2;
      Y2D := Yen;
      if Clip(X1D, Y1D, X2D, Y2D) then
        DrawLine(X1D, Y1D, X2D, Y2D);
      Yst := Yst + Delta;
      Yen := Yen + Delta;
    end;
    ClippingGlb := ClippingLoc;
    HatchGlb := false;
    X1RefGlb := X1RefLoc;
    X2RefGlb := X2RefLoc;
    Y1RefGlb := Y1RefLoc;
    Y2RefGlb := Y2RefLoc;
    DirectModeGlb := DirectModeLoc;
  end;
end; { HatchDirect }

begin { Hatch }
  if DirectModeGlb then
    HatchDirect(trunc(X_1), trunc(Y_1), trunc(X_2), trunc(Y_2), trunc(Delta))
  else
    begin
      DirectModeLoc := DirectModeGlb;
      DirectModeGlb := true;
      X1 := WindowX(X_1);
      Y1 := WindowY(Y_1);
      X2 := WindowX(X_2);
      Y2 := WindowY(Y_2);
      Dummy := Clip(X1, Y1, X2, Y1);
      Dummy := Clip(X1, Y1, X1, Y2);
      HatchDirect(X1, Y1, X2, Y2, trunc(Delta));
      DirectModeGlb := DirectModeLoc;
    end;
end; { Hatch }

procedure DrawHistogram{(A :PlotArray; NPoints : integer;
                        Hatching : boolean; HatchStyle : integer)};

var
  X1, X2, Y2, NPixels, Delta, NDiff, YRef, LineStyleLoc, I : integer;
  Fract, S, Y, YAxis : Float;
  DirectModeLoc, Negative : boolean;
  Wtemp : WindowType;
  X1Loc, Y1Loc, X2Loc, Y2Loc : integer;
  Temp : Float;

function Balance : integer;
begin
  Balance := 0;
  S := S + Fract;
  if S >= 0.0 then
  begin
    S := S - 1.0;
    Balance := 1;
  end;
end; { Balance }

begin { DrawHistogram }
  if abs(NPoints) >= 2 then
    begin
      X1Loc := X1Glb;
      Y1Loc := Y1Glb;
      X2Loc := X2Glb;
      Y2Loc := Y2Glb;
      LineStyleLoc := LinestyleGlb;
      SetLineStyle(0);
      if AxisGlb then
      begin
        Wtemp := GrafWindow[WindowNdxGlb];
        ReDefineWindow(WindowNdxGlb, X1RefGlb + 4 + X1Glb, Y1RefGlb + 6 + Y1Glb,
                       X2RefGlb - 2 - X2Glb, Y2RefGlb - 14 - Y2Glb);
        SelectWindow(WindowNdxGlb);
        AxisGlb := true;
      end;
      DirectModeLoc := DirectModeGlb;
      DirectModeGlb := true;
      Negative := NPoints < 0;
      NPoints := abs(NPoints);
      NPixels := (X2RefGlb - X1RefGlb) shl 3 + 7;
      Delta := NPixels div NPoints;
      NDiff := NPixels - Delta * NPoints;
      Fract := NDiff / NPoints;
      S := -Fract;
      X1 := X1RefGlb shl 3;
      Temp := Y2RefGlb + Y1RefGlb - AyGlb;
      if Temp > MaxInt then
        Temp := MaxInt
      else
        if Temp < -32767 then
          Temp := -32767;
      YRef := trunc(Temp);
      if Negative then
        DrawStraight(X1, X2RefGlb shl 3 + 7, YRef);
      YAxis := Y1RefGlb;
      if BYGlb > 0 then
        YAxis := Y2RefGlb;
      for I := 1 to NPoints do
      begin
        X2 := X1 + Delta + Balance;
        Y := A[I, 2];
        if not Negative then
          Y := abs(Y);
        Temp := AyGlb + ByGlb * Y;
        if Temp > MaxInt then
          Temp := MaxInt
        else
          if Temp < -32767 then
            Temp := -32767;
        Y2 := Y2RefGlb + Y1RefGlb - trunc(Temp);
        if not Negative then
          begin
            DrawLine(X1, YAxis, X1, Y2);
            DrawStraight(X1, X2, Y2);
            DrawLine(X2, YAxis, X2, Y2);
            if Hatching then
              if Odd(I) then
                Hatch(X1, Y2, X2, YAxis, HatchStyle)
              else
                Hatch(X1, Y2, X2, YAxis, -HatchStyle);
          end
        else
          begin
            DrawLine(X1, YRef, X1, Y2);
            DrawStraight(X1, X2, Y2);
            DrawLine(X2, YRef, X2, Y2);
            if Hatching then
              if YRef - Y2 < 0 then
                if Odd(I) then
                  Hatch(X1, YRef, X2, Y2, HatchStyle)
                else
                  Hatch(X1, YRef, X2, Y2, -HatchStyle)
              else
                if Odd(I) then
                  Hatch(X1, Y2, X2,YRef, HatchStyle)
                else
                  Hatch(X1, Y2, X2, YRef, -HatchStyle);
          end;
        X1 := X2;
      end;
      if AxisGlb then
      begin
        GrafWindow[WindowNdxGlb] := Wtemp;
        SelectWindow(WindowNdxGlb);
        X1Glb := X1Loc;
        Y1Glb := Y1Loc;
        X2Glb := X2Loc;
        Y2Glb := Y2Loc;
        AxisGlb := false;
      end;
      DirectModeGlb := DirectModeLoc;
      SetLineStyle(LineStyleLoc);
    end
  else
    Error(19, 4);
end; { DrawHistogram }

procedure DrawCircleSegment{(Xr0, Yr0 : Float; var Xr1, Yr1 : Float;
                            Inner, Outer, Phi, Area : Float;
                            Txt : WrkString; Option, Scale : byte)};

var
  FaktC, FaktS, CDummy, C, S, Radius : Float;
  Phi1, DeltaPhi, CosPhi, SinPhi, CosDphi, SinDphi : Float;
  DeltaX, DeltaY, Xr2, Yr2, RadiusLoc, X0Loc, Y0Loc, X1Loc, Y1Loc : Float;
  I, AsciiCode, TextLen, N, X0, Y0, X1, Y1, X2, Y2 : integer;
  DirectModeLoc : boolean;
  TempText : WrkString;

procedure ClippedLine(X1, Y1, X2, Y2 : integer);
begin
  if Clip(X1, Y1, X2, Y2) then
    DrawLine(X1, Y1, X2, Y2);
end; { ClippedLine }

procedure ClippedPoint(X, Y : integer);
begin
  if ClippingGlb then
    begin
      if (X >= X1RefGlb shl 3) and (X < X2RefGlb shl 3 + 7) then
        if (Y >= Y1RefGlb) and (Y <= Y2RefGlb) then
          DP(X, Y);
    end
  else
    DP(X, Y);
end; { ClippedPoint }

begin { DrawCircleSegment }
  X0Loc := Xr0;
  Y0Loc := Yr0;
  X1Loc := Xr1;
  Y1Loc := Yr1;
  RadiusLoc := Sqrt(Sqr(X1Loc - X0Loc) + Sqr(Y1Loc - Y0Loc));
  if RadiusLoc > 0.0 then
  begin
    Option := abs(Option);
    Inner := abs(Inner);
    Outer := abs(Outer);
    Scale := abs(Scale);
    DirectModeLoc := DirectModeGlb;
    DirectModeGlb := True;
    Phi := Phi * Pi / 180.0;
    if abs(Phi) / (2.0 * Pi) > 1.0 then
      Phi := 2.0 * Pi;
    N := trunc(RadiusLoc * abs(Phi) / 9.0);
    if N < 2 then
      N := 2;
    if (abs(Xr1 - Xr0) > 0) and (abs(Yr1 - Yr0) > 0) then
      Phi1 := ArcTan((Yr1 - Yr0) / (Xr1 - Xr0))
    else
      if Xr1 - Xr0 = 0 then
        if Yr1 - Yr0 > 0 then
          Phi1 := Pi / 2.0
        else
          Phi1 := 1.5 * Pi
        else
          if Xr1 > Xr0 then
            Phi1:=0.0
          else
            Phi1 := Pi;
    DeltaPhi := Phi / (N - 1);
    C := 1.0;
    S := 0.0;
    CosPhi := Cos(Phi1);
    SinPhi := Sin(Phi1);
    CosDphi := Cos(DeltaPhi);
    SinDphi := Sin(DeltaPhi);
    if Xr1 < Xr0 then
      begin
        FaktS := -1;
        FaktC := -1;
      end
    else
      begin
        FaktS := 1;
        FaktC := 1;
      end;
    if (Yr1 = Yr0) and (Xr1 < Xr0) then
    begin
      FaktC := -FaktC;
      FaktS := -FaktS;
    end;
    if Area < 0 then
    begin
      Area := abs(Area);
      DeltaX := FaktC * 0.3 * RadiusLoc * Cos(Phi / 2 + Phi1);
      DeltaY := trunc(FaktS * 0.3 * AspectGlb * RadiusLoc *
                      Sin(Phi / 2 + Phi1) + 0.5);
      Xr0 := Xr0 + DeltaX;
      Yr0 := Yr0 + DeltaY;
    end;
    X0 := WindowX(Xr0);
    Y0 := WindowY(Yr0);
    if not DirectModeLoc then
      ClippedPoint(X0, Y0)
    else
      DP(X0, Y0);
    X1 := X0;
    Y1 := Y0;
    for I := 1 to N do
    begin
      Xr2 := Xr0 + FaktC * RadiusLoc * (CosPhi * C - SinPhi * S);
      X2 := WindowX(Xr2);
      Yr2 := Yr0 + AspectGlb * RadiusLoc * FaktS * (SinPhi * C + CosPhi * S);
      Y2 := WindowY(Yr2);
      if not DirectModeLoc then
        ClippedLine(X1, Y1, X2, Y2)
      else
        DrawLine(X1, Y1, X2, Y2);
      X1 := X2;
      Y1 := Y2;
      CDummy := C * CosDphi - S * SinDphi;
      S := S * CosDphi + C * SinDphi;
      C := CDummy;
    end;
    if not PieGlb then
      if not DirectModeLoc then
        ClippedLine(X1, Y1, X0, Y0)
      else
        DrawLine(X1, Y1, X0, Y0);
      if (Option > 0) and (Phi < 2.0 * Pi) then
      begin
        Xr1 := Xr0 + FaktC * RadiusLoc * Inner * Cos(Phi / 2.0 + Phi1);
        Yr1 := Yr0 + FaktS * AspectGlb * RadiusLoc * Inner * Sin(Phi / 2.0 + Phi1);
        Xr2 := Xr0 + FaktC * RadiusLoc * Outer * Cos(Phi / 2.0 + Phi1);
        Yr2 := Yr0 + FaktS * AspectGlb * RadiusLoc * Outer * Sin(Phi / 2.0 + Phi1);
        X1 := WindowX(Xr1);
        Y1 := WindowY(Yr1);
        X2 := WindowX(Xr2);
        Y2 := WindowY(Yr2);
        if not DirectModeLoc then
          ClippedLine(X1, Y1, X2, Y2)
        else
          DrawLine(X1, Y1, X2, Y2);
        Str(Area:1:2, TempText);
        case Option of
          1 : TempText := Txt;
          2 : TempText := Txt + TempText;
        { 3 : TempText := TempText; }
        end;
        TextLen := Length(TempText);
        if X2 >= X0 then
          X2 := X2 + Scale * 6
        else
          X2 := X2 - TextLen * 6 * Scale;
        DrawText(X2, Y2, Scale, TempText);
      end;
      Xr1 := X0Loc + FaktC * RadiusLoc * Cos(Phi + Phi1);
      Yr1 := Y0Loc + FaktS * RadiusLoc * Sin(Phi + Phi1);
      DirectModeGlb := DirectModeLoc;
  end;
end; { DrawCircleSegment }

procedure DrawCartPie{(X1, Y1, X2, Y2, Inner, Outer : Float;
                      A : PieArray; N, Prior, Scale : integer)};
var
  I : integer;
  Sum, AspectLoc : Float;

procedure DCS(N : integer);
begin
  DrawCircleSegment(X1, Y1, X2, Y2, Inner, Outer, abs(A[N].Area / Sum * 360),
                    A[N].Area, A[N].Text, Prior, Scale);
end; { DCS }

begin { DrawCartPie }
  AspectLoc := AspectGlb;
  AspectGlb := AspectGlb * BXGlb / BYGlb;
  Sum := 0.0;
  for I := 1 to N do
    Sum := Sum + abs(A[I].Area);
  for I := 1 to N - 1 do
  begin
    PieGlb := (A[I].Area > 0) and (A[I + 1].Area > 0);
    DCS(I);
  end;
  PieGlb := (A[N].Area > 0) and (A[1].Area > 0);
  DCS(N);
  PieGlb := true;
  AspectGlb := AspectLoc;
end; { DrawCartPie }

procedure DrawPolarPie{(X1, Y1, Radius, Angle, Inner, Outer : Float;
                       A : PieArray; N, Prior, Scale : integer)};
begin
  Angle := Angle / 180 * Pi;
  DrawCartPie(X1, Y1, X1 + Cos(Angle) * Radius, Y1 + Sin(-Angle) * Radius,
              Inner, Outer, A, N, Prior, Scale);
end; { DrawPolarPie }

procedure Spline{(var AA : PlotArray; N : integer; X1, Xm : Float;
                 var BB : PlotArray; M : integer)};

type
  Vector = array[1..MaxPlotGlb] of Float;

var
  I, K    : integer;
  Dx, T   : Float;
  B, C, D : Vector;

function SplineEval( T : Float; var I : integer) : Float;
var
  J, K : integer;
  Dx   : Float;
begin
  if I >= N then
    I := 1;
  if (T < AA[I, 1]) or (T > AA[I+1, 1]) then
  begin
    I := 1;
    J := N + 1;
    repeat
      K := (I + J) div 2;
      if T < AA[K, 1] then
        J := K;
      if T >= AA[K, 1] then
        I := K;
    until J <= (I + 1);
  end;
  Dx := T - AA[I, 1];
  SplineEval := AA[I, 2] + Dx * (B[I] + Dx * (C[I] + Dx * D[I]));
end; { SplineEval }

begin { Spline }
  if N >= 3 then
    begin
      D[1] := AA[2, 1] - AA[1, 1];
      C[2] := (AA[2, 2] - AA[1, 2]) / D[1];
      for I := 2 to N-1 do
      begin
        D[I] := AA[I+1, 1] - AA[I, 1];
        B[I] := 2.0 * (D[I-1] + D[I]);
        C[I+1] := (AA[I+1, 2] - AA[I, 2]) / D[I];
        C[I] := C[I+1] - C[I];
      end;
      B[1] := -D[1];
      B[N] := -D[N-1];
      C[1] := 0.0;
      C[N] := 0.0;
      if N > 3 then
      begin
        C[1] := C[3] / (AA[4, 1] - AA[2, 1]) - C[2] / (AA[3, 1] - AA[1, 1]);
        C[N] := C[N-1] / (AA[N, 1] - AA[N-2, 1])
                - C[N-2] / (AA[N-1, 1] - AA[N-3, 1]);
        C[1] := C[1] * Sqr(D[1]) / (AA[4, 1] - AA[1, 1]);
        C[N] := -C[N] * Sqr(D[N-1]) / (AA[N, 1] - AA[N-3, 1]);
      end;
      for I := 2 to N do
      begin
        T := D[I-1] / B[I-1];
        B[I] := B[I] - T * D[I-1];
        C[I] := C[I] - T * C[I-1];
      end;
      C[N] := C[N] / B[N];
      for I := N-1 downto 1 do
        C[I] := (C[I] - D[I] * C[I+1]) / B[I];
      B[N] := (AA[N, 2] - AA[N-1, 2]) / D[N-1] + D[N-1] * (C[N-1] + 2.0 * C[N]);
      for I := 1 to N-1 do
      begin
        B[I] := (AA[I+1, 2] - AA[I, 2]) / D[I] - D[I] * (C[I+1] + 2.0 * C[I]);
        D[I] := (C[I+1] - C[I]) / D[I];
        C[I] := 3.0 * C[I];
      end;
      C[N] := 3.0 * C[N];
      D[N] := D[N-1];
    end
  else
    if N = 2 then
    begin
      B[1] := (AA[2, 2] - AA[1, 2]) / (AA[2, 1] - AA[1, 1]);
      C[1] := 0.0;
      D[1] := 0.0;
      B[2] := B[1];
      C[2] := 0.0;
      D[2] := 0.0;
    end;
  if (N >= 2) and (M >= 2) then
    if (X1 >= AA[1, 1])  and (Xm <= AA[N, 1]) then
      begin
        Dx := (Xm - X1) / (M - 1);
        K := 1;
        for I := 1 to M do
        begin
          BB[I, 1] := X1 + (I - 1) * Dx;
          BB[I, 2] := SplineEval(BB[I, 1], K);
        end;
      end
    else
      Error(20, 7)
  else
    Error(20, 4);
end; { Spline }

procedure Bezier{(A : PlotArray; MaxContrPoints : integer;
                 var B : PlotArray; MaxIntPoints : integer)};
const
  MaxControlPoints = 25;
type
  CombiArray = array[0..MaxControlPoints] of Float;
var
  N : integer;
  ContrPoint, IntPoint : integer;
  T, SumX, SumY, Prod, DeltaT, Quot : Float;
  Combi : CombiArray;

begin
  MaxContrPoints := MaxContrPoints - 1;
  DeltaT := 1.0 / (MaxIntPoints - 1);
  Combi[0] := 1;
  Combi[MaxContrPoints] := 1;
  for N := 0 to MaxContrPoints - 2 do
    Combi[N + 1] := Combi[N] * (MaxContrPoints - N) / (N + 1);
  for IntPoint := 1 to MaxIntPoints do
  begin
    T := (IntPoint - 1) * DeltaT;
    if T <= 0.5 then
      begin
        Prod := 1.0 - T;
        Quot := Prod;
        for N := 1 to MaxContrPoints - 1 do
          Prod := Prod * Quot;
        Quot := T / Quot;
        SumX := A[MaxContrPoints + 1, 1];
        SumY := A[MaxContrPoints + 1, 2];
        for N := MaxContrPoints downto 1 do
        begin
          SumX := Combi[N - 1] * A[N, 1] + Quot * SumX;
          SumY := Combi[N - 1] * A[N, 2] + Quot * SumY;
        end;
      end
    else
      begin
        Prod := T;
        Quot := Prod;
        for N := 1 to MaxContrPoints - 1 do
          Prod := Prod * Quot;
        Quot := (1 - T) / Quot;
        SumX := A[1, 1];
        SumY := A[1, 2];
        for N := 1 to MaxContrPoints do
        begin
          SumX := Combi[N] * A[N + 1, 1] + Quot * SumX;
          SumY := Combi[N] * A[N + 1, 2] + Quot * SumY;
        end;
      end;
    B[IntPoint, 1] := SumX * Prod;
    B[IntPoint, 2] := SumY * Prod;
  end;
end; { Bezier }

end. { GShell }