{--------------------------------------------------------------------------

                     HighSpeed Pascal for the Amiga

                             GRAPHICS DEMO

                  Programmed by Martin Eskildsen 1991

                  Copyright (c) 1991 by D-House I ApS
                         All rights reserved


  Version : Date (dd.mm.yy) : Comment
  -----------------------------------
    1.00 : 23.08.91 : First version
    1.01 : 17.09.91 : Revised for new library versions
    1.02 : 06.11.91 : Final for first release

--------------------------------------------------------------------------}

program GraphicsDemo;

uses Init, Intuition, Graphics;

{ In this example, we have chosen to show how "software clipping" can be
  done, as we would otherwise have to involve layers. Therefore all procs
  below do some checks to ensure the correctness of the produced coordinates
}

procedure DrawLines;
var
  i            : integer;               { FOR index }
  stepX, stepY : real;                  { X and Y increments }
  xoffs, yoffs : integer;               { Where to start }
begin
  with WorkArea do begin
    stepX := (maxX - minX) / 30;
    stepY := (maxY - minY) / 30;
    for i := 0 to 30 do with OutputWindow^ do begin
      xoffs := round(stepX * i);
      yoffs := round(stepY * i);
      Move_(RPort, minX, minY + yoffs);    Draw(RPort, minX + xoffs, maxY);
      Move_(RPort, maxX, minY + yoffs);    Draw(RPort, maxX - xoffs, maxY)
    end
  end
end;

procedure DrawEllipses;
var
  i            : integer;
  stepX, stepY : real;
  x, y         : integer;
begin
 with WorkArea do begin
   stepX := (maxX - minX - 6) / (30*2);
   stepY := (maxY - minY - 6) / (30*2);
   x     := (maxX - minX) div 2 + minX;
   y     := (maxY - minY) div 2 + minY;
   for i := 1 to 30 do with OutputWindow^ do
     DrawEllipse(RPort, x, y, round(i * stepX), round(i * stepY) )
 end
end;

{ The circle display presented by the below procedure isn't very nice, but
  here Commodore-Amiga is to blame for making a poor circle procedure }
procedure DrawCircles;
var
  i, x, y, r : integer;         { Index, x,y and radius }
begin
  with WorkArea do begin
    for i := 1 to 40 do begin
      repeat
        x := minX + random(maxX - minX);
        y := minY + random(maxY - minY);
        r := random(30);
      until (x-r >= minX) and (y-r >= minY) and
            (x+r <= maxX) and (y+r <= maxY);
      DrawCircle(OutputWindow^.RPort, x, y, r)
    end
  end
end;

procedure PlotPoints;
var x, y, i : integer;
    l       : longint;           { dummy value returned by WritePixel }
begin
  for i := 1 to 5000 do begin
    x := Random(WorkArea.maxX);
    y := Random(WorkArea.maxY);
    if LegalPosition(x, y) then l := WritePixel(OutputWindow^.RPort, x, y)
  end
end;

procedure FillRectangles;
var
  i                     : integer;
  color, Ocolor         : integer;      { Fill and Outline colors }
  x1, y1, x2, y2        : integer;      { Upper, lower corners }
begin
  for i := 1 to 1000 do begin
    color  := Random(4);
    Ocolor := Random(4);
    repeat
      x1 := Random(WorkArea.maxX);  y1 := Random(WorkArea.maxY);
      x2 := Random(WorkArea.maxX);  y2 := Random(WorkArea.maxY);
      SwapMin(x1, x2);  { Make sure (x1, y1) < (x2, y2) }
      SwapMin(y1, y2)
    until LegalPosition(x1, y1) and LegalPosition(x2, y2) and (x1 < x2) and (y1 < y2);
    with OutputWindow^ do begin
      SetAPen (RPort,  color);                  { Fill color }
      SetOPen (RPort, Ocolor);                  { Outline color }
      RectFill(RPort, x1, y1, x2, y2)           { Do the fill }
    end
  end
end;

begin
  if PrepareEnvironment('Simple Graphics') then begin

    OpenOutputWindow;

    Message('First, the Lines');
    DrawLines;

    Message('Let''s get Elliptical');
    ClearOutputWindow;
    DrawEllipses;

    Message('While we''re at it: Some "Circles" ...');
    ClearOutputWindow;
    DrawCircles;

    Message('Not to mention the Points');
    ClearOutputWindow;
    PlotPoints;

    Message('And finally the Filled Rectangles');
    ClearOutputWindow;
    FillRectangles;

    Message('Wow! That''s it then - get rid of that window!');
    CloseOutputWindow;
    CloseDown
  end
end.