Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/gp/gp.pas

Pascal/Delphi Source File | 1994-05-23 | 52.6 KB | 1,855 lines

UNIT GP;   { revision 5/17/94 }
           { took scale from NxyPlot }

INTERFACE

USES Graph, BGIDriv, BGIFont,{ only SMALLFONT,CGA,HERC,EGAVGA LINKED }
     Crt, GraphPrn, HpCopy, Powers, Mouse;

(* USE UNIT VESA16U in MAIN if wish DETECT to find VESA16,
   driver 16, modes 0,1,2 *)

CONST  { included for reference and so GRAPH not necessarily needed }

{ EGA VGA COLORS       DRIVERS            MODES FOR DRIVERS }
  Black        =  0;   Detect   = 0;      CGAc0   = 0;   CGAc1 = 1; CGAc2 = 2;
  Blue         =  1;   CGA      = 1;      CGAc3   = 3;   CGAhi = 4;
  Green        =  2;
  Cyan         =  3;   EGA      = 3;      EGALo   = 0;   EGAhi   = 1;
  Red          =  4;   EGA64    = 4;      EGA64Lo = 0;   EGA64hi = 1;
  Magenta      =  5;
  Brown        =  6;
  LightGray    =  7;   HercMono = 7;      HercMonoHi = 0;
  DarkGray     =  8;
  LightBlue    =  9;   VGA      = 9;      VGALo = 0; VGAmed = 1; VGAhi = 2;
  LightGreen   =  10;
  LightCyan    =  11;   { SEE Ref Guide GRAPH UNIT def's }
  LightRed     =  12;
  LightMagenta =  13;
  Yellow       =  14;
  White        =  15;

VAR    { GLOBALS FOR POSSIBLE USE BY MAIN }

  { graph driver and graph mode variables }
      Gdrvr, Gmode : INTEGER;

  { current world values }
      WorldXmin, WorldXmax, WorldYmin, WorldYmax : REAL;

  { current window values }
      WindowXmin, WindowXmax, WindowYmin, WindowYmax : INTEGER;

  { values labeled at ends of axes created by MakeWorldAndAxes }
      AxesXmin, AxesXmax, AxesYmin, AxesYmax : REAL;

PROCEDURE BeginGraphic(VAR Gdrvr, Gmode : INTEGER);
PROCEDURE EndGraphic;

PROCEDURE GoGraphic;
PROCEDURE GoText;

PROCEDURE DefineWorld(Num : INTEGER; Xmin, Xmax, Ymin, Ymax : REAL);
PROCEDURE SelectWorld(Num : INTEGER);
PROCEDURE BoxWorld(Color : WORD);

PROCEDURE DefineWindow(Num : INTEGER; Xmin, Xmax, Ymin, Ymax : REAL);
PROCEDURE SelectWindow(Num : INTEGER);
PROCEDURE ClearCurrentWindow;

PROCEDURE MakeWorldAndAxes(WindowNum,WorldNum:INTEGER;
      Xmin, Xmax, Ymin, Ymax : REAL; AxesColor, BoxColor : WORD;
      Xtitle : STRING; XtitleColor : WORD;
      Ytitle : STRING; YtitleColor : WORD;
      MainTitle : STRING; MainTitleColor : WORD);

FUNCTION XperPixel : REAL;
FUNCTION YperPixel : REAL;
FUNCTION NowX : REAL;
FUNCTION NOWY : REAL;
PROCEDURE GetXYfromPixels(VAR X,Y : REAL; Xpos, Ypos : INTEGER);
FUNCTION XtoYAspFac : REAL;



PROCEDURE PlotPoint(X, Y : REAL; Color : WORD);
FUNCTION  GetPoint(X, Y : REAL) : WORD;

PROCEDURE PlotTextXY(X, Y : REAL; TextString : STRING; Color : WORD);
PROCEDURE PlotText(TextString : STRING; Color : WORD);

PROCEDURE PlotRealXY(LabelStr : STRING;
           Value : REAL;W, d : INTEGER;X,Y : REAL;Color : WORD);
                  { for X:w format type use d = -1 }
PROCEDURE PlotReal(LabelStr : STRING;
                     Value : REAL;W, d : INTEGER; Color : WORD);
                     { for X:w format type use d = -1 }

PROCEDURE PlotIntegerXY(LabelStr : STRING; Value, w : INTEGER;
                        X, Y : REAL; Color : WORD);

PROCEDURE PlotInteger(LabelStr : STRING; Value, w : INTEGER; Color : WORD);

PROCEDURE PlotLine(X1, Y1, X2, Y2 : REAL; Color : WORD);
PROCEDURE PlotLineTo(X,Y : REAL; Color : WORD);
PROCEDURE PlotLineRel(Dx,Dy : REAL; Color : WORD);

PROCEDURE PlotMoveTo(X,Y : REAL);
PROCEDURE PlotMoveRel(Dx, Dy : REAL);

PROCEDURE PlotEllipse(Xmin, Xmax, Ymin, Ymax : REAL; Color : WORD);
PROCEDURE PlotRect(Xmin, Xmax, Ymin, Ymax : REAL; Color : WORD);
PROCEDURE PlotCircle(X, Y, R : REAL; Color : WORD);
PROCEDURE Flood(x,y :REAL; FillColor,BorderColor : WORD);

PROCEDURE SaveImage(Num:INTEGER; Xmin,Xmax,Ymin,Ymax: REAL);
PROCEDURE UnSaveImage(Num : INTEGER);
PROCEDURE ClearImage(Num:INTEGER);
PROCEDURE PlotImage(Num:INTEGER; Xlow,Yhi : REAL; PutType : WORD);
PROCEDURE MoveImage(Num:INTEGER; Xlow, Yhi : REAL);
PROCEDURE HeapImageToDisk(ImageNum : INTEGER; FileName : STRING);
PROCEDURE DiskImageToHeap(FileName : STRING; ImageNum : INTEGER);

PROCEDURE CrossCursor(VAR CursorX, CursorY : REAL;
                      ColorCursor:WORD;ShowXY:Boolean;
                      Col, Row : INTEGER; ColorText : WORD);
PROCEDURE BoxCursor(VAR BoxXmin, BoxXmax, BoxYmin, BoxYmax : REAL;
                    ColorCursor : WORD; ShowXY : BOOLEAN;
                    Col, Row : INTEGER; ColorText : WORD);
PROCEDURE GetPixelArea(CurveColor, RefillColor : Word; VAR Area : REAL);

FUNCTION MouseOK : BOOLEAN;
PROCEDURE RestrictMouseToWindow;
PROCEDURE GetMouseXY(VAR X,Y:REAL);
FUNCTION LeftMouseXY(VAR X, Y :REAL): BOOLEAN;
FUNCTION LeftButtonClicked(VAR X, Y : REAL) : BOOLEAN;
FUNCTION RightMouseXY(VAR X, Y :REAL): BOOLEAN;
FUNCTION RightButtonClicked(VAR X, Y : REAL) : BOOLEAN;

PROCEDURE MousePointer(VAR X, Y : REAL; Show : BOOLEAN;
                       Row, Col : INTEGER; Color : BYTE);
PROCEDURE MouseRubberBox(VAR X1,X2,Y1,Y2:REAL;Color : Word;
                         EraseBox : BOOLEAN);
PROCEDURE MouseRubberLine(VAR X1, Y1, X2, Y2 : REAL; Color : WORD;
                          EraseLine : Boolean);
PROCEDURE MouseDraw(Color : WORD);

PROCEDURE CopyToEpson;
PROCEDURE CopyToHPLaserJet;

(*************************************************************************)


IMPLEMENTATION   { 4/26/91 : changed size of titles and axes labling }
                 { Changed MakeWorldAndAxes to redefine window AND world }
TYPE          { so that cannot plot over axes, may clear plot and not axes }
  GraphicWorldRec = RECORD
                      Xmn, Xmx, Ymn, Ymx : REAL;
                    END;
  GraphicWindowRec = RECORD
                       Xmn, Xmx, Ymn, Ymx : REAL;
                     END;
  BoxRec = RECORD
             Xmn,Ymx : REAL;
           END;
VAR
  GraphicWorld : ARRAY[1..10] OF GraphicWorldRec;
  CurrentWorld : GraphicWorldRec;
  GraphicWindow : ARRAY[1..10] OF GraphicWindowRec;
  Image : array[1..10] of pointer;
  ImageValid : array[1..10] of Boolean;
  SizeOfImage : array[1..10] of WORD;
  Box: array[1..10] of BoxRec;
  J : INTEGER;
  OldDirectVideo : Boolean;
  X, Y : REAL;
(************************************************************************)

  PROCEDURE CopyToHPLaserjet;
  BEGIN
    HPHardCopy;
  END;

(*************************************************************************)

  PROCEDURE CopyToEpson;
  BEGIN
    Hardcopy(6);
    Write(Lst,^L);
  END;

(*************************************************************************)

  FUNCTION XperPixel : REAL;
  VAR
    X,Y,Xpix2 : WORD;
  BEGIN
    X := GetX;
    Y := GetY;
    WITH CurrentWorld DO
    BEGIN
      PlotMoveTo(Xmx,Ymn);
      Xpix2 := GetX;
      XperPixel := (Xmx-Xmn)/Xpix2;
    END;
    MoveTo(X, Y);
  END;

  (*************************************************************************)

  FUNCTION YperPixel : REAL;
  VAR
    X, Y, Ypix1, Ypix2 : WORD;
  BEGIN
    X := GetX;
    Y := GetY;
    WITH CurrentWorld DO
    BEGIN
      PlotMoveTo(Xmn,Ymn);
      Ypix2 := GetY;
      YperPixel := (Ymx-Ymn)/Ypix2;{ note reversal in denominator }
    END;
    MoveTo(X, Y);
  END;

  (*************************************************************************)

  PROCEDURE BeginGraphic(VAR Gdrvr,Gmode : INTEGER);
  VAR
    ErrorCode : INTEGER;
    PROCEDURE Abort(Msg : STRING);
    BEGIN
      WriteLn(Msg, ': ', GraphErrorMsg(GraphResult));
      Halt(1);
    END;
  BEGIN
    { Register all the drivers } {SEE UNIT BGIDRIV }
    IF RegisterBGIdriver(@CGADriverProc) < 0 THEN
      Abort('CGA');
    IF RegisterBGIdriver(@EGAVGADriverProc) < 0 THEN
      Abort('EGA/VGA');
    IF RegisterBGIdriver(@HercDriverProc) < 0 THEN
      Abort('Herc');
  (*  IF RegisterBGIdriver(@ATTDriverProc) < 0 THEN
      Abort('AT&T');
    IF RegisterBGIdriver(@PC3270DriverProc) < 0 THEN
      Abort('PC 3270');
  *)
    { Register all the fonts } {SEE UNIT BGIFONT }
{    IF RegisterBGIfont(@BOLDFontProc) < 0 THEN
      Abort('BOLD');
    IF RegisterBGIfont(@EuroFontProc) < 0 THEN
      Abort('EURO');
    IF RegisterBGIfont(@GothicFontProc) < 0 THEN
      Abort('Gothic');
    IF RegisterBGIfont(@LcomFontProc) < 0 THEN
      Abort('Lcom');
}
    IF RegisterBGIfont(@SmallFontProc) < 0 THEN
      Abort('Small');

{    IF RegisterBGIfont(@SansSerifFontProc) < 0 THEN
      Abort('SansSerif');

    IF RegisterBGIfont(@ScriFontProc) < 0 THEN
      Abort('Scri');
    IF RegisterBGIfont(@SimpFontProc) < 0 THEN
      Abort('Simp');
    IF RegisterBGIfont(@TriplexFontProc) < 0 THEN
      Abort('Triplex');
    IF RegisterBGIfont(@TscrFontProc) < 0 THEN
      Abort('Tscr');
}
    InitGraph(Gdrvr, Gmode, '');
    ErrorCode := GraphResult;
    IF ErrorCode <> grOk THEN
      BEGIN
        WriteLn('(Graphics error:', GraphErrorMsg(ErrorCode));
        Halt(1);
      END;
    SelectWindow(1); { sets WindowXmax etc }
    SelectWorld(1);  { sets WorldXmax etc }
    OldDirectVideo := DirectVideo;
    DirectVideo := FALSE;
  END;  { BeginGraphic }

(*************************************************************************)

  PROCEDURE EndGraphic;
  BEGIN
    For J := 1 to 10 DO
    IF ImageValid[J] THEN
      UnSaveImage(J);
    DirectVideo := OldDirectVideo;
    CloseGraph;
  END;

(*************************************************************************)

  PROCEDURE DefineWorld(Num : INTEGER; Xmin, Xmax, Ymin, Ymax : REAL);
  BEGIN
    IF NOT (Num in [1..10] )
    THEN
      BEGIN
        EndGraphic;
        Writeln('DefineWorld was called with Num = ',Num);
        Writeln('Max number of worlds is ten');
        HALT;
      END;
    WITH GraphicWorld[Num] DO
      BEGIN
        IF (Xmin = 0) AND (Xmax = 0) THEN Xmax := 1.0
        ELSE
          IF Xmin = Xmax THEN Xmax := ABS(2.0*Xmin);
        IF (Ymin = 0) AND (Ymax = 0) THEN Ymax := 1.0
        ELSE
          IF Ymin = Ymax THEN Ymax := ABS(2.0*Ymin);
        Xmn := Xmin;
        Ymn := Ymin;
        Xmx := Xmax;
        Ymx := Ymax;
      END;
  END;

(*************************************************************************)

  PROCEDURE DefineWindow(Num : INTEGER; Xmin, Xmax, Ymin, Ymax : REAL);

    { Xmin etc are real PERCENTS , LOWER LEFT screen is origin }
    { pixel co-ords handled by SelectWindow }

  BEGIN
    IF NOT (Num in [1..10])
    THEN
      BEGIN
        EndGraphic;
        Writeln('DefineWindow was called with Num = ',Num);
        Writeln('Max number of windows is ten');
        HALT;
      END;
    WITH GraphicWindow[Num] DO
      BEGIN
        IF Xmin < 0.0 THEN Xmin := 0.0;
        IF Xmax > 100.0 THEN Xmax := 100.0;
        IF Ymin < 0.0 THEN Ymin := 0.0;
        IF Ymax > 100.0 THEN Ymax := 100.0;
        Xmn := Xmin;
        Ymn := Ymin;
        Xmx := Xmax;
        Ymx := Ymax;
      END;
  END;

(*************************************************************************)

  PROCEDURE SelectWorld(Num : INTEGER);
  BEGIN
    IF NOT (Num in [1..10])
    THEN
      BEGIN
        EndGraphic;
        Writeln('SelectWorld was called with Num = ',Num);
        Writeln('Max number of worlds is ten');
        HALT;
      END;
    CurrentWorld := GraphicWorld[Num];
    With CurrentWorld DO
    BEGIN
      WorldXmin := Xmn;
      WorldXmax := Xmx;
      WorldYmin := Ymn;
      WorldYmax := Ymx;
    END;
  END;

(*************************************************************************)

  PROCEDURE BoxWorld( Color : WORD);
  BEGIN
    WITH CurrentWorld DO
      BEGIN
        PlotMoveTo(Xmn, Ymn);
        PlotLineTo(Xmn, Ymx, Color);
        PlotLineTo(Xmx, Ymx, Color);
        PlotLineTo(Xmx, Ymn, Color);
        PlotLineTo(Xmn, Ymn, Color);
      END;
  END;

(*************************************************************************)

  PROCEDURE SelectWindow(Num : INTEGER);
  VAR
    X1, Y1, X2, Y2 : INTEGER;
  BEGIN
    IF NOT (Num in [1..10])
    THEN
      BEGIN
        EndGraphic;
        Writeln('SelectWindow was called with Num = ',Num);
        Writeln('Max number of windows is ten');
        HALT;
      END;
    WITH GraphicWindow[Num] DO
      BEGIN
        X1 := Trunc(0.01*GetMaxX*Xmn);
        X2 := Trunc(0.01*GetMaxX*Xmx);
        Y2 := Trunc(0.01*GetMaxY*(100-Ymn));
        Y1 := Trunc(0.01*GetMaxY*(100-Ymx));
      END;
    WindowXmin := X1;  { Across and DOWN pixel count }
    WindowXmax := X2;
    WindowYmin := Y1;
    WindowYmax := Y2;
    SetViewPort(X1, Y1, X2, Y2, ClipOn);
  END;

(*************************************************************************)

PROCEDURE MakeWindow(Num : Integer; Xmin, Xmax, Ymin, Ymax : REAL);
VAR                         { use to define a window inside a window }
  X1, X2, Y1, Y2 : REAL; { to be able to clear plot INSIDE axes }
BEGIN
  PlotMoveTo(Xmin+2.0*XperPixel,Ymin+YperPixel);
  X1:= (100.0*(WindowXmin+GetX)/GetMaxX);
  Y1 :=(100.0*(GetMaxY-WindowYmin-GetY)/GetMaxY);
  PlotMoveTo(Xmax,Ymax);
  X2 :=(100.0*(WindowXmin+GetX)/GetMaxX);
  Y2 :=(100.0*(GetMaxY-WindowYmin-GetY)/GetMaxY);
  DefineWindow(Num,X1,X2,Y1,Y2);
END;

(*************************************************************************)

  PROCEDURE GoGraphic;
  BEGIN
    SetGraphMode(GetGraphMode);
    DirectVideo := FALSE;
  END;

(*************************************************************************)

  PROCEDURE GoText;
  BEGIN
    RestoreCrtMode;
    DirectVideo := OldDirectVideo;
  END;

(*************************************************************************)

  FUNCTION XpixelRel(X : REAL) : INTEGER;
  VAR
    ViewPort : ViewPortType;
    Xtemp : REAL;
  BEGIN
    GetViewSettings(ViewPort);
    WITH ViewPort DO
      BEGIN
        WITH CurrentWorld DO
          BEGIN
            Xtemp := (X2-X1)*(X-Xmn)/(Xmx-Xmn);
            IF Xtemp > MaxInt
            THEN
              XpixelRel := MaxInt
            ELSE
              IF Xtemp < - MaxInt
              THEN
                XpixelRel := - MaxInt
              ELSE
                XpixelRel := Round(Xtemp);
          END;
      END;
  END;

(*************************************************************************)

  FUNCTION YpixelRel(Y : REAL) : INTEGER;
  VAR
    ViewPort : ViewPortType;
    Ytemp : REAL;
  BEGIN
    GetViewSettings(ViewPort);
    WITH ViewPort DO
      BEGIN
        WITH CurrentWorld DO
          BEGIN
            Ytemp := (Y2-Y1)*(1.0 - (Y-Ymn)/(Ymx-Ymn));
            IF Ytemp > MaxInt
            THEN
              YpixelRel := MaxInt
            ELSE
              IF Ytemp < -MaxInt
              THEN
                YpixelRel := -MaxInt
              ELSE
                YpixelRel := Round(Ytemp);
          END;
      END;
  END;

(*************************************************************************)

  PROCEDURE PlotPoint(X, Y : REAL; Color : WORD);
  BEGIN
    PutPixel(XpixelRel(X), YpixelRel(Y), Color);
  END;

(*************************************************************************)

  FUNCTION GetPoint(X, Y : REAL) : WORD;
  BEGIN
    GetPoint := GetPixel(XpixelRel(X), YpixelRel(Y));
  END;

(*************************************************************************)

  PROCEDURE PlotLine(X1, Y1, X2, Y2 : REAL; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Line(XpixelRel(X1), YpixelRel(Y1), XpixelRel(X2), YpixelRel(Y2));
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotLineTo(X,Y : REAL; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    LineTo(XpixelRel(X),YpixelRel(Y));
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotLineRel(Dx,Dy : REAL; Color : WORD);
  VAR
    OldColor : WORD;
    Xav, Yav : REAL;
    tdx,tdy,tx,ty :REAL; zx,zy : integer;
  BEGIN
    Xav := 0.5*(WorldXmax + WorldXmin);
    Yav := 0.5*(WorldYmax + WorldYmin);
    OldColor := GetColor;
    SetColor(Color);
    LineRel(Round(Dx/XperPixel), -Round(Dy/YperPixel));
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotMoveTo(X,Y : REAL);
  BEGIN
    MoveTo(XpixelRel(X),YpixelRel(Y));
  END;

(*************************************************************************)

  PROCEDURE PlotMoveRel(Dx, Dy : REAL);
  BEGIN
    MoveRel(XpixelRel(2.0*Dx)-XpixelRel(Dx),YpixelRel(2.0*Dy)-YpixelRel(Dy));
  END;

(*************************************************************************)

  PROCEDURE ClearCurrentWindow;
  BEGIN
    ClearViewPort;
  END;

(*************************************************************************)

  PROCEDURE PlotTextXY(X, Y : REAL; TextString : STRING; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    OutTextXY(XpixelRel(X), YpixelRel(Y), TextString);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotRealXY(LabelStr : STRING;
           Value : REAL;W, d : INTEGER;X,Y : REAL;Color : WORD);
                     { for X:w format type use d = -1 }
  VAR
    Tstr : STRING;
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Str(Value:w:d,Tstr);
    PlotMoveTo(X,Y);
    OutText(LabelStr + Tstr);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotIntegerXY(LabelStr : STRING; Value, w : INTEGER;
                                   X, Y : REAL; Color : WORD);
  VAR
    OldColor : WORD;
    Tstr : STRING;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Str(Value:w,Tstr);
    PlotMoveTo(X, Y);
    OutText(LabelStr + Tstr);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotText(TextString : STRING; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    OutText(TextString);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotReal(LabelStr : STRING;
                     Value : REAL;W, d : INTEGER; Color : WORD);
                     { for X:w format type use d = -1 }
  VAR
    Tstr : STRING;
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Str(Value:w:d,Tstr);
    OutText(LabelStr + Tstr);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotInteger(LabelStr : STRING; Value, w : INTEGER; Color : WORD);
  VAR
    OldColor : WORD;
    Tstr : STRING;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Str(Value:w,Tstr);
    OutText(LabelStr + Tstr);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotEllipse(Xmin, Xmax, Ymin, Ymax : REAL; Color : WORD);
  VAR
    X, Y, Xr, Yr : INTEGER;
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    X := XpixelRel(0.5*(Xmax+Xmin)); { center co-ords }
    Y := YpixelRel(0.5*(Ymax+Ymin));
    Xr := (XpixelRel(Xmax)-XpixelRel(Xmin)) DIV 2;
    Yr := (YpixelRel(Ymin)-YpixelRel(Ymax)) DIV 2;
    Ellipse(X, Y, 0, 360, Xr, Yr);
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotCircle(X, Y, R : REAL; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Circle(XpixelRel(X), YpixelRel(Y),Round(R/XperPixel));
    SetColor(OldColor);
  END;

(*************************************************************************)

  PROCEDURE PlotRect(Xmin, Xmax, Ymin, Ymax : REAL; Color : WORD);
  VAR
    OldColor : WORD;
  BEGIN
    OldColor := GetColor;
    SetColor(Color);
    Rectangle(XpixelRel(Xmin), YpixelRel(Ymax), XpixelRel(Xmax),
              YpixelRel(Ymin));
    SetColor(OldColor);
  END;

(*************************************************************************)

PROCEDURE FLOOD(x,y :REAL; FillColor,BorderColor : WORD);
BEGIN
  SetFillStyle(SolidFill,FillColor);
  FloodFill(XpixelRel(x),YpixelRel(y),BorderColor);
END;

(*************************************************************************)

PROCEDURE SaveImage(Num:INTEGER; Xmin,Xmax,Ymin,Ymax: REAL);
VAR
  Size, x1,x2,y1,y2 : WORD;
  Temp : REAL;
BEGIN
  IF NOT ( Num in [1..10])
  THEN
    BEGIN
      EndGraphic;
      WriteLn('SaveImage called with num = ',num);
      Writeln('Only ten images may be saved');
      HALT;
    END;
    IF Xmax < Xmin THEN
    BEGIN
      Temp := Xmin;
      Xmin := Xmax;
      Xmax := Temp;
    END;
    IF Ymax < Ymin THEN
    BEGIN
      Temp := Ymin;
      Ymin := Ymax;
      Ymax := Temp;
    END;
  x1:=XpixelRel(Xmin);
  x2:=XpixelRel(Xmax);
  y1:=YpixelRel(Ymax);{ note Ymax and Ymin reversed as required by ImageSize }
  y2:=YpixelRel(Ymin);{ and GetImage }
  Size:=ImageSize(x1,y1,x2,y2);
  IF Size = 0 THEN
    BEGIN
      EndGraphic;
      Writeln('IMAGE ',Num,' TOO LARGE TO SAVE');
      HALT;
    END;
  IF MemAvail < Size THEN
    BEGIN
      EndGraphic;
      Writeln('Insufficient Heap Memory available for call to SaveImage(',
      Num,')');
      HALT;
    END;
  GetMem(Image[Num],Size);
  SizeOfImage[Num] := Size;
  GetImage(x1,y1,x2,y2,Image[Num]^);
  ImageValid[Num] := TRUE;
  With Box[Num] DO
  Begin
    Xmn:=Xmin;       { Only Upper Left Corner Needed }
    Ymx:=Ymax;
  end;
end;

(*************************************************************************)

PROCEDURE UnSaveImage(Num : INTEGER);
BEGIN
  IF NOT ( Num in [1..10])
  THEN
    BEGIN
      EndGraphic;
      WriteLn('UnSaveImage called with num = ',num);
      Writeln('Only ten images may be saved');
      HALT;
    END;
  IF ImageValid[Num] = FALSE
  THEN
    BEGIN
      EndGraphic;
      WriteLn('Attempt to UnSave image number ',num);
      Writeln('This image has not been saved');
      HALT;
    END;
  FreeMem(Image[Num],SizeOfImage[Num]);
  ImageValid[Num] := FALSE;
END;

(*************************************************************************)

PROCEDURE PlotImage(Num:INTEGER; Xlow,Yhi : REAL; PutType : WORD);
VAR
  x,y:INTEGER;
Begin
  IF NOT ( Num in [1..10])
  THEN
    BEGIN
      EndGraphic;
      WriteLn('PlotImage called with num = ',num);
      Writeln('Only ten images may be manipulated');
      HALT;
    END;
  IF ImageValid[Num] = FALSE
  THEN
    BEGIN
      EndGraphic;
      Writeln('Attempt to PlotImage number ',num);
      WriteLn('This image has not been saved');
      HALT;
    END;
  WITH Box[Num] DO
  begin
    x:=XpixelRel(Xlow);
    y:=YpixelRel(Yhi);
    PutImage(x,y,Image[Num]^,PutType);  { uses upper left corner }
    Xmn:=Xlow;
    Ymx:=Yhi;
  end;
end;

(*************************************************************************)

PROCEDURE ClearImage(Num:INTEGER);
VAR
  x,y:INTEGER;
BEGIN
  IF NOT ( Num in [1..10])
  THEN
    BEGIN
      EndGraphic;
      WriteLn('ClearImage called with num = ',num);
      Writeln('Only ten images may be manipulated');
      HALT;
    END;
  IF ImageValid[Num] = FALSE
  THEN
    BEGIN
      EndGraphic;
      Writeln('Attempt to clear image number ',num);
      Writeln('This image not saved');
      HALT;
    END;
  WITH Box[Num] DO
  Begin
    x:=XpixelRel(Xmn);
    y:=YpixelRel(Ymx);
  end;
  PutImage(x,y,Image[Num]^,XorPut);
END;

(*************************************************************************)

PROCEDURE MoveImage(Num:INTEGER; Xlow, Yhi : REAL);
Begin
  IF NOT ( Num in [1..10])
  THEN
    BEGIN
      EndGraphic;
      WriteLn('MoveImage called with num = ',num);
      Writeln('Only ten images may be manipulated');
      HALT;
    END;
  IF ImageValid[Num] = FALSE
  THEN
    BEGIN
      WriteLn('Attempt to move image number ',num);
      Writeln('This image has not been saved');
      HALT;
    END;
  ClearImage(Num);
  PlotImage(Num,Xlow,Yhi, XORPut);
end;

(*************************************************************************)

PROCEDURE HeapImageToDisk(ImageNum : Integer; FileName : String);
VAR
  ImageFile : File;
  NumToWrite, Count : Word;
Begin
  IF (ImageValid[ImageNum] = FALSE) THEN
    BEGIN
      EndGraphic;
      writeln('HeapImageToDisk called with INVALID Image Number ',
             ImageNum, '.  Referenced FileName ',FileName);
      Halt;
    END
  ELSE
    BEGIN
      Assign(ImageFile,FileName);
      ReWrite(ImageFile,1);
      NumToWrite := SizeOfImage[ImageNum];
      BlockWrite(ImageFile,Image[ImageNum]^, NumToWrite,Count);
      Close(ImageFile);
      IF ( NumToWrite <> Count ) THEN
        BEGIN
          EndGraphic;
          writeln('Disk full during write to '+Filename,' by HeapImageToDisk');
          writeln('using Image Number ',ImageNum);
          Halt;
        END;
    END;
END;  { HeapImageToDisk }

(*************************************************************************)

PROCEDURE DiskImageToHeap(FileName : String; ImageNum : Integer);
VAR
  ImageFile : File;
  NumRead, Size : Word;
BEGIN
  IF ( ImageValid[ImageNum] = TRUE ) THEN
    UnSaveImage(ImageNum);
  Assign(ImageFile, FileName);
  ReSet(ImageFile,1);
  Size := FileSize(ImageFile);
  GetMem(Image[ImageNum],Size);
  BlockRead(ImageFile, Image[ImageNum]^, Size, NumRead);
  Close(ImageFile);
  IF (NumRead <> Size) THEN
    BEGIN
      EndGraphic;
      WriteLn('Incorrect number of bytes read from '+FileName + ' during');
      writeln('DiskImageToHeap with Image Number ',ImageNum);
      Halt;
    END;
  ImageValid[ImageNum] := TRUE;
  SizeOfImage[ImageNum] := Size;
END;  { DiskImageToHeap }

(*************************************************************************)

PROCEDURE MakeWorldAndAxes(WindowNum,WorldNum:INTEGER;
      Xmin, Xmax, Ymin, Ymax : REAL; AxesColor, BoxColor : WORD;
      Xtitle : STRING; XtitleColor : WORD;
      Ytitle : STRING; YtitleColor : WORD;
      MainTitle : STRING; MainTitleColor : WORD);
VAR
  X1, X2, Y1, Y2, Dx, Dy, TenXpwr, TenYpwr : REAL;
  Xdivs, Ydivs, XPwr, Ypwr, J, K, Digits, Dot : INTEGER;
  Nstr : STRING;
  OldTextSettings : TextSettingsType;
  OldColor : WORD;
  TempPosMin, TempPos, TempY : REAL;
(*-------------------------------------------------------------*)

PROCEDURE WriteTitles(Xtitle,Ytitle,MainTitle:string);
VAR
  Xpix1,Xpix2,Ypix1,Ypix2,Xlength,Ylength,XMainLength : INTEGER;
  XpwrTen, YpwrTen : REAL;

begin
  GetTextSettings(OldTextSettings);
  XpwrTen := PwrI(10.0,Xpwr);
  YpwrTen := PwrI(10.0,Ypwr);
  SetTextStyle(SmallFont,HorizDir,5);
  Xlength := TextWidth(Xtitle);
  PlotMoveTo(0.5*(XpwrTen*(X2+X1)-Xlength*XperPixel),
             0.5*(WorldYmin + TempY + TextHeight('H')*YperPixel));
  (*PlotMoveTo(0.5*(XpwrTen*(X2+X1)-Xlength*XperPixel),
             WorldYmin + 1.5*TextHeight('H')*YperPixel);*)
  SetColor(XtitleColor);
  OutText(Xtitle);
(*  WITH GraphicWindow[WindowNum] DO
  BEGIN
    IF  Ymx-Ymn > 67.0 THEN YChrSize := 7
    ELSE
      IF  Ymx-Ymn > 37.0 THEN YChrSize := 6
      ELSE
        YChrSize := 5;
  END;
  YChrSize := 6;
*)
  SetTextStyle(SmallFont,VertDir,5);
  Ylength := TextWidth(Ytitle);
  PlotTextXY(0.5*(WorldXmin + TempPosMin - TextHeight('H')*XperPixel),
             0.5*(WorldYmin+WorldYmax+Ylength*YperPixel),
             Ytitle,YtitleColor);
  (*PlotTextXY(WorldXmin + 0.5*TextHeight('H')*XperPixel,
             0.5*(WorldYmin+WorldYmax+Ylength*YperPixel),
             Ytitle,YtitleColor);*)
  {SetColor(YtitleColor);
  OutText(Ytitle);}
  SetTextStyle(SmallFont,HorizDir,6);
  XMainLength := TextWidth(MainTitle);
  PlotMoveTo(0.5*(XpwrTen*(X2+X1)-XMainlength*XperPixel),
             WorldYmax-0.25*TextHeight('H')*YperPixel);
  SetColor(MainTitleColor);
  OutText(MainTitle);
end;


(*------------------------------------------------------------------*)

  Procedure Scale(Zmin,Zmax:REAL;VAR Z1,Z2,Zinc:REAL;VAR Ndivs,Pwr:Integer);
VAR
 Temp : REAL;
  Function Floor(X:REAL):REAL;
  BEGIN
    Floor := Int(X);
  END;
  Function Ceil(X:REAL):REAL;
  BEGIN
    IF X = Int(X) THEN Ceil := X
    ELSE
      IF X > 0.0 THEN Ceil := Int(X+1.0)
    ELSE Ceil := Int(X-1.0);
  END;
  Function Log10(X:REAL):REAL;
  BEGIN
    Log10 := Ln(X)/Ln(10.0);
  END;

BEGIN
  IF Zmin > Zmax THEN
  BEGIN
    Temp := Zmax;
    Zmax := Zmin;
    Zmin := Temp;
  END;
  IF (Zmin = 0.0) AND (Zmax = 0.0) THEN Zmax := 1.0;
  IF Zmin = Zmax THEN
  BEGIN
    IF Zmin < 0.0 THEN
      Zmax := 0.9*Zmin
    ELSE
      Zmax := 1.1*Zmin;
  END;
  Zinc := (Zmax-Zmin)*0.2;
  Temp := Log10(Zinc);
  IF Temp >= 0.0 THEN Pwr := Trunc(Floor(Temp))
  ELSE
    Pwr := Trunc(Ceil(Temp));
  IF Zinc > 1.0 THEN Inc(Pwr);
  Temp := Zinc*PwrI(10.0, -Pwr);
  Zinc := 0.1;
  IF Temp > 0.1 THEN Zinc := 0.2;
  IF Temp > 0.2 THEN Zinc := 0.25;
  IF Temp > 0.25 THEN Zinc := 0.5;
  IF Temp > 0.5 THEN Zinc := 1.0;
  Zinc := Zinc*PwrI(10.0,Pwr);
  IF Zmin < Int(Zmin/Zinc)*Zinc THEN
    Zmin := (Int(Zmin/Zinc) -1)*Zinc
  ELSE
    Zmin := Int(Zmin/Zinc)*Zinc;
  IF Zmax > Int(Zmax/Zinc)*Zinc THEN
    Zmax := (Int(Zmax/Zinc) +1)*Zinc
  ELSE
    Zmax := Int(Zmax/Zinc)*Zinc;
  Zinc := Zinc*PwrI(10.0,-Pwr);
  Z1 := Zmin*PwrI(10.0,-Pwr);
  Z2 := Zmax*PwrI(10.0,-Pwr);
  Ndivs := Round((Z2-Z1)/Zinc);
END;

(* -------------------------------------------------------*)

BEGIN                         { MakeWorldAndAxes }
  IF (NOT(WindowNum IN [1..10]))
  THEN
    BEGIN
      EndGraphic;
      WriteLn('MakeWorldAndAxes called with WindowNum = ',WindowNum);
      Writeln('Only ten windows may be designated');
      HALT;
    END;
   IF (NOT (WorldNum IN [1..10]))
   THEN
     BEGIN
      EndGraphic;
      WriteLn('MakeWorldAndAxes called with WorldNum = ',WorldNum);
      Writeln('Only ten worlds may be designated');
      HALT;
    END;
  OldColor := GetColor;
  scale(Xmin, Xmax, X1, X2, Dx, Xdivs, XPwr);
  scale(Ymin, Ymax, Y1, Y2, Dy, Ydivs, YPwr);
  TenXpwr := PwrI(10.0, XPwr);
  TenYpwr := PwrI(10.0, Ypwr);
  AxesXmin := X1*TenXpwr;    { passed as globals for MAIN's possible use }
  AxesXmax := X2*TenXpwr;
  AxesYmin := Y1*TenYpwr;
  AxesYmax := Y2*TenYpwr;
  DefineWorld(WorldNum,(X1-0.4*(X2-X1))*TenXpwr,
                       (X2+0.2*(X2-X1))*TenXpwr,
                       (Y1-0.3*(Y2-Y1))*TenYpwr,
                       (Y2+0.3*(Y2-Y1))*TenYpwr);
  SelectWindow(WindowNum);
  SelectWorld(WorldNum);
  BoxWorld(BoxColor);
  SetColor(AxesColor);
  { do x-axis }
  PlotLine(X1*TenXpwr, Y1*TenYpwr, X2*TenXpwr, Y1*TenYpwr, AxesColor);
 (* WITH GraphicWindow[WindowNum] DO
  BEGIN
    IF  Xmx-Xmn > 67.0 THEN XChrSize := 6
    ELSE
      IF  Xmx-Xmn > 37.0 THEN XChrSize := 5
      ELSE
        XChrSize := 4;
  END;
*)
  SetTextStyle(SmallFont,HorizDir,4);
  FOR J := 0 TO Xdivs DO  { draw x-axis and tics, draw x values }
    BEGIN
      PlotMoveTo((X1+J*Dx)*TenXpwr, Y1*TenYpwr);
      PlotLineRel(0, -0.5*TextHeight('H')*YperPixel, AxesColor);
      Str(((X1+J*Dx)*TenXpwr):0:5, Nstr);
      K := Pos('.',Nstr);
      Dot := K;
      REPEAT
        Inc(K);
      UNTIL (K=Length(Nstr)) OR (Nstr[K] <> '0');
      IF (K = Length(Nstr)) THEN
      BEGIN
        IF Nstr[K] = '0' THEN Digits := 0
        ELSE Digits := K-Dot;
      END
      ELSE
      BEGIN
        REPEAT
          Inc(K);
        UNTIL (K=Length(Nstr)) OR (Nstr[K] = '0');
        IF (Nstr[K] = '0') THEN
          Digits := K-1-Dot
        ELSE Digits := K-Dot;
      END;
      Str(((X1+J*Dx)*TenXpwr):0:Digits, Nstr);
      IF Nstr = '-0' THEN Nstr := '0';
      PlotMoveTo((X1+J*Dx)*TenXpwr-0.5*TextWidth(Nstr)*XperPixel,
                 AxesYmin-Textheight('1')*Yperpixel);
      TempY := NowY - TextHeight('1')*YperPixel;
      OutText(Nstr);
    END;

  { do y-axis }
  TempPosMin := WorldXmax;
  PlotLine(X1*TenXpwr, Y1*TenYpwr, X1*TenXpwr, Y2*TenYpwr,AxesColor);
  FOR J := 0 TO Ydivs DO
    BEGIN
      PlotMoveTo(X1*TenXpwr, (Y1+J*Dy)*TenYpwr);
      PlotLineRel(-0.5*TextWidth('H')*XperPixel, 0, AxesColor);
      Str(((Y1+J*Dy)*TenYpwr):0:5, Nstr);
      K := Pos('.',Nstr);
      Dot :=K;
      REPEAT
        Inc(k);
      UNTIL (K=Length(Nstr)) OR (Nstr[K] <> '0');
      IF (K = Length(Nstr)) THEN
      BEGIN
        IF Nstr[K] = '0' THEN Digits := 0
        ELSE Digits := K -Dot;
      END
      ELSE
      BEGIN
        REPEAT
          Inc(K);
        UNTIL (K=Length(Nstr)) OR (Nstr[K] = '0');
        IF (Nstr[K] = '0') THEN
          Digits := K-1-Dot
        ELSE Digits := K-Dot;
      END;
      Str(((Y1+J*Dy)*TenYpwr):0:Digits, Nstr);
      IF Nstr = '-0' THEN Nstr := '0';
      TempPos := X1*TenXpwr-(TextWidth('H')+TextWidth(Nstr))*XperPixel;
      IF TempPosMin > TempPos THEN TempPosMin := TempPos;
      PlotMoveTo(TempPos,(Y1+J*Dy)*TenYpwr+0.5*TextHeight('1')*YperPixel);
      OutText(Nstr);
    END;
  WriteTitles(Xtitle,Ytitle,MainTitle);
  WITH OldTextSettings DO
  BEGIN
    SetTextJustify(Horiz,Vert);
    SetTextStyle(Font,Direction,CharSize);
  END;
  MakeWindow(WindowNum,AxesXmin,AxesXmax,AxesYmin,AxesYmax);
  SelectWindow(WindowNum);
  DefineWorld(WorldNum,AxesXmin,AxesXmax,AxesYmin,AxesYmax);
  SelectWorld(WorldNum);
  SetColor(OldColor);
END;                          { MakeWorldAndAxes }

(**********************************************************************)

FUNCTION NowX : REAL;
VAR
  Xpix, Ypix : WORD;
BEGIN
  Xpix := GetX;
  Ypix := GetY;
  NowX := WorldXmin + XperPixel*Xpix;
  MoveTo(Xpix,Ypix);
END;

(***************************************************************************)

FUNCTION NowY : REAL;
VAR
  Xpix, Ypix : WORD;
BEGIN
  Xpix := GetX;
  Ypix := GetY;
  NowY := WorldYmax - YperPixel*Ypix;
  MoveTo(Xpix,Ypix);
END;

(***************************************************************************)

FUNCTION XtoYAspFac : REAL;
VAR
  Xasp, Yasp : WORD;
BEGIN
  GetAspectRatio(Xasp,Yasp);
  XtoYAspFac := YperPixel*Xasp/(XperPixel*Yasp);
END;

(***************************************************************************)

PROCEDURE CrossCursor(VAR CursorX, CursorY : REAL;
                      ColorCursor:WORD;ShowXY:Boolean;
                      Col, Row : INTEGER; ColorText : WORD);
VAR
  Ch : Char;
  X,Y,DelX,DelY : REAL;
  OldColor : WORD;

(* -------------------------------------------------------*)
PROCEDURE DrawCursor(x,y : REAL);
BEGIN
  PlotLine(x-DelX,y,x+delX,y, GetColor);
  PlotLine(x,y-DelY,x,y+delY,GetColor);
END;
(* -------------------------------------------------------*)
PROCEDURE ShowCursorXY;
BEGIN
  IF ShowXY THEN
  BEGIN
    GoToXY(Col,Row);
    write('X = ',CursorX:18,'   Y = ',CursorY:18);
  END;
END;
(* -------------------------------------------------------*)
PROCEDURE MoveCursor(x,y : REAL);
BEGIN
  DrawCursor(CursorX,CursorY);
  DrawCursor(x,y);
end;
(* -------------------------------------------------------*)
BEGIN                   { CrossCursor }
  WITH CurrentWorld DO
  BEGIN
    CursorX := 0.5*(Xmn+Xmx);
    CursorY := 0.5*(Ymn+Ymx);
  END; { WITH }
  DelX := 10.0*XperPixel;
  DelY := 10.0*YperPixel;
  TextColor(ColorText);
  OldColor := GetColor;
  SetColor(ColorCursor);
  SetWriteMode(XORput);
  DrawCursor(CursorX,CursorY);
  ShowCursorXY;
  REPEAT
    Ch := ReadKey;
    If Ch = #0 THEN
    BEGIN
      x := CursorX;
      y := CursorY;
      Ch := ReadKey;
      WITH CurrentWorld DO
      BEGIN
        CASE Ch of
          {RightArrow} #77 : IF (CursorX + Delx + XperPixel) <= Xmx THEN
                               x := CursorX + XperPixel;
          {LeftArrow}  #75 : IF (cursorX - DelX - XperPixel) >= Xmn THEN
                               x := CursorX - XperPixel;
          {UpArrow}    #72 : IF ( CursorY + DelY + YperPixel) <= Ymx THEN
                               y := CursorY + YperPixel;
          {DownArrow}  #80 : IF (CursorY -Dely - YperPixel) >= Ymn THEN
                               y := CursorY - YperPixel;
          { End }      #79 : IF (CursorX + DelX + 10.0*XperPixel) <= Xmx THEN
                               x := CursorX + 10.0*XperPixel;
          { Home }     #71 : IF (cursorX - DelX - 10.0*XperPixel) >= Xmn THEN
                               x := CursorX - 10.0*XperPixel;
          { PageUp }   #73 : IF ( CursorY + DelY + 10.0*YperPixel) <= Ymx THEN
                               y := CursorY + 10.0*YperPixel;
          { PageDown } #81 : IF (CursorY -DelY -10.0*YperPixel) >= Ymn THEN
                               y := CursorY - 10.0*YperPixel;
        END;  { CASE }
      END; { WITH }
      MoveCursor(x,y);
      CursorX := x;
      CursorY := y;
      ShowCursorXY;
      END;
  UNTIL (Ch = #13);
  DrawCursor(CursorX,CursorY);
  SetColor(OldColor);
  IF ShowXY THEN
    BEGIN
      GoToXY(Col, Row);
      FOR J := Col to 80 DO
        write(' ');
    END;
  SetWriteMode(NormalPut);
END; { CrossCursor }

(**************************************************************************)

PROCEDURE BoxCursor(VAR BoxXmin, BoxXmax, BoxYmin, BoxYmax : REAL;
                    ColorCursor : WORD; ShowXY : Boolean; Col, Row :integer;
                    ColorText : WORD);

                         { uses images 7, 8, 9 and 10 }
  CONST
    StepFraction = 0.2;
  VAR
    Xmin, Xmax, Ymin, Ymax, Xstep, Ystep : REAL;
    Ch : Char;
    OldColor : WORD;
    J : INTEGER;
    (* -------------------------------------------------------*)
    PROCEDURE DrawCursor;
    BEGIN
      PlotMoveTo(Xmin, Ymin);
      PlotLineTo(Xmin, Ymax, GetColor);
      PlotLineTo(Xmax, Ymax, GetColor);
      PlotLineTo(Xmax, Ymin, GetColor);
      PlotLineTo(Xmin, Ymin, GetColor);
    END;
    (* -------------------------------------------------------*)
    PROCEDURE MoveCursor(DelX, DelY : REAL);
    BEGIN
      DrawCursor;     { erase }
      Xmin := Xmin+DelX;
      Xmax := Xmax+DelX;
      Ymin := Ymin+DelY;
      Ymax := Ymax+DelY;
      DrawCursor;
    END;
    (* -------------------------------------------------------*)
    PROCEDURE ExpandCursor;   { no if any edge is within 1 pixel }
    VAR
      X1, X2, Y1, Y2, Xdist, Ydist : REAL;
    BEGIN
      Xdist := XperPixel;
      Ydist := YperPixel;
      BEGIN
        IF (((Xmin-Xstep) >= (WorldXmin+Xdist))
        AND ((Xmax+Xstep) <= (WorldXmax-Xdist))
        AND ((Ymin-Ystep) >= (WorldYmin+Ydist))
        AND ((Ymax+Ystep) <= (WorldYmax-Ydist)))
        THEN
          BEGIN
            X1 := Xmin-Xstep;
            X2 := Xmax+Xstep;
            Y1 := Ymin-Ystep;
            Y2 := Ymax+Ystep;
            DrawCursor;    { erase }
            Xmin := X1;
            Xmax := X2;
            Ymin := Y1;
            Ymax := Y2;
            Xstep := StepFraction*(Xmax-Xmin);
            Ystep := StepFraction*(Ymax-Ymin);
            DrawCursor;
          END;
      END;
    END;                      { ExpandCursor }
    (* -------------------------------------------------------*)
    PROCEDURE ShrinkCursor;
    VAR
      X1, X2, Y1, Y2 : REAL;
    BEGIN
      IF ((Xmax-Xmin) > (2.0*XperPixel))
      AND ((Ymax-Ymin) > (2.0*YperPixel)) THEN
        BEGIN
          X1 := Xmin+Xstep;
          X2 := Xmax-Xstep;
          Y1 := Ymin+Ystep;
          Y2 := Ymax-Ystep;
          DrawCursor;   { erase }
          Xmin := X1;
          Xmax := X2;
          Ymin := Y1;
          Ymax := Y2;
          Xstep := StepFraction*(Xmax-Xmin);
          Ystep := StepFraction*(Ymax-Ymin);
          DrawCursor;
        END;
    END;                      { ShrinkCursor }
  (* -------------------------------------------------------*)

  BEGIN                       {BoxCursor }
    OldColor := GetColor;
    SetColor(ColorCursor);
    TextColor(ColorText);
    Xmin := 0.5*(WorldXmax+WorldXmin)-0.1*(WorldXmax-WorldXmin);
    Xmax := 0.5*(WorldXmax+WorldXmin)+0.1*(WorldXmax-WorldXmin);
    Ymin := 0.5*(WorldYmax+WorldYmin)-0.1*(WorldYmax-WorldYmin);
    Ymax := 0.5*(WorldYmax+WorldYmin)+0.1*(WorldYmax-WorldYmin);
    Xstep := StepFraction*(Xmax-Xmin);
    Ystep := StepFraction*(Ymax-Ymin);
    SetWriteMode(XORput);
    DrawCursor;
    REPEAT
      IF ShowXY THEN
        BEGIN
          GoToXY(Col,Row);
          Write('Xcenter = ',(0.5*(Xmax+Xmin)):16,
                '   Ycenter = ',(0.5*(Ymax+Ymin)):16);
        END;
      Ch := ReadKey;
      IF Ch = #0 THEN
        Ch := ReadKey;
      CASE Ch OF
        { UpArrow } #72 : IF ((Ymax+Ystep) <= WorldYmax-YperPixel) THEN
                            MoveCursor(0, Ystep)
                          ELSE
                            MoveCursor(0, WorldYmax-YperPixel-Ymax);
        { DownArrow } #80 : IF ((Ymin-Ystep) >= WorldYmin+YperPixel) THEN
                              MoveCursor(0, -Ystep)
                            ELSE
                              MoveCursor(0,WorldYmin+YperPixel-Ymin);
        {RightArrow } #77 : IF ((Xmax+Xstep) <= WorldXmax-XperPixel) THEN
                              MoveCursor(Xstep, 0)
                            ELSE MoveCursor(WorldXmax-XperPixel-Xmax,0);
        { LeftArrow } #75 : IF ((Xmin-Xstep) >= WorldXmin+XperPixel) THEN
                              MoveCursor(-Xstep, 0)
                            ELSE MoveCursor(WorldXmin+XperPixel-Xmin,0);
        { expand } '+' : ExpandCursor;
        { shrink } '-' : ShrinkCursor;
      END;                    {CASE }
      BoxXmin := Xmin;
      BoxXmax := Xmax;
      BoxYmin := Ymin;
      BoxYmax := Ymax;
    UNTIL Ch = #13;   { ENTER }
    DrawCursor;   { erase }
    SetColor(OldColor);
    IF ShowXY THEN
    BEGIN
      GoToXY(Col, Row);
      FOR J := Col to 79 DO
        write(' ');
    END;
    SetWriteMode(NormalPut);
  END;                        { BoxCursor }

(*************************************************************************)

PROCEDURE GetXYfromPixels(VAR X,Y : REAL; Xpos, Ypos : Integer);
  BEGIN
    X := WorldXmin + ((Xpos - WindowXMin)/(WindowXmax - WindowXmin))
                     *(WorldXmax - WorldXmin);
    Y := WorldYmin + ((WindowYmax - Ypos)/(WindowYmax - WindowYmin))
                     *(WorldYmax - WorldYmin);
  END;

(*************************************************************************)

FUNCTION MouseOK : Boolean;
BEGIN
  IF MouseDriverFound AND MouseReset THEN
    MouseOK := TRUE
  ELSE
    MouseOK := FALSE;
END;

(*************************************************************************)

PROCEDURE RestrictMouseToWindow;
BEGIN
  SetHorizCursorBounds(windowXmin,windowXmax);
  SetVertCursorbounds(windowYmin,windowYmax);
END;

(*************************************************************************)

FUNCTION LeftMouseXY(VAR X, Y :REAL): BOOLEAN;
VAR
  Xpos, Ypos : Integer;       { IF LeftButton Pressed THEN X Y are valid }
BEGIN                         { ELSE X Y NOT valid }
  IF LeftButtonPressed(Xpos, Ypos) THEN
      LeftMouseXY := TRUE
  ELSE
    LeftMouseXY := FALSE;
  GetXYfromPixels(X,Y,Xpos,Ypos);
END;

(*************************************************************************)

FUNCTION RightMouseXY(VAR X, Y :REAL): BOOLEAN;
VAR
  Xpos, Ypos : Integer;       { IF RightButton Pressed THEN X Y are valid }
BEGIN                         { ELSE X Y NOT valid }
  IF RightButtonPressed(Xpos, Ypos) THEN
      RightMouseXY := TRUE
  ELSE
    RightMouseXY := FALSE;
  GetXYfromPixels(X,Y,Xpos,Ypos);
END;

(*************************************************************************)

FUNCTION LeftButtonClicked(VAR X, Y : REAL) : Boolean;
VAR
  Xpos, Ypos : Integer;
Begin
  IF LeftButtonReleased(Xpos,Ypos) THEN
    LeftButtonClicked := TRUE
  ELSE
    LeftButtonClicked := FALSE;
  GetXYfromPixels(X, Y, Xpos, Ypos);
END;

(***************************************************************************)

FUNCTION RightButtonClicked(VAR X, Y : REAL) : Boolean;
VAR
  Xpos, Ypos : Integer;
Begin
  IF RightButtonReleased(Xpos,Ypos) THEN
    RightButtonClicked := TRUE
  ELSE
    RightButtonClicked := FALSE;
  GetXYfromPixels(X, Y, Xpos, Ypos);
END;

(***************************************************************************)

PROCEDURE GetMouseXY(VAR X,Y:REAL);  { returns mouse current position }
VAR
  Buttons, Xpos, Ypos : Integer;
BEGIN
  GetButtonsAndPosition(Buttons, Xpos, Ypos);
  GetXYfromPixels(X,Y,Xpos,Ypos);
END;

(*************************************************************************)

PROCEDURE MousePointer(VAR X, Y : REAL; Show : Boolean;
                       Row, Col : Integer; Color : BYTE);
VAR
  OldColor : BYTE;
  Xpos, Ypos : Integer;
  Xt, Yt : REAL;
BEGIN
  Xt := 1.0e20;
  Yt := 1.0E20;
  OldColor := TextAttr;
  If NOT MouseOk THEN
      BEGIN
        EndGraphic;
        WriteLn('MOUSE DRIVER NOT LOADED OR MOUSE HARDWARE NOT FOUND');
        HALT;
      END;
  RestrictMouseToWindow;
  ShowCursor;
  IF Show THEN
  BEGIN
    GoToXY(Col, Row);
    TextColor(Black);
    ClrEol;
    TextColor(Color);
  END;
  REPEAT
    GetMouseXY(X,Y);
    IF (X <> Xt) OR (Y <> Yt) THEN
    BEGIN
      Xt := X;
      Yt := Y;
      IF Show THEN
        BEGIN
          GOTOXY(Col, Row);
          Write('       X = ',X:12,'  Y = ',Y:12,
                  '     CLICK LEFT BUTTON TO EXIT');
        END;
    END;
  UNTIL  LeftButtonReleased(Xpos,Ypos);
  HideCursor;
  TextAttr := OldColor;
END; { MousePointer }

(*************************************************************************)

PROCEDURE MouseRubberBox(VAR X1,X2,Y1,Y2:REAL;Color : Word;
                         EraseBox : Boolean);
VAR
  x2t, y1t , xdum, ydum: REAL;
  Xpos, Ypos : INTEGER;

  BEGIN  { MouseRubberBox }
    If NOT MouseOk THEN
      BEGIN
        EndGraphic;
        WriteLn('MOUSE DRIVER NOT LOADED OR MOUSE HARDWARE NOT FOUND');
        HALT;
      END;
    RestrictMouseToWindow;
    ShowCursor;
    Repeat Until LeftButtonClicked(x1, y2); { initial upper left corner }
    REPEAT
      GetMouseXY(x2,y1);                    { initial lower right corner }
    UNTIL (x2 > x1)  AND (y1 < y2);
    hidecursor;
    SetWriteMode(XORput);
    plotrect(x1,x2,y1,y2,color);
    showcursor;
      x2t := x2;              { save initial lower right }
      y1t := y1;
    REPEAT
      REPEAT
        GetMouseXY(x2,y1);           { NEW lower right corner }
      UNTIL (x2 <> x2t) OR (y1 <> y1t);
      IF (x1 < x2) AND ( y1 < y2) THEN
      BEGIN
        hidecursor;
        PlotRect(x1,x2t,y1t,y2,color);  { erase old box }
        PlotRect(x1,x2,y1,y2,Color);  { show new box using new lower right }
        ShowCursor;
        x2t := x2; { save new lower right }
        y1t := y1;
      END;
    UNTIL LeftButtonClicked(xdum, ydum);

    HideCursor;           { drag box around }
      REPEAT
        GetMouseXY(x2t,y1t); { get new lower right corner for displacements }
        IF  (x2t <> x2) OR (y1t <> y1) THEN
        BEGIN
          PlotRect(x1,x2,y1,y2,color);  { erase old position }
          x1 := x1+x2t-x2;
          y2 := y2+y1t-y1;
          y1 := y1t;
          x2 := x2t;
          PlotRect(x1,x2,y1,y2,color);  { at new position }
        END;
      UNTIL LeftButtonClicked(x2t,y1t);

    IF EraseBox THEN
      plotrect(x1,x2,y1,y2,color);
    SetWriteMode(NormalPut);
    IF X1 > X2 THEN
    Begin
      X2t := X2;
      X2 := X1;
      X1 := X2t;
    End;
    IF Y1 > Y2 THEN
    Begin
      Y1t := Y1;
      Y1 := Y2;
      Y2 := Y1t;
    End;
  End; { MouseRubberBox }

(*************************************************************************)

PROCEDURE MouseRubberLine(VAR X1, Y1, X2, Y2 : REAL; Color : WORD;
                          EraseLine : Boolean);
VAR
  Xdum, Ydum, X2t, Y2t : REAL;
  OldColor : WORD;

BEGIN
  IF NOT MouseOk THEN
    BEGIN
      EndGraphic;
      WriteLn('NO MOUSE DRIVER LOADED OR NO MOUSE HARDWARE FOUND');
      HALT;
    END;
  OldColor := GetColor;
  RestrictMouseToWindow;
  ShowCursor;
  REPEAT UNTIL LeftButtonClicked(X1, Y1);
  HideCursor;
  X2 := X1;
  Y2 := Y1;
  SetWriteMode(XORput);
  PlotLine(X1,Y1,X2,Y2,Color);
  ShowCursor;
    REPEAT
      GetMouseXY(X2t, Y2t);
      IF (X2t <> X2) OR (Y2t <> Y2) THEN
      BEGIN
        HideCursor;
        PlotLine(X1,Y1,X2,Y2,Color);
        X2 := X2t;
        Y2 := Y2t;
        PlotLine(X1,Y1,X2,Y2,Color);
        ShowCursor;
      END;
    UNTIL LeftButtonClicked(Xdum, Ydum);
    HideCursor;
    If EraseLine THEN
      PlotLine(X1,Y1,X2,Y2,Color);
    SetWriteMode(NormalPut);
    SetColor(OldColor);
END;  { MouseRubberLine }

(*************************************************************************)

PROCEDURE MouseDraw(Color : WORD);
  VAR         { Draws while left button pressed.  Click right button to exit }
              { Drawing is left on screen }
    X1, Y1, X2, Y2, Xdum, Ydum : REAL;
    Xpos, Ypos : Integer;
    OldColor : WORD;
  BEGIN
    IF NOT MouseOK THEN
      BEGIN
        EndGraphic;
        WriteLn('Mouse Driver not loaded, or mouse hardware not found');
        Halt;
      END;
    OldColor := GetColor;
    SetColor(Color);
    ShowCursor;
    WHILE NOT RightButtonClicked(Xdum, Ydum) DO
      BEGIN
        WHILE LeftButtonPressed(Xpos, Ypos) DO
          BEGIN
            GetMouseXY(X1, Y1);
            REPEAT
              GetMouseXY(X2, Y2);
            UNTIL (X2 <> X1) OR (Y2 <> Y1);
            HideCursor;
            PlotLine(X1, Y1, X2, Y2, Color);
            ShowCursor;
            X1 := X2;
            Y1 := Y2;
          END;
      END;
    HideCursor;
    SetColor(OldColor);
  END;  { MouseDraw }

(*************************************************************************)

PROCEDURE GetPixelArea(CurveColor, RefillColor : Word; VAR Area : REAL);
  VAR
    X1, Y1 : Integer;
    F, D, Dx, Dy : Integer;
    Dfound : Boolean;
    Xmin, Xmax, Ymin, Ymax, X, Y : Integer;
    NumInside : LongInt;
    Xseed, Yseed : REAL;

  BEGIN
    IF MouseOK THEN
      MousePointer(Xseed, Yseed, False, 1, 1, Black)
    ELSE
      BEGIN
        SetWriteMode(XORput);
        CrossCursor(Xseed, Yseed, Green, False, 1, 1, Black);
        SetWriteMode(NormalPut);
      END;
    PlotMoveTo(Xseed, Yseed);
    REPEAT
      MoveRel(-1, 0);
    UNTIL GetPixel(GetX, GetY) = CurveColor;
    X1 := GetX;
    Y1 := GetY;
    Xmin := GetMaxX;
    Xmax := 0;
    Ymin := GetMaxY;
    Ymax := 0;
    F := 0;
    NumInside :=0;
    REPEAT
      Dfound := False;
        CASE F OF
          0 : D := 5;
          1 : D := 6;
          2 : D := 7;
          3 : D := 0;
          4 : D := 1;
          5 : D := 2;
          6 : D := 3;
          7 : D := 4;
        END;
      REPEAT
         CASE D OF
          6 : BEGIN  Dx := 0; Dy := -1; END;
          7 : BEGIN  Dx := -1; Dy := -1; END;
          0 : BEGIN  Dx := -1; Dy := 0; END;
          1 : BEGIN  Dx := -1; Dy := 1; END;
          2 : BEGIN  Dx := 0; Dy := 1; END;
          3 : BEGIN  Dx := 1; Dy := 1; END;
          4 : BEGIN  Dx := 1; Dy := 0; END;
          5 : BEGIN  Dx := 1; Dy := -1; END;
         END;
        MoveRel(Dx, Dy);
        X := GetX;
        Y := GetY;
        IF GetPixel(X, Y) = CurveColor THEN
          BEGIN
            Dfound := True;
            IF Xmin > X THEN Xmin := X
            ELSE
              IF Xmax < X THEN Xmax := X;
            IF Ymin > Y THEN Ymin := Y
            ELSE
              IF Ymax < Y THEN Ymax := Y;
          END
        ELSE
        BEGIN
          D := (D+1) MOD 8;
          MoveRel(-Dx, -Dy);
        END;
      UNTIL Dfound;
      F := D;
    UNTIL (X = X1) AND (Y = Y1);
    Flood(Xseed, Yseed, CurveColor, CurveColor);
    MoveTo(Xmin, Ymin);
    REPEAT
      X := GetX;
      REPEAT
        Y := GetY;
        IF GetPixel(X, Y) = CurveColor THEN
          BEGIN
            INC(NumInside);
            IF RefillColor <> Black THEN
              PutPixel(X, Y, RefillColor);
          END;
        INC(Y);
        MoveTo(X, Y);
      UNTIL Y > Ymax;
      INC(X);
      MoveTo(X, Ymin);
    UNTIL X > Xmax;
    Area := NumInside*XperPixel*YperPixel;
  END;

(*************************************************************************)

BEGIN                         { initialization of unit }
  WITH CurrentWorld DO
    BEGIN
      Xmn := -10.0;
      Xmx := 10.0;
      Ymn := -10.0;
      Ymx := 10.0;
    END;
  FOR J := 1 TO 10 DO
    BEGIN
      GraphicWorld[J] := CurrentWorld;
      ImageValid[J] := FALSE;
      SizeOfImage[J] := 0;
      WITH GraphicWindow[J] DO
        BEGIN
          Xmn := 0;           { full screen }
          Xmx := 100;
          Ymn := 0;
          Ymx := 100;
        END;
    END;
    Gdrvr := Detect;
END.