(* *************************************************************** *)
   (*                                                                 *)
   (*                         SPRITES.INC                             *)
   (*                                                                 *)
   (*   These are the definitions and procedures needed to implement  *)
   (*   the sprites and animation package. You may delete any that    *)
   (*   are not used in your program. To keep the display procedures  *)
   (*   simpler ( and thus hopefully faster ) I have written four     *)
   (*   separate ones. It is unlikely that you will want to use all   *)
   (*   four in a single program.                                     *)
   (*                                                                 *)
   (*   Keep in mind that the sprites and procedures are byte based.  *)
   (*   That means that sprites can only be displayed at a byte       *)
   (*   boundary when placed on the screen. This is not much of a     *)
   (*   restriction, but it does mean the the x-coordinate passed to  *)
   (*   the display procedures should be a multiple of four pixels :  *)
   (*   0,4,8,12,16,20,24 ..... etc. Also, any steps used for ani-    *)
   (*   mation should move the sprite a multiple of four pixels as    *)
   (*   well. There is no checking of the display coordinates. It is  *)
   (*   left to the programmer. If a sprite overlaps the edge of the  *)
   (*   screen, it will wrap around to the other side.                *)
   (*                                                                 *)
   (*   The CENTER of the sprite is displayed at the specified x,y    *)
   (*   coordinates.                                                  *)
   (*                                                                 *)
   (*   If you use direct XOR animation, you should use a delay just  *)
   (*   after displaying the sprite (say, Delay(75) ). You need to    *)
   (*   give the viewer time to see and understand the object. Rapid  *)
   (*   XOR animation looks vague and ghostly and the objects dis-    *)
   (*   played appear to flicker.                                     *)
   (*                                                                 *)
   (*   The XOR procedure is more complicated than a direct display   *)
   (*   and might be a little slower - however, it does avoid page    *)
   (*   flipping, which also must take time.                          *)
   (*                                                                 *)
   (*                              (c) Donald L. Pavia                *)
   (*         Ver 2.0              Department of Chemistry            *)
   (*      February 1986           Western Washington University      *)
   (*                              Bellingham, Washington 98225       *)
   (*                                                                 *)
   (* *************************************************************** *)

const ColorSeg = $B800; ColorOfs = $0000;

type  str14 = string[14];           { this is used for filenames it is long }
                                    { enough to include a drive designation }
                                    { like B:, but must be made longer if   }
                                    { you wish to include a pathname        }

      GrafScreen = record                                { definition of    }
                evenpixel : array[0..99,0..79] of byte;  { 320 x 200 screen }
                filler    : array[1..192] of byte;
                oddpixel  : array[0..99,0..79] of byte;
              end;

      Image = record                                 { definition of sprite }
                srows  : integer; scols  : integer;      {     dimensions }
                first  : array[0..9,0..5] of byte;       { 10 rows,6 cols }
                second : array[0..9,0..5] of byte;       { 10 rows,6 cols }
                future_use : array[0..3] of byte; { to pad out to 128 bytes   }
              end;                                { to allow use of blockread }

      SpriteTable = array[1..24] of Image;

var   ColorBuffer : GrafScreen absolute ColorSeg:ColorOfs;
      WorkBuffer  : GrafScreen;
      BackGroundBuffer : GrafScreen;         { these are the display pages }

      Sprite,TempSprite : Image;       { Sprite is the currently active one.}
                                       { Single sprites loaded from disk go }
      Table : SpriteTable;             { into TempSprite and must be trans- }
                                       { ferred to a variable YOU create.   }
      SpriteRows,Spritecols : integer;
      Found : boolean;
      count,times : integer;
      Wait,Again : char;
{----------------------------------------------------------------------------}
function Exist (FileName : str14) : boolean;

var  Fil : file;
                                           { returns true if filename exists }
begin
     assign (Fil,FileName);
     {$I-} reset (Fil); {$I+}
     Exist := (IOresult = 0);
     close (Fil);
end;
{----------------------------------------------------------------------------}
procedure PutSpriteC (col,row : integer);         { direct display of sprite }
                                                  { on screen (colorbuffer)  }
var   rowpos,colpos,i,j : integer;                {    notice the C          }

begin
     SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;

     if odd (row) then begin
       rowpos := (row-spriterows-1) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.oddpixel  [rowpos+i,colpos+j] := sprite.first  [i,j];

       for i := 1 to spriterows+1 do
         for j := 0 to spritecols do
           ColorBuffer.evenpixel [rowpos+i,colpos+j] := sprite.second [i-1,j];
     end

     else begin
       rowpos := (row-spriterows) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.evenpixel [rowpos+i,colpos+j] := sprite.first [i,j];

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.oddpixel [rowpos+i,colpos+j] := sprite.second [i,j];
     end;

end; { procedure PutSprite(Direct) }
{----------------------------------------------------------------------------}
procedure PutSpriteW (col,row : integer);      { direct display of sprite in }
                                               { hidden screen (workbuffer)  }
var   rowpos,colpos,i,j : integer;             {      notice the W           }

begin
     SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;

     if odd (row) then begin
       rowpos := (row-spriterows-1) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.oddpixel  [rowpos+i,colpos+j] := sprite.first  [i,j];

       for i := 1 to spriterows+1 do
         for j := 0 to spritecols do
           WorkBuffer.evenpixel [rowpos+i,colpos+j] := sprite.second [i-1,j];
     end

     else begin
       rowpos := (row-spriterows) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.evenpixel [rowpos+i,colpos+j] := sprite.first [i,j];

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.oddpixel [rowpos+i,colpos+j] := sprite.second [i,j];
     end;

end; { procedure PutSpriteW (WorkBuffer) }
{----------------------------------------------------------------------------}
procedure XorSpriteC (col,row : integer);         { xor display of sprite    }
                                                  { on screen (colorbuffer)  }
var   rowpos,colpos,i,j : integer;                {    notice the C          }

begin
     SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;

     if odd (row) then begin
       rowpos := (row-spriterows-1) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.oddpixel  [rowpos+i,colpos+j] :=
            ColorBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.first  [i,j];

       for i := 1 to spriterows+1 do
         for j := 0 to spritecols do
           ColorBuffer.evenpixel [rowpos+i,colpos+j] :=
            ColorBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.second [i-1,j];
     end

     else begin
       rowpos := (row-spriterows) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.evenpixel [rowpos+i,colpos+j] :=
            ColorBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.first [i,j];

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           ColorBuffer.oddpixel [rowpos+i,colpos+j] :=
            ColorBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.second [i,j];
     end;

end; { procedure XorSpriteC }
{----------------------------------------------------------------------------}
procedure XorSpriteW (col,row : integer);         { xor display of sprite }
                                                  { in hidden workbuffer  }
var   rowpos,colpos,i,j : integer;                {    notice the W       }

begin
     SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;

     if odd (row) then begin
       rowpos := (row-spriterows-1) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.oddpixel  [rowpos+i,colpos+j] :=
            WorkBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.first  [i,j];

       for i := 1 to spriterows+1 do
         for j := 0 to spritecols do
           WorkBuffer.evenpixel [rowpos+i,colpos+j] :=
            WorkBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.second [i-1,j];
     end

     else begin
       rowpos := (row-spriterows) shr 1;
       colpos := col shr 2 - (spritecols+1) shr 1;

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.evenpixel [rowpos+i,colpos+j] :=
            WorkBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.first [i,j];

       for i := 0 to spriterows do
         for j := 0 to spritecols do
           WorkBuffer.oddpixel [rowpos+i,colpos+j] :=
            WorkBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.second [i,j];
     end;

end; { procedure XorSpriteW }
{----------------------------------------------------------------------------}
Procedure LoadSprite (SpriteName : str14);

var   ImageFile : file of Image;
      LoadedSprite : Image;

begin
     if Exist (SpriteName) then begin
          assign (ImageFile,SpriteName);
          reset (ImageFile);
          read (ImageFile,LoadedSprite);
          close (ImageFile);
          TempSprite := LoadedSprite;
          Found := true; end
     else begin
          write (#7);
          gotoxy (1,24); write ('Sorry, File Does Not Exist !!');
          read (Kbd,Wait);
          Found := false  end;

end;
{----------------------------------------------------------------------------}
procedure LoadTable (NameOfTable : str14);

                                        { blockread gobbles 128 byte chunks }
                                        { 24 x 128 = 3072 bytes for a table }
var  TableFile : File;                  { untyped file used }

begin
      if Exist (NameOfTable) then begin
        assign (TableFile,NameOfTable);
        reset (TableFile);
        BlockRead (TableFile,Table,24);
        close (TableFile);
        end
     else begin
        gotoxy (1,25);
        write (#7); write ('Sorry, Table Does Not Exist !!          ');
     end;

end; { procedure LoadTable }
{----------------------------------------------------------------------------}
procedure Spwrite (i,j,k : integer);     { simplifies code but a call to an }
                                         { unnecessary procedure could slow }
                                         { the animation speed              }
begin
     SPRITE := Table[i]; XorSpriteW (j,k);

end; { procedure Spwrite }
{----------------------------------------------------------------------------}
procedure Show;                                      { same remark as above }

begin
     ColorBuffer := WorkBuffer; WorkBuffer := BackGroundBuffer;

end; { procedure Show }
{----------------------------------------------------------------------------}