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

procedure SetMode(Mode:word);assembler; {Установка граф. режима. Без проверок}
asm
  mov ax, Mode
  int 10h
end;{SetMode}
{-------------------}
Procedure CreatePalette;assembler; {Создание нужной палитры
                                    256-цветного режима}
  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}

    mov cx, 128         {Это будет кол-вом цветов}
    mov bx, 0           {Текущий индекс}
    inc dx		{Write pal port  -  3c9h }
@@1:
    mov al, bl          {R : 0-63}
    push bx
    push dx
     mov bx, 3
     div bx
    pop dx
    pop bx
    out dx, al

    mov al, bl		{G : 0-127}
    shr al, 2
    out dx, al

(*    mov al, bl		{B : 0-255}
    shr al, 8   *)
    mov al, 10
    out dx, al
    inc bx
    loop @@1

    shr bx, 1
    mov cx, 95
@@2:
    mov al, 0ffh          {R : 0-63}
    shr al, 2
    out dx, al

    mov al, bl		{G : 0-127}
    shr al, 1
    out dx, al

    mov al, bl		{B : 0-255}
    shr al, 4
    out dx, al
    inc bx
    loop @@2
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,'bump.dat');
 Reset(inP,1);
 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.