
{ Animation line/ellipse demo program for BGI256 }
{ as of 24 April 1993  written by Michael Day }

program Animate;
uses crt,graph,WrMode;

type ByteArray = array[0..64520] of byte;

const DrawColor : word = white;

var gm,gd:integer;
    done : boolean;
    bx,by,kx,ky:integer;
    oldbx,oldby,OldKx,OldKy:integer;
    PO:^ByteArray;
    Auto : boolean;
    alldone : boolean;
    delaytime: integer;
    TopPoint : boolean;
    s : string[10];
    LineType : word;
    index : word;
    oldindex : word;
    ch : char;
    OldHow,how : word;
    OldDrawColor : word;

const
    UpArrow = char(72+128);
    DnArrow = char(80+128);
    LeftArrow = char(75+128);
    RightArrow = char(77+128);


procedure PlotPixel(Draw:boolean; X,Y:integer);
begin
  if Draw then
  begin
    Po^[Index] := GetPixel(x,y);         {plot the pixel}
  end
  else
  begin
    if Po^[Index] <> OldDrawColor then  {is it ok to undraw?}
      PutPixel(x,y,Po^[Index]);         {yes, undraw the pixel}
  end;
  inc(Index);
end;

{--------------------------------------------}
{plot a line on screen }
procedure doline(Draw:boolean; x1,y1,x2,y2:integer);
var  x,y,xstep,ystep,deltax,deltay,direction : integer;
begin
  SetWriteMode(MiscCommand+SetGetPixelReadWrite);
  SetColor(DrawColor);
  x := x1;
  y := y1;
  if x1 = x2 then xstep := 0
    else if x1 > x2 then xstep := -1
      else xstep := 1;
  if y1 = y2 then ystep := 0
    else if y1 > y2 then ystep := -1
      else ystep := 1;
  deltax := abs(x2 - x1);
  deltay := abs(y2 - y1);
  if deltax = 0 then direction := -1
    else direction := 0;
  PlotPixel(Draw,X,Y);
  repeat
    if direction < 0 then
    begin
      y := y + ystep;
      direction := direction + deltax;
      if ((direction >= 0) or (LineType > 0)) then
        PlotPixel(Draw,X,Y);
    end
    else
    begin
      x := x + xstep;
      direction := direction - deltay;
      if ((direction >= 0) or (LineType > 1)) then
        PlotPixel(Draw,X,Y);
    end;
  until ((y = y2) and (x = x2));
end;

{----------------------------------------------------}
{draw a rectangle}
procedure dorect(Draw:boolean; x1,y1,x2,y2:integer);
begin
  doline(Draw,x1,y1,x2,y1);
  doline(Draw,x2,y1,x2,y2);
  doline(Draw,x2,y2,x1,y2);
  doline(Draw,x1,y2,x1,y1);
end;

{----------------------------------------------------}
{draw an ellipse}
procedure DoEllipse(Draw:boolean; x,y,Rx,Ry:integer);
var xo,yo : integer;
  procedure SetQuad;
  begin
    PlotPixel(Draw,x-xo,y-yo);
    PlotPixel(Draw,x+xo,y+yo);
    if (xo = 0) or (yo = 0) then Exit;
    PlotPixel(Draw,x+xo,y-yo);
    PlotPixel(Draw,x-xo,y+yo);
  end;

var d,dx,dy,RxSqr,RySqr,RxSqr2,RySqr2: longint;
begin
  SetWriteMode(MiscCommand+SetGetPixelReadWrite);
  SetColor(DrawColor);
  xo := 0;
  yo := Ry;
  RxSqr  := Rx*Rx;
  RxSqr2 := RxSqr*2;
  RySqr  := Ry*Ry;
  RySqr2 := RySqr*2;
  d := RySqr-(RxSqr*Ry)+(RxSqr div 4);
  dx := 0;
  dy := Ry*RxSqr2;
  while dx < dy do
  begin
    SetQuad;
    if d > 0 then
    begin
      dec(yo);
      dy := dy-RxSqr2;
      d := d-dy;
    end;
    inc(xo);
    dx := dx+RySqr2;
    d := d+dx+RySqr;
  end;
  d := d + ((((3*(RxSqr-RySqr)) div 2)-(dx+dy)) div 2);
  while yo >= 0 do
  begin
    SetQuad;
    if d < 0 then
    begin
      inc(xo);
      dx := dx+RySqr2;
      d := d+dx;
    end;
    dec(yo);
    dy := dy-RxSqr2;
    d := d-dy+RxSqr;
  end;
end;


{-----------------------------------------------------}
{convert integer to string}
function fstr(I:integer):string;
var s : string;
begin
  str(I,S);
  fstr := S;
end;

{your basic limit function}
function Limit(Num,Start,Stop:integer):integer;
begin
  if Num < Start then Limit := Start
  else if Num > Stop then Limit := Stop
  else Limit := Num;
end;


{put a background on the screen}
procedure MakeScreen;
begin
  SetColor(Red);
  setfillstyle(SolidFill,red);
  bar(GetMaxX div 3,GetMaxY div 3,(GetMaxX div 3)*2,(GetMaxY div 3)*2);
  SetColor(Yellow);
  rectangle(GetMaxX div 4,GetMaxY div 4,(GetMaxX div 4)*3,(GetMaxY div 4)*3);
  setColor(Green);
  Circle(GetMaxX div 2,GetMaxY div 2,GetMaxY div 2);
  setcolor(blue);
  OutTextxy(0,GetMaxY-10,#24+#25+#26+#27+'=MovPt "T"=CtrlPt "A"=Ani 0-9=Spd');
  OutTextxy(0,0,'X:'+fstr(GetMaxX+1)+' Y:'+fstr(GetMaxY+1));
end;

{process keyboard input}
procedure GetKey;
var Tx,Ty : integer;
begin
  Tx := 0;
  Ty := 0;
  ch := readkey;
  if ch = #0 then
    ch := char(ord(readkey)+$80);
  case upcase(ch) of
    'Q',#$1b   : done := true;
    UpArrow    : Ty := -5;
    DnArrow    : Ty := 5;
    LeftArrow  : Tx := -5;
    RightArrow : Tx := 5;
           'A' : Auto := not(Auto);
      '0'..'9' : DelayTime := sqr(ord(ch) and $f)*5;
           'T' : TopPoint := not(TopPoint);
           'C' : DrawColor := limit(succ(DrawColor) and $f,1,GetMaxColor);
           'L' : How := 0;
           'R' : How := 1;
           'E' : How := 2;
  end;  {case}
  if TopPoint then
  begin
    Bx := Limit(Bx+Tx,0,GetMaxX);
    By := Limit(By+Ty,0,GetMaxY);
  end
  else
  begin
    Kx := Limit(Kx+Tx,0,GetMaxX);
    Ky := Limit(Ky+Ty,0,GetMaxY);
  end;
end;

{----------------------------------------------------------}
{handle object request}
procedure DoIt(How:word; Draw:boolean; x1,y1,x2,y2:integer);
var a,b,c,d:integer;
begin
  index := 0;
  case How of
    0:doline(Draw,x1,y1,x2,y2);
    1:dorect(Draw,x1,y1,x2,y2);
    2:begin
        a := (x1 div 4)+(getmaxX div 3);
        b := (y1 div 4)+(getmaxy div 3);
        c := abs(x2 - x1) div 4;
        d := abs(y2 - y1) div 4;
        doellipse(Draw,a,b,c,d);
      end;
  end;
end;

{do the demo}
procedure doDemo;
begin
  Kx := GetMaxX div 2;
  Ky := GetMaxY div 2;
  OldKx := Kx;
  OldKy := Ky;
  Bx := 240;
  By := 150;
  OldBx := Bx;
  OldBy := By;
  OldHow := 0;
  How := 0;
  Auto := false;
  DelayTime := 100;
  LineType := 3;
  OldDrawColor := DrawColor;

  done := false;
  doit(How,true,Bx,By,Kx,Ky);  {draw initial line}
  repeat
    if KeyPressed then GetKey;
    if Auto then
    begin
      How := random(3);
      Kx := random(GetMaxX);
      Ky := random(GetMaxY);
      Bx := random(GetMaxX);
      By := random(GetMaxY);
      delay(DelayTime);
    end;
    if (Bx <> OldBx) or (By <> OldBy) or (Kx <> OldKx) or (Ky <> OldKy) then
    begin
      doit(OldHow,false,OldBx,OldBy,OldKx,OldKy);  {undraw the line}
      doit(How,true,Bx,By,Kx,Ky);   {draw new line}
      OldHow := How;
      OldBx := Bx;
      OldBy := By;
      OldKx := Kx;
      OldKy := Ky;
      OldDrawColor := DrawColor;

      if oldindex < index then
      begin
        setfillstyle(SolidFill,black);
        bar((GetMaxX div 3)*2,0,GetMaxX,10);
        outtextxy((GetMaxX div 3)*2,0,'Index:'+Fstr(OldIndex));
        oldindex := index;
      end;
    end;
  until done;
end;

{----------------------------}
{main code starts here}
begin
  new(PO);
  fillchar(PO^,sizeof(PO^),0);
  gm := 0;
  if ParamCount > 0 then
  begin
    S := ParamStr(1);
    gm := ord(s[1]) and $0f;
  end;
  gd := InstallUserDriver('BGI256',nil);
  initGraph(gd,gm,'');
  MakeScreen;
  DoDemo;
  CloseGraph;
end.
