[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{$A+,B+,G-,I-,O-,V-,D-,L-,Q-,R-,S-,E-,N-  TP 7.0 Opt.}

program FastEllipseDrawingDemo320x400;    {02-05-96}

uses  Crt, Dos;

{********************************************************}
procedure SetTweakedMode320x400;

var   r: registers;

begin
  r.ax:=$13;   Intr($10,r);  {video mode 19: 320x200/256}
  portw[$3c4] := $0604;      {>64KByte Video-Ram, chain4 mode off}
  portw[$3d4] := $4009;      {max. scan line = 400}
  portw[$3d4] := $0014;      {word mode}
  portw[$3d4] := $E317;      {mode control}
  FillChar (ptr($A000,0)^, $8000, 0);  {clear memory}
end;
{*********************************************************}
procedure PutPixel (x,y: integer; color: word);

begin
{ if x < 0 then exit;
  if y < 0 then exit; }
  port[$03C4] := 2;            {plane selection}
  port[$03C5] := 1 shl (x and 3);
  mem [$A000: word (y shl 6 + y shl 4 + (x shr 2))] := color;
end;
{*********************************************************}
procedure DrawEllipse (mx,my, a,b, color: integer);

var   x,  mx1,mx2,  my1,my2: integer;
      aq,bq, dx,dy, r,rx,ry: longint;

begin
  PutPixel (mx + a, my, color);
  PutPixel (mx - a, my, color);

  mx1 := mx - a;   my1 := my;
  mx2 := mx + a;   my2 := my;

  aq := longint (a) * a;        {calc sqr}
  bq := longint (b) * b;
  dx := aq shl 1;               {dx := 2 * a * a}
  dy := bq shl 1;               {dy := 2 * b * b}
  r  := a * bq;                 {r  := a * b * b}
  rx := r shl 1;                {rx := 2 * a * b * b}
  ry := 0;                      {because y = 0}
  x := a;

  while x > 0
  do begin
    if r > 0
    then begin                  { y + 1 }
      inc (my1);   dec (my2);
      inc (ry, dx);             {ry = dx * y}
      dec (r, ry);              {r = r - dx + y}
    end;
    if r <= 0
    then begin                  { x - 1 }
      dec (x);
      inc (mx1);   dec (mx2);
      dec (rx, dy);             {rx = dy * x}
      inc (r, rx);              {r = r + dy * x}
    end;
    PutPixel (mx1, my1, color);
    PutPixel (mx1, my2, color);
    PutPixel (mx2, my1, color);
    PutPixel (mx2, my2, color);
  end;
end;
{*********************************************************}
const maxX = 319;   maxY = 399;

var   a,b: integer;

begin
  SetTweakedMode320x400;
  repeat
    a := 1+Random (100);
    b := 1+Random (100);
    DrawEllipse (a + Random (maxX - 2 * a),
                 b + Random (maxY - 2 * b), a,b,
                 1 + Random (255));
  until keypressed;
  TextMode(3);
end.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]