{$G+}
{Innocenty Enikeew Copyright 2001}
{Программа-демонстрация алгоритма 2d-bump mapping
 (имитация неровной поверхности) Алгоритм сперт откуда-то из инета :) }
const
 bright  = 253; {Сила источника света}
 density = 64; {Радиус светового пятна}

procedure SetMode(Mode:word);assembler; {Установка граф. режима. Без проверок}
asm
  mov ax, Mode
  int 10h
end;{SetMode}
{-------------------}
Procedure CreatePalette; {Создание нужной палитры
                                    256-цветного режима}
var
 R,G,B,i : byte;
begin
  asm
    mov dx, 3c6h        {Порт регистра маски палитры}
    mov al, 0ffh        { FF - 0-256 -вся палитра}
    out dx, al 		{We will change all palette}

    mov dx, 3c8h        {Порт выбора номера цвета для записи в палитру}
    mov al, 0
    out dx, al		{Beginning from first}
  end;
  R:=0;G:=0;B:=0;
  for i := 1 to 192 do
  begin
   R := i shr 2;
   G := (i * 16) div 192;
   asm
     mov dx, 3C9h

     mov al, R
     out dx, al

     mov al, G
     out dx, al

     mov al, B
     out dx, al
   end;
  end;
  for i := 1 to 64 do
  begin
   R := 48 + (i shr 2);
   G := 16 + (i*48) shr 6;
   asm
     mov dx, 3C9h

     mov al, R
     out dx, al

     mov al, G
     out dx, al

     mov al, B
     out dx, al
   end;
  end;
end;{CreatePalette}
{-------------------------------}
Function KeyPressed:boolean;assembler;
asm
  mov ah, 1
  int 16h
  mov al, 0
  jz @@2
  mov al, 1
@@2:
end;
type
 tEnv = array [0..250,0..250] of byte;
 tScr = array [0..199,0..319] of byte;
var
 Inp             : FILE;
 envmap          : ^TEnv;
 bump,BackBuffer : ^tScr;
 i,j,lx,ly       : integer;
 nx,ny		 : integer;
 dx,dy           : integer;
 x,y,z           : real;

Procedure Draw;
begin
 for i:=0 to 199 do
  for j := 0 to 319 do
   begin
     nx := bump^[i,j] - bump^[i,j+1] - (lx-j) + density;
     ny := bump^[i,j] - bump^[i+1,j] - (ly-i) + density;
     if (nx>=255) or (nx<0) then nx := 255;
     if (ny>=255) or (ny<0) then ny := 255;
     BackBuffer^[i,j] := envmap^[ny,nx];
   end;
end;
{-----------------------}
Procedure DrawBack;assembler; {Прорисовка буфера на экран}
asm
push es
push ds
  mov cx, 320*200
  shr cx, 1
  push 0A000h
  pop es
  xor di, di
  lds si, BackBuffer
  repe movsw
pop ds
pop es
end;
{-----------------------}
begin
 GetMem(bump,SizeOf(tScr));
 GetMem(BackBuffer,SizeOf(tScr));
 GetMem(EnvMap,256*256-1);
 for i := 0 to 255 do
  for j := 0 to 255 do
   begin
     x := j/density-1;
     y := i/density-1;
     z := 1 - sqrt(x*x+y*y);
     if z < 0 then z:=0;
     envmap^[i,j] := round(z*bright);
   end;
 Assign(Inp,'bump3.tga');
 Reset(inP,1);
 Seek(inP,$312);
 BlockRead(Inp,Bump^,320*200);
 Close(inp);
 lx := 90;
 ly := 100;
 dx := 1;
 dy := 1;
 SetMode($13);
 CreatePalette;

 while not keypressed do
 begin
  Draw;
  repeat until (Port[$03DA] and 8) <> 8;
  repeat until (Port[$03DA] and 8) =  8;
  DrawBack;
  inc(lx,dx);
  inc(ly,dy);
  if (lx > 310) or (lx<5) then dx := -dx;
  if (ly > 190) or (ly<5) then dy := -dy;
 end;
 SetMode(3);
 FreeMem(bump,SizeOf(tScr));
 freeMem(BackBuffer,SizeOf(tScr));
 freeMem(EnvMap,256*256-1);
end.