home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / sprite / sprites.lib < prev    next >
Encoding:
Text File  |  1989-07-18  |  12.8 KB  |  300 lines
  1.    (* *************************************************************** *)
  2.    (*                                                                 *)
  3.    (*                         SPRITES.INC                             *)
  4.    (*                                                                 *)
  5.    (*   These are the definitions and procedures needed to implement  *)
  6.    (*   the sprites and animation package. You may delete any that    *)
  7.    (*   are not used in your program. To keep the display procedures  *)
  8.    (*   simpler ( and thus hopefully faster ) I have written four     *)
  9.    (*   separate ones. It is unlikely that you will want to use all   *)
  10.    (*   four in a single program.                                     *)
  11.    (*                                                                 *)
  12.    (*   Keep in mind that the sprites and procedures are byte based.  *)
  13.    (*   That means that sprites can only be displayed at a byte       *)
  14.    (*   boundary when placed on the screen. This is not much of a     *)
  15.    (*   restriction, but it does mean the the x-coordinate passed to  *)
  16.    (*   the display procedures should be a multiple of four pixels :  *)
  17.    (*   0,4,8,12,16,20,24 ..... etc. Also, any steps used for ani-    *)
  18.    (*   mation should move the sprite a multiple of four pixels as    *)
  19.    (*   well. There is no checking of the display coordinates. It is  *)
  20.    (*   left to the programmer. If a sprite overlaps the edge of the  *)
  21.    (*   screen, it will wrap around to the other side.                *)
  22.    (*                                                                 *)
  23.    (*   The CENTER of the sprite is displayed at the specified x,y    *)
  24.    (*   coordinates.                                                  *)
  25.    (*                                                                 *)
  26.    (*   If you use direct XOR animation, you should use a delay just  *)
  27.    (*   after displaying the sprite (say, Delay(75) ). You need to    *)
  28.    (*   give the viewer time to see and understand the object. Rapid  *)
  29.    (*   XOR animation looks vague and ghostly and the objects dis-    *)
  30.    (*   played appear to flicker.                                     *)
  31.    (*                                                                 *)
  32.    (*   The XOR procedure is more complicated than a direct display   *)
  33.    (*   and might be a little slower - however, it does avoid page    *)
  34.    (*   flipping, which also must take time.                          *)
  35.    (*                                                                 *)
  36.    (*                              (c) Donald L. Pavia                *)
  37.    (*         Ver 2.0              Department of Chemistry            *)
  38.    (*      February 1986           Western Washington University      *)
  39.    (*                              Bellingham, Washington 98225       *)
  40.    (*                                                                 *)
  41.    (* *************************************************************** *)
  42.  
  43. const ColorSeg = $B800; ColorOfs = $0000;
  44. {! 1. Zuweisungen^ vorzeichenloser Werte >$8000 nur an Word oder LongInt}
  45.  
  46. type  str14 = string[14];           { this is used for filenames it is long }
  47.                                     { enough to include a drive designation }
  48.                                     { like B:, but must be made longer if   }
  49.                                     { you wish to include a pathname        }
  50.  
  51.       GrafScreen = record                                { definition of    }
  52.                 evenpixel : array[0..99,0..79] of byte;  { 320 x 200 screen }
  53.                 filler    : array[1..192] of byte;
  54.                 oddpixel  : array[0..99,0..79] of byte;
  55.               end;
  56.  
  57.       Image = record                                 { definition of sprite }
  58.                 srows  : integer; scols  : integer;      {     dimensions }
  59.                 first  : array[0..9,0..5] of byte;       { 10 rows,6 cols }
  60.                 second : array[0..9,0..5] of byte;       { 10 rows,6 cols }
  61.                 future_use : array[0..3] of byte; { to pad out to 128 bytes   }
  62.               end;                                { to allow use of blockread }
  63.  
  64.       SpriteTable = array[1..24] of Image;
  65.  
  66. var   ColorBuffer : GrafScreen absolute ColorSeg:ColorOfs;
  67.       WorkBuffer  : GrafScreen;
  68.       BackGroundBuffer : GrafScreen;         { these are the display pages }
  69.  
  70.       Sprite,TempSprite : Image;       { Sprite is the currently active one.}
  71.                                        { Single sprites loaded from disk go }
  72.       Table : SpriteTable;             { into TempSprite and must be trans- }
  73.                                        { ferred to a variable YOU create.   }
  74.       SpriteRows,Spritecols : integer;
  75.       Found : boolean;
  76.       count,times : integer;
  77.       Wait,Again : char;
  78. {----------------------------------------------------------------------------}
  79. function Exist (FileName : str14) : boolean;
  80.  
  81. var  Fil : file;
  82.                                            { returns true if filename exists }
  83. begin
  84.      assign (Fil,FileName);
  85.      {$I-} reset (Fil); {$I+}
  86.      Exist := (IOresult = 0);
  87. {! 2. IOResult ^liefert in der Version 4.0 MS-DOS-Fehlercodes zurück}
  88.      close (Fil);
  89. end;
  90. {----------------------------------------------------------------------------}
  91. procedure PutSpriteC (col,row : integer);         { direct display of sprite }
  92.                                                   { on screen (colorbuffer)  }
  93. var   rowpos,colpos,i,j : integer;                {    notice the C          }
  94.  
  95. begin
  96.      SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;
  97.  
  98.      if odd (row) then begin
  99.        rowpos := (row-spriterows-1) shr 1;
  100.        colpos := col shr 2 - (spritecols+1) shr 1;
  101.  
  102.        for i := 0 to spriterows do
  103.          for j := 0 to spritecols do
  104.            ColorBuffer.oddpixel  [rowpos+i,colpos+j] := sprite.first  [i,j];
  105.  
  106.        for i := 1 to spriterows+1 do
  107.          for j := 0 to spritecols do
  108.            ColorBuffer.evenpixel [rowpos+i,colpos+j] := sprite.second [i-1,j];
  109.      end
  110.  
  111.      else begin
  112.        rowpos := (row-spriterows) shr 1;
  113.        colpos := col shr 2 - (spritecols+1) shr 1;
  114.  
  115.        for i := 0 to spriterows do
  116.          for j := 0 to spritecols do
  117.            ColorBuffer.evenpixel [rowpos+i,colpos+j] := sprite.first [i,j];
  118.  
  119.        for i := 0 to spriterows do
  120.          for j := 0 to spritecols do
  121.            ColorBuffer.oddpixel [rowpos+i,colpos+j] := sprite.second [i,j];
  122.      end;
  123.  
  124. end; { procedure PutSprite(Direct) }
  125. {----------------------------------------------------------------------------}
  126. procedure PutSpriteW (col,row : integer);      { direct display of sprite in }
  127.                                                { hidden screen (workbuffer)  }
  128. var   rowpos,colpos,i,j : integer;             {      notice the W           }
  129.  
  130. begin
  131.      SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;
  132.  
  133.      if odd (row) then begin
  134.        rowpos := (row-spriterows-1) shr 1;
  135.        colpos := col shr 2 - (spritecols+1) shr 1;
  136.  
  137.        for i := 0 to spriterows do
  138.          for j := 0 to spritecols do
  139.            WorkBuffer.oddpixel  [rowpos+i,colpos+j] := sprite.first  [i,j];
  140.  
  141.        for i := 1 to spriterows+1 do
  142.          for j := 0 to spritecols do
  143.            WorkBuffer.evenpixel [rowpos+i,colpos+j] := sprite.second [i-1,j];
  144.      end
  145.  
  146.      else begin
  147.        rowpos := (row-spriterows) shr 1;
  148.        colpos := col shr 2 - (spritecols+1) shr 1;
  149.  
  150.        for i := 0 to spriterows do
  151.          for j := 0 to spritecols do
  152.            WorkBuffer.evenpixel [rowpos+i,colpos+j] := sprite.first [i,j];
  153.  
  154.        for i := 0 to spriterows do
  155.          for j := 0 to spritecols do
  156.            WorkBuffer.oddpixel [rowpos+i,colpos+j] := sprite.second [i,j];
  157.      end;
  158.  
  159. end; { procedure PutSpriteW (WorkBuffer) }
  160. {----------------------------------------------------------------------------}
  161. procedure XorSpriteC (col,row : integer);         { xor display of sprite    }
  162.                                                   { on screen (colorbuffer)  }
  163. var   rowpos,colpos,i,j : integer;                {    notice the C          }
  164.  
  165. begin
  166.      SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;
  167.  
  168.      if odd (row) then begin
  169.        rowpos := (row-spriterows-1) shr 1;
  170.        colpos := col shr 2 - (spritecols+1) shr 1;
  171.  
  172.        for i := 0 to spriterows do
  173.          for j := 0 to spritecols do
  174.            ColorBuffer.oddpixel  [rowpos+i,colpos+j] :=
  175.             ColorBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.first  [i,j];
  176.  
  177.        for i := 1 to spriterows+1 do
  178.          for j := 0 to spritecols do
  179.            ColorBuffer.evenpixel [rowpos+i,colpos+j] :=
  180.             ColorBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.second [i-1,j];
  181.      end
  182.  
  183.      else begin
  184.        rowpos := (row-spriterows) shr 1;
  185.        colpos := col shr 2 - (spritecols+1) shr 1;
  186.  
  187.        for i := 0 to spriterows do
  188.          for j := 0 to spritecols do
  189.            ColorBuffer.evenpixel [rowpos+i,colpos+j] :=
  190.             ColorBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.first [i,j];
  191.  
  192.        for i := 0 to spriterows do
  193.          for j := 0 to spritecols do
  194.            ColorBuffer.oddpixel [rowpos+i,colpos+j] :=
  195.             ColorBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.second [i,j];
  196.      end;
  197.  
  198. end; { procedure XorSpriteC }
  199. {----------------------------------------------------------------------------}
  200. procedure XorSpriteW (col,row : integer);         { xor display of sprite }
  201.                                                   { in hidden workbuffer  }
  202. var   rowpos,colpos,i,j : integer;                {    notice the W       }
  203.  
  204. begin
  205.      SpriteRows := Sprite.srows; SpriteCols := Sprite.scols;
  206.  
  207.      if odd (row) then begin
  208.        rowpos := (row-spriterows-1) shr 1;
  209.        colpos := col shr 2 - (spritecols+1) shr 1;
  210.  
  211.        for i := 0 to spriterows do
  212.          for j := 0 to spritecols do
  213.            WorkBuffer.oddpixel  [rowpos+i,colpos+j] :=
  214.             WorkBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.first  [i,j];
  215.  
  216.        for i := 1 to spriterows+1 do
  217.          for j := 0 to spritecols do
  218.            WorkBuffer.evenpixel [rowpos+i,colpos+j] :=
  219.             WorkBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.second [i-1,j];
  220.      end
  221.  
  222.      else begin
  223.        rowpos := (row-spriterows) shr 1;
  224.        colpos := col shr 2 - (spritecols+1) shr 1;
  225.  
  226.        for i := 0 to spriterows do
  227.          for j := 0 to spritecols do
  228.            WorkBuffer.evenpixel [rowpos+i,colpos+j] :=
  229.             WorkBuffer.evenpixel [rowpos+i,colpos+j] xor sprite.first [i,j];
  230.  
  231.        for i := 0 to spriterows do
  232.          for j := 0 to spritecols do
  233.            WorkBuffer.oddpixel [rowpos+i,colpos+j] :=
  234.             WorkBuffer.oddpixel [rowpos+i,colpos+j] xor sprite.second [i,j];
  235.      end;
  236.  
  237. end; { procedure XorSpriteW }
  238. {----------------------------------------------------------------------------}
  239. Procedure LoadSprite (SpriteName : str14);
  240.  
  241. var   ImageFile : file of Image;
  242.       LoadedSprite : Image;
  243.  
  244. begin
  245.      if Exist (SpriteName) then begin
  246.           assign (ImageFile,SpriteName);
  247.           reset (ImageFile);
  248.           read (ImageFile,LoadedSprite);
  249.           close (ImageFile);
  250.           TempSprite := LoadedSprite;
  251.           Found := true; end
  252.      else begin
  253.           write (#7);
  254.           gotoxy (1,24); write ('Sorry, File Does Not Exist !!');
  255.           read (Kbd,Wait);
  256. {! 3. Kbd erford^ert das Unit Turbo3 - verwenden Sie ReadKey (im Unit Crt)}
  257.           Found := false  end;
  258.  
  259. end;
  260. {----------------------------------------------------------------------------}
  261. procedure LoadTable (NameOfTable : str14);
  262.  
  263.                                         { blockread gobbles 128 byte chunks }
  264.                                         { 24 x 128 = 3072 bytes for a table }
  265. var  TableFile : File;                  { untyped file used }
  266.  
  267. begin
  268.       if Exist (NameOfTable) then begin
  269.         assign (TableFile,NameOfTable);
  270.         reset (TableFile);
  271.         BlockRead (TableFile,Table,24);
  272.         close (TableFile);
  273.         end
  274.      else begin
  275.         gotoxy (1,25);
  276.         write (#7); write ('Sorry, Table Does Not Exist !!          ');
  277.      end;
  278.  
  279. end; { procedure LoadTable }
  280. {----------------------------------------------------------------------------}
  281. procedure Spwrite (i,j,k : integer);     { simplifies code but a call to an }
  282.                                          { unnecessary procedure could slow }
  283.                                          { the animation speed              }
  284. begin
  285.      SPRITE := Table[i]; XorSpriteW (j,k);
  286.  
  287. end; { procedure Spwrite }
  288. {----------------------------------------------------------------------------}
  289. procedure Show;                                      { same remark as above }
  290.  
  291. begin
  292.      ColorBuffer := WorkBuffer; WorkBuffer := BackGroundBuffer;
  293.  
  294. end; { procedure Show }
  295. {----------------------------------------------------------------------------}
  296.  
  297.  
  298.  
  299.  
  300.