
{ animation unit for BGI256 demo program }
{ as of 26 Dec 1994 }

{$R-}
unit AniSub;
interface

uses crt,graph,Wrmode,lpunit;

procedure CreateSaucer(SaucerSize:word);
procedure DoSaucer;
procedure VertWait(Cnt:word);
procedure StartMouse;

TYPE  ByteArray = array[0..64000] of byte;
{TYPE  SpriteRecord = record
                       Width,Height,OldX,OldY:integer;
                       Image,Old:pointer
                     end; }

const MaxAni = 9;

var Si,Ai,R,Xr,Yr : integer;
    MoveDelay : word;
    StartX,StartY,StepX,StepY : integer;
    Rx,Ry : integer;
    SX,SY,DX,DY,Ax,Ay,X1,Y1,X2,Y2 : integer;
    AniSize : word;
    PT,PM:^ByteArray;
    ArcCoords : ArcCoordsType;
    Xasp,Yasp:word;
    TSIZE : longint;
    ok,done : boolean;
    CH : char;
    oldtime,aborttime : longint;
    TmpS,TempAC : word;
    Ts1,Ts2,Ts3 : string[40];
    AniImage : array[0..MaxAni] of SpriteRecord;

    SysClock : word absolute $40:$6C;

CONST UserFillPattern : FillPatternType = ($AA,$55,$AA,$55,$AA,$55,$AA,$55);

const AnimateStyle : word = 0; {0=std bgi, 1=quick ani, 2=low flicker}
      OldClock : word = 0;
      AniCount : word = 0;
      VertCount : word = 1;
      SpriteCount : word = 0;
      ActiveCount : word = 0;
      BounceSpeed : word = 1;
      usemouse : boolean = false;
      bounce : boolean = true;

const ShowArea = false;
      SCmask = $7;
      MaxInt = $8000;

implementation

function Limit(What,Low,High:integer):integer;
begin
  if What < Low then Limit := Low
  else if What > High then Limit := High
  else Limit := What;
end;

function fstr(L:longint):string;
var S:string;
begin
  str(L,S);
  fstr := S;
end;

{C0=background color, C1=outline color, C2=eye stalk color,}
{C3=eye color, C4=pupil color, C5=fill color, C6=fill border color}
procedure MakeSaucerImage(C0,C1,C2,C3,C4,C5,C6:word);
begin
  setLineStyle(SolidLn,0,1);
  SetFillStyle(SolidFill,C0);
  Bar(x1,y1,x2,y2);
  SetColor(C1); {lightCyan}
  Ellipse(StartX, StartY-(Ry div 8), 190, 357, r, r div 4);
  Ellipse(StartX, StartY, 0, 360, r, (r div 2));
  GetArcCoords(ArcCoords);
  SetColor(C2);   {lightblue}
  Line(StartX+(Rx div 3), StartY-((Ry*3)div 8), StartX+(Rx div 2), StartY-((Ry*3)div 4));
  Line(StartX-(Rx div 3), StartY-((Ry*3)div 8), StartX-(Rx div 2), StartY-((Ry*3)div 4));
  SetColor(C3); {lightRed}
  Circle(StartX+(Rx div 2), StartY-((Ry*3)div 4), 2);
  Circle(StartX-(Rx div 2), StartY-((Ry*3)div 4), 2);
  SetColor(C4);  {White}
  PutPixel(StartX+(Rx div 2), StartY-((Ry*3)div 4), C4);
  PutPixel(StartX-(Rx div 2), StartY-((Ry*3)div 4), C4);
  SetWriteMode(FillMode+BorderFill);
  SetWriteMode(FillMode+AutoFill);
  SetFillPattern(UserFillPattern, C5);  {Cyan}
  FloodFill(StartX, StartY+(Ry div 3)+2, C6); {LightCyan}
end;

procedure StartMouse;
var rax,ray:word;
begin
  if usemouse then
  begin
    rax := GetMaxX;
    ray := GetMaxY;
    asm
      mov ax,0 {init mouse}
      int $33
      mov cx,0
      mov dx,[rax]
      mov ax,7
      int $33
      mov cx,0
      mov dx,[ray]
      mov ax,8
      int $33
    end;
  end;
end;

procedure CreateSaucer(SaucerSize:word);
var BadSize : boolean;
    i,t1,t2 : integer;
    Xasp,Yasp : word;
    rax,ray:word;
begin
  StartMouse;
  R := SaucerSize;
  MoveDelay := 0;
  StartX := GetMaxX div 2;
  StartY := GetMaxY div 2;
  GetAspectRatio(Xasp,Yasp);
  BadSize := true;
  while BadSize do
  begin
    Rx := r;
    Ry := (r*Xasp) div Yasp;
    X1 := StartX-rx-1;
    Y1 := StartY-ry-1;
    X2 := StartX+rx+1;
    Y2 := StartY+ry+1;
    if (longint(X2 - X1) * longint(Y2 - Y1) < 65500) and
       (X1 > 0) and (X2 < GetMaxX) and
       (Y1 > 0) and (Y2 < GetMaxY) then
      BadSize := false
    else
      R := 20;
  end;
  Xr := X2-X1;
  Yr := Y2-Y1;
  AniSize := ImageSize(x1,y1,x2,y2);
  GetMem(PT,AniSize);
  SetWriteMode(MiscCommand+SetGetImageReadOnly);
  GetImage(x1,y1,x2,y2,PT^);
   GetMem(PM,AniSize);
   MakeSaucerImage(255,0,0,0,0,0,0);
   GetImage(x1,y1,x2,y2,PM^);

  SpriteCount := 0;
  for i := 0 to MaxAni do
  begin
    if MaxAvail+2000 > (AniSize*2) then
    begin
      GetMem(AniImage[i].Image,AniSize);
      MakeSaucerImage(Black,
                      ((pred(LightCyan)+i) mod 15)+1,
                      LightBlue,LightRed,White,
                      ((pred(Cyan)     +i) mod 15)+1,
                      ((pred(LightCyan)+i) mod 15)+1);
      GetImage(x1,y1,x2,y2,AniImage[i].Image^);
      AniImage[i].Width := 0;
      AniImage[i].Height := 0;
      AniImage[i].OldX := x1;
      AniImage[i].OldY := y1;
      SetColor(yellow);
      Rectangle(x1,y1,x2,y2);
      GetMem(AniImage[i].Old,AniSize);
      inc(SpriteCount);
    end
    else
    begin
      AniImage[i].Old := nil;
    end;
  end;

  Tsize := MaxAvail;
  PutImage(x1,y1,PT^,CopyPut);
  Ax := x1;
  Ay := y1;
end;

function AniIn(X1,Y1,X2,Y2:integer):boolean;
var i : integer;
begin
  AniIn := true;
  for i := 0 to ActiveCount do
  begin
    with AniImage[i] do
    begin
    if ( (OldX+Xr >= X1) and (OldX <= X2+Xr) ) and
       ( (OldY+Yr >= Y1) and (OldY <= Y2+Yr) ) then Exit;
    end;
  end;
  AniIn := false;
end;

procedure VertWait(Cnt:word);
var i:word;
begin
  aborttime := 0;
  for i := 1 to cnt do
  begin
    aborttime := aborttime+DisplaySync;
  end;
end;

procedure DoSaucer;
var rax,ray:word;
begin
 { HeapLimit := 0;}

  CreateSaucer(GetMaxY div 10);
  StepX := random(r div 4)+1;
  StepY := random(r div 4)+1;
  AniCount := 0;
  ActiveCount := 0;
  word(AniImage[0].OldX) := {Ax} MaxInt ;
  word(AniImage[0].OldY) :={ Ay} MaxInt ;
  AniImage[0].Width  := 0;
  AniImage[0].Height := 0;
  SetWriteMode(MiscCommand+SetGetImageReadOnly);
(*
  GetImage(Ax,Ay,Ax+Xr,Ay+Yr,AniImage[0].Old^); {get copy of initial image}
*)
  SetWriteMode(MiscCommand+SetGetImageReadWrite);
  SetWriteMode(GetImageMode+ForeMoveWrite); {set getimage write mode}
  oldtime := 0;
  done := false;
  Ts1 := '';
  Ts2 := '';
  Ts3 := '';
  while not(Done) do
  begin
    if AnimateStyle = 0 then
    begin
      SetWriteMode(MiscCommand+SetGetImageReadOnly);
    end
    else
    begin
      SetWriteMode(MiscCommand+SetGetImageReadWrite);
      SetWriteMode(GetImageMode+ForeMoveWrite); {set getimage write mode}
    end;

    for ai := 0 to ActiveCount do
    begin
      ok := false;
      while not(ok) do
      begin
        if usemouse then
        begin
          asm
            mov ax,3
            int $33
            mov [rax],cx
            mov [ray],dx
          end;
          ax := rax;
          ay := ray;
        end
        else if Bounce then
        begin
          Ax := Ax+StepX;
          Ay := Ay+StepY;
          if ((Ax > GetMaxX-Xr) or (Ax < 0)) then

          begin
            rax := random(2);
            StepX := BounceSpeed+1;
            if rax < 1 then
              StepX := -StepX;
          end;
          if ((Ay > GetMaxY-Yr) or (Ay < 0)) then
          begin
            ray := random(2);
            StepY := BounceSpeed+1;
            if ray < 1 then
              StepY := -StepY;

            Ax := Ax+StepX;
            Ay := Ay+StepY;
          end;
        end
        else
        begin
          StepX := Random(r div 4);
          if StepX mod 2 > 0 then
            StepX := -StepX;
          Ax := Ax + StepX;
          StepY := Random(r div 4);
          if StepY mod 2 > 0 then
            StepY := -StepY;
          Ay := Ay + StepY;
        end;
        Ax := limit(Ax,0,GetMaxX-Xr); {point to new location}
        Ay := limit(Ay,0,GetMaxY-Yr);
        ok := true;
        if ActiveCount > 0 then
        begin
          if (Ax <= Xr) and (Ay <= Yr) then ok := false
          else
          begin
            for si := 0 to ActiveCount do
            begin
              if ( (Ax+Xr >= AniImage[si].OldX) and (Ax <= AniImage[si].OldX+Xr) ) and
                 ( (Ay+Yr >= AniImage[si].OldY) and (Ay <= AniImage[si].OldY+Yr) ) and
                 ( si <> ai ) then
                ok := false;
            end;
          end;
        end;
      end;
      AniImage[ai].Width  := Xr;
      AniImage[ai].Height := Yr;

      {critical animation code here}
      case AnimateStyle of
       2: begin  {low flicker animation method}
            PutImage(Ax,Ay,AniImage[ai],PutAniMode+ForeMoveWrite);
          end;
       1: begin  {Quick Animate method}
           if not ((AniImage[ai].OldX = Ax) and (AniImage[ai].OldY = Ay)) then
           begin
            move(AniImage[ai].Image^,PT^,AniSize);   {get animation image again}
            if (AniImage[ai].OldX <> $8000) and (AniImage[ai].OldY <> $8000) then
            begin
              PutImage(AniImage[ai].OldX,AniImage[ai].OldY,
                       AniImage[ai].Old^,CopyPut);     {restore old image}
            end;
            GetImage(Ax,Ay,Ax+Xr,Ay+Yr,PT^);         {get/put new image}
            move(PT^,AniImage[ai].Old^,AniSize);     {save the old image}
            if showarea then
              rectangle(Ax,Ay,Ax+Xr,Ay+Yr);
            AniImage[ai].OldX := Ax;  {save the position}
            AniImage[ai].OldY := Ay;
           end;
          end;
       else begin   {std bgi animation method}
             if not ((AniImage[ai].OldX = Ax) and (AniImage[ai].OldY = Ay)) then
             begin
              if (AniImage[ai].OldX <> $8000) and (AniImage[ai].OldY <> $8000) then
              begin
                PutImage(AniImage[ai].OldX,AniImage[ai].OldY,
                         AniImage[ai].Old^,CopyPut);     {restore old image}
              end;
              GetImage(Ax,Ay,Ax+Xr,Ay+Yr,AniImage[ai].Old^); {get/put new image}
              PutImage(Ax,Ay,PM^,AndPut);                    {mask foreground}
              PutImage(Ax,Ay,AniImage[ai].Image^,OrPut);     {write new image}
              AniImage[ai].OldX := Ax;  {save the position}
              AniImage[ai].OldY := Ay;
             end;
            end;
      end; {case}
    end;

    VertWait(VertCount);

    DY := 25;
    DX := 74;
    if not AniIN(DX,DY,DX+130,DY+10) then
    begin
      if (aborttime > oldtime) or
         ( (aborttime = 0) and (oldtime <> 0) ) or
         ( (Aborttime < oldtime) and (SysClock and not(SCmask) <> OldClock)) then
      begin
        setcolor(black);
        outtextxy(DX,DY,Ts2); {'Dly:'+fstr(oldtime));}
        oldtime := aborttime;
        Ts2 := 'Dly '+fstr(AnimateStyle)+':'+fstr(aborttime);
        setcolor(green);
        outtextxy(DX,DY,Ts2);   {'Dly:'+fstr(aborttime));}
      end
    end;

    SY := 35;
    SX := 74;
    inc(AniCount);
    if not AniIN(SX,SY,SX+95+95,SY+10) then
    begin
      if (SysClock and not(SCmask)) <> OldClock then
      begin
        OldClock := SysClock and not(SCmask);
        TempAC := succ(ActiveCount)*pred(AniCount)*round(1/(0.055*succ(SCmask)));
        TmpS := succ(ActiveCount);
        setcolor(black);
        outtextxy(SX,SY,Ts1); {'SPS:'+fstr(OldAniCount));}
        Ts1 := 'SPS '+fstr(TmpS)+':'+fstr(TempAC);
        setcolor(cyan);
        outtextxy(SX,SY,Ts1);
        setcolor(black);
        outtextxy(SX+100,SY,Ts3);
        Ts3 := 'A'+fstr(animatestyle)+':V'+fstr(Vertcount)+':B'+fstr(BounceSpeed);
        setcolor(magenta);
        outtextxy(SX+100,SY,Ts3);
        AniCount := 0;
      end;
    end;

    if (MoveDelay > 0) and not usemouse then delay(MoveDelay);
    CH := #255;
    if Keypressed then
    begin
      CH := READKEY;
      IF CH = #0 THEN CH := char(ord(READKEY)+$80);
    end;
    if (CH >= '0') and (CH <= '9') then
      MoveDelay := sqr(ord(CH) - $30)*5
    else if (CH < #32) or (upcase(CH) = 'Q') then
      Done := true;

    if CH = '+' then
    begin
      if succ(ActiveCount) < SpriteCount then
      begin
        inc(ActiveCount);
        SetWriteMode(MiscCommand+SetGetImageReadOnly);
        GetImage(0,0,Xr,Yr,AniImage[ActiveCount].Old^); {get copy of initial image}
        SetWriteMode(MiscCommand+SetGetImageReadWrite);
        AniImage[ActiveCount].OldX := 0;
        AniImage[ActiveCount].OldY := 0;
      end;
    end;
    if CH = '-' then
    begin
      if ActiveCount > 0 then
      begin
        PutImage(AniImage[ActiveCount].OldX,AniImage[ActiveCount].OldY,
                 AniImage[ActiveCount].Old^,CopyPut); {get copy of initial image}
        AniImage[ActiveCount].OldX := 0;
        AniImage[ActiveCount].OldY := 0;
        dec(ActiveCount);
      end;

    end;

    if upcase(ch) = 'A' then
    begin
      inc(AnimateStyle);
      if BGIversion = 302 then
      begin
        if AnimateStyle > 1 then AnimateStyle := 0
      end
      else if BGIversion > 0 then
      begin
        if AnimateStyle > 2 then AnimateStyle := 0
      end
      else AnimateStyle := 0;
    end;

    if upcase(ch) = 'V' then
    begin
      inc(VertCount);
      if VertCount > 5 then VertCount := 0;
    end;

    if upcase(ch) = 'B' then
    begin
      inc(BounceSpeed);
      if BounceSpeed > 5 then BounceSpeed := 0;
    end;

    if upcase(ch) = 'M' then
    begin
      usemouse := not usemouse;
      StartMouse;
    end;

    if upcase(ch) = 'P' then PrintScreen(0,1,true);

  end;

  SetWriteMode(MiscCommand+SetGetImageReadOnly);

  {release heap memory allocations}
  for ai := 0 to MaxAni do
    if AniImage[ai].Old <> nil then
      Freemem(AniImage[ai].Old,AniSize);
  if PT <> nil then
    Freemem(PT,AniSize);
  if PM <> nil then
    Freemem(PM,AniSize);
end;

begin
  PM := nil;
  PT := nil;
  fillchar(AniImage,sizeof(AniImage),0);
end.
