program Sprite;
{простейшая демонстрация работы со спрайтами}
uses dos,     {для работы с прерыванием VideoBIOS}
crt;     {для работы с клавиатурой}
const
Xsize = 20;      {размеры спрайта, точек}
Ysize = 20;
TransparentColor = $FF; {?прозрачный? цвет}
type
SpriteArrayType =
array[0..Ysize-1,0..Xsize-1]of byte;
{массив равный по размеру спрайту}
SpriteType = record
x,y  : word;         {текущие координаты спрайта}
dx,dy : integer;   {приращения координат спрайта}
Img  : ^SpriteArrayType;
{для массива с изображением спрайта}
Back : ^SpriteArrayType;
{для массива, хранящего фон под спрайтом}
end;
ScreenType = array[0..199,0..319]of byte;
{для экрана}
var
Sprt : SpriteType;                         {спрайт}
r    : registers;      {для вызова прерывания BIOS}
Scr  : ^ScreenType;                         {экран}
procedure GetBuffer;
{сохранение фона под спрайтом в буфере}
var
i,j    : word;      {переменные цикла}
begin
for j := 0 to Ysize-1 do
for i := 0 to Xsize-1 do
with Sprt do
Back^[j,i] := Scr^[j+y,i+x];
end;
procedure PutBuffer;   {восстановление фона}
var
i,j    : word;      {переменные цикла}
begin
for j := 0 to Ysize-1 do
for i := 0 to Xsize-1 do
with Sprt do
Scr^[j+y,i+x] := Back^[j,i];
end;
procedure PutSprite;   {вывод спрайта на экран}
var
i,j    : word;      {переменные цикла}
begin
for j := 0 to Ysize-1 do
for i := 0 to Xsize-1 do
with Sprt do
if Img^[j,i] <> TransparentColor then
{ставим только точки,}
{цвет которых отличается от ?прозрачного?}
Scr^[j+y,i+x] := Img^[j,i];
end;
procedure PutBackground;     {создание фона на экране}
var
i,j    : word;      {переменные цикла}
begin
for j := 0 to 199 do
for i := 0 to 319 do
Scr^[j,i] := lo(i+j*8);
end;
procedure CreateSprite(s:string; x,y,dx,dy:integer);
{?создание? спрайта}
var
f : file;      {файл с изображением спрайта}
begin
getmem(Sprt.Img,sizeof(SpriteArrayType));
{выделяем память для спрайта}
getmem(Sprt.Back,sizeof(SpriteArrayType));
{выделяем память для буфера}
assign(f,s);    {bmp-файл размерами Xsize на Ysize}
reset(f,1);            {открываем файл со спрайтом}
seek(f,1078);                {пропускаем заголовок}
blockread(f,Sprt.Img^,Xsize*Ysize);
{читаем изображение}
close(f);
Sprt.x := x;
Sprt.y := y;     { задаем начальные значения }
Sprt.dx := dx;    {  координат и приращений   }
Sprt.dy := dy;
end;
procedure DestroySprite; {?уничтожение? спрайта}
begin
{ возвращаем память }
freemem(Sprt.Back,sizeof(SpriteArrayType));
freemem(Sprt.Img,sizeof(SpriteArrayType));
end;
procedure CalcSpritePosition;  {вычисление координат}
begin                      {спрайта и их приращений}
{по достижении границы экрана делаем,}
{ чтобы спрайт ?отразился? от нее}
with Sprt do begin
if (x + Xsize + dx) >= 319 then
dx := -dx;      {вычисляем новые приращения}
if (x + dx) <= 0 then
dx := -dx;         {реализующие ?отражение?}
if (y + Ysize + dy) >= 199 then
dy := -dy;               {спрайта от стенок}
if (y + dy) <= 0 then
dy := -dy;
x := x+dx;          {   вычисляем новые  }
y := y+dy;          { координаты спрайта }
end;
end;
begin
CreateSprite(?sprt01.bmp?,0,0,1,1);
r.ax := $13;  { устанавливаем режим }
intr($10,r);  {  320х200х256 цветов }
Scr := ptr(SegA000,0);         {адрес видеопамяти}
PutBackGround;      {рисуем фон}
GetBuffer;  {сохраняем фон под спрайтом}
PutSprite;  {и рисуем на его месте спрайт}
repeat   {теперь спрайт будет двигаться по экрану}
{до тех пор, пока мы не нажмем на клавишу}
PutBuffer;    {восстанавливаем фон}
CalcSpritePosition;
GetBuffer;    {сохраняем фон}
PutSprite;    {рисуем спрайт}
while (port[$3da] and 8) = 0 do;
{ожидаем обратный ход луча кадровой развертки}
until keypressed;
readkey;                  {чистим буфер клавиатуры}
r.ax := $3;
intr($10,r);       {возвращаемся в текстовый режим}
DestroySprite;
end.