Листинг 1

program Sprite;

uses dos,     {для работы с прерыванием VideoBIOS}
     crt,     {для работы с клавиатурой}
     pal,     {для работы с палитрой}
     text256, {для вывода текста}
     timer18, {для измерения времени и синхронизации}
     sprites; {для работы со спрайтами}
const
   TextColor : byte = 0;         {текущий цвет текста}
   NumSprites = 2;               {количество спрайтов}
   NameSprt : array[1..2{NumSprites}]of string =
          (?sprt01.bmp?,?sprt02.bmp?);
                               {имена файлов спрайтов}
var
   Sprt : array[1..NumSprites]of SpriteType; {спрайты}
   r    : registers;      {для вызова прерывания BIOS}
   i    : integer;                  {счетчик спрайтов}
   s    : string;      {для вывода сообщений на экран}
   FPS  : single;       {темп вывода кадров в секунду}

function sign(a:single):integer;
begin
   if a = 0 then
      sign := 0
   else
      if a > 0 then
         sign := 1
      else
         sign := -1;
end;

begin
   GetPal(p[0],0,256);
   FadeOut(p);
   randomize;
   for i := 1 to NumSprites do
      CreateSprite(NameSprt[(i mod 2)+1],random(320
                -Xsize),random(200-Ysize),1,1,Sprt[i]);
   r.ax := $13;  { устанавливаем режим }
   intr($10,r);  {  320х200х256 цветов }
   BlackPal;
   PutBackGround;      {рисуем фон}
   FadeIn(p);
   for i := 1 to NumSprites do begin
      GetBuffer(Sprt[i]);{сохраняем фон под спрайтом}
      PutSprite(Sprt[i]);{и рисуем на его месте спрайт}
   end;
   repeat   {теперь спрайт будет двигаться по экрану}
           {до тех пор, пока мы не нажмем на клавишу}
      for i := NumSprites downto 1 do
         PutBuffer(Sprt[i]);    {восстанавливаем фон}
      for i := 1 to NumSprites do begin
         CalcSpritePosition(Sprt[i]);
         GetBuffer(Sprt[i]);  {сохраняем фон}
         PutSprite(Sprt[i]);  {выводим спрайт}
      end;
      inc(TextColor);
      SetTextParm(TextColor div 16,
                            (TextColor + 48) div 16,1);
      PutText(56,16,?Демонстрационная?);
      SetTextParm(TextColor and $F,0,0);
      PutText(192,16,?программа?);
      SetTextParm(15,0,1);
      FPS := GetFPS;
      str(FPS:0:1,s);
      PutText(120,184,? ?+s+? fps ?);
      if FPS > 1 then      {изменяем приращение}
        for i := 1 to NumSprites do begin
          Sprt[i].dx := sign(Sprt[i].dx)*round(70/FPS);
          Sprt[i].dy := sign(Sprt[i].dy)*round(70/FPS);
        end;
      WaitVerticalRetrace;
        {ожидаем обратный ход луча кадровой развертки}
   until keypressed;
   readkey;                  {чистим буфер клавиатуры}
   FadeOut(p);
   r.ax := $3;
   intr($10,r);       {возвращаемся в текстовый режим}
   for i := NumSprites downto 1 do
      DestroySprite(Sprt[i]);
end.

назад