Program HiresGraphics_Amstrad_PC1512;

{$U+}

{
    EGA1512.inc   ******************************************

  routines for using the 16 Colour mode on the Amstrad PC1512

   *********************************************************
 }


Const
  BitValue : array[0..3] of byte = (1,2,4,8); {weighting of bits 1-4}


procedure Amstrad_16_Colour_Graphics (Paper, Border : byte);

{
  Initiates the Amstrad PC 1512 16-Colour mode with a predefined
  border and paper colour by writing to the necessary ports.
}

begin
  Hires;                 {select 640 x 200 display}

  Port[$3D9] := $0F;     {enable 16 colour mode   }
  Port[$3DF] := Border;  {set border colour       }
  Port[$3DD] := Paper;   {sets which planes to be written to}

  FillChar (Mem[$B800:0],$4000,$FF)  {sets screen to Paper Colour}
end;


Procedure Colour (Ink : byte);

{ Sets which colour planes to write to }

begin
  Port[$3DD] := Ink
end;

Procedure Pset (x,y,colour : integer);

{
  Sets a given pixel to the specified colour.
  Examines each colour plane in turn and uses the
  Turbo Pascal Plot statement to set or reset
  the relevant pixel in the plane.
}

var
  Plane : integer;
begin
  for plane := 0 to 3 do     {each plane in turn}
  begin
    Port[$3DD] := BitValue[Plane];
    Port[$3DE] := Plane;
    if (colour AND BitValue[plane]) <> 0 then
          Plot(x,y,1)
       else
          Plot(x,y,0)
  end
end;

Procedure DrawLine(x1,y1,x2,y2,Colour : Integer);
{
  Draws a line in a given colour.
  Examines each plane in turn and uses the Turbo
  Pascal Draw statement to draw the line by
  setting bits in the relevant planes and resetting
  the bits in the other planes
}

Var
  Plane : integer;
begin
  for plane := 0 to 3 do  {each plane in turn}
  begin
    Port[$3DD] := BitValue[Plane]; {set the plane to write to }
    Port[$3DE] := Plane;           {and read from             }

    if (colour AND BitValue[plane]) <> 0 then
        Draw(x1,y1,x2,y2,1)
      else
        Draw(x1,y1,x2,y2,0)
  end
end;

procedure DrawCircle(xc,yc,r,colour:integer);

{ Uses the Michener implementation of Bresenham's algorithm:
  see Foley & van Dam (1983) Fundamentals of Interactive
  Computer Graphics, Published by Addison-Wesley, p445
}

  procedure CirclePoints(xc,yc,x,y,colour:integer);

   begin
    pset(xc+x,yc+y shr 1,colour);
    pset(xc+y,yc+x shr 1,colour);
    pset(xc+y,yc-x shr 1,colour);
    pset(xc+x,yc-y shr 1,colour);
    pset(xc-x,yc-y shr 1,colour);
    pset(xc-y,yc-x shr 1,colour);
    pset(xc-y,yc+x shr 1,colour);
    pset(xc-x,yc+y shr 1,colour)
  end;

var
  x,y,d : integer;
begin
  x := 0;
  y := r;
  d := 3 - r shl 1;
  while x < y do
    begin
      CirclePoints(xc,yc,x,y,colour);
      if d < 0
       then d := d + x * 4 + 6
      else
        begin
          d := d + (x-y) * 4 + 10;
          y := y - 1
        end;
     x := x + 1
    end;
     if x = y then CirclePoints(xc,yc,x,y,colour)
  end;

procedure DrawBox(x1,y1,x2,y2,colour:integer);

{
  Draws a single line box in a defined colour.
  x1, y1 are coords of top-left-hand corner
  x2, y2 are coords of bottom-right-hand corner
}

begin
  DrawLine(x1,y1,x2,y1,colour);
  DrawLine(x2,y1,x2,y2,colour);
  DrawLine(x2,y2,x1,y2,colour);
  Drawline(x1,y2,x1,y1,colour)
end;

procedure FillBox(x1,y1,x2,y2,colour:integer);

{
  Draws a rectangle filled with specified colour.
  x1,y1 are coords of top-left-hand corner.
  x2, y2 are coords of bottom-right-hand corner.
  These will be adjusted to the nearest whole byte.
  (Uses shift instructions for speed to calculate
  screen addresses.)
}

Var
  offset,b,y,plane,length : integer;
begin
  offset := (y1 shr 1)*80 + (y1 and 1)*8192 + x1 shr 3;
  length := (x2-x1+7) shr 3;
  for y := y1 to y2 do
    begin
      for plane := 0 to 3 do
        begin
          Port[$3DD] := BitValue[Plane];
          if (colour and BitValue[Plane]) <> 0 then
              b := $FF
            else
              b := 0;
          if odd(y) then
              FillChar(Mem[$BA00:offset],length,b)
            else
              FillChar(Mem[$B800:offset],length,b);
        end;
      if odd(y) then offset := offset + 80
    end
end;