{$R-,Q-}
Program BUMP_MAPPING_WITH_PHONG_TEXTURE;
Const fs=$64;                           {ASSEMBLER 386+ hrefIXES}
       gs=$65;
Var   sintable:array[0..320] of integer;
       phongseg,vpageseg,txrseg:word;
       phong,vpage,txrpointer:pointer;
       x,y:integer;
       anglex,angley:byte;

  { Задаем компоненты R,G,B для цвета Color }
PROCEDURE Setrgb(color,r,g,b:byte);Assembler;   
Asm
  Mov al,[color]
  Mov dx,03c8H
  Out dx,al
  Inc dx
  Mov al,[r]
  Out dx,al
  Mov al,[g]
  Out dx,al
  Mov al,[b]
  Out dx,al
End;

  { Создаем гаснущую (faded) плаитру }
PROCEDURE Fadepalette(r1,g1,b1,r2,g2,b2,cstart,cend:byte);  
Var rstep,gstep,bstep,rval,gval,bval:longint;
     i:integer;
Begin
   rval:=longint(r1) shl 8;
   gval:=longint(g1) shl 8;
   bval:=longint(b1) shl 8;
   rstep:=longint(r2-r1+1) shl 8 div (cend-cstart+1);
   gstep:=longint(g2-g1+1) shl 8 div (cend-cstart+1);
   bstep:=longint(b2-b1+1) shl 8 div (cend-cstart+1);
   For i:=cstart to cend do
    Begin
      Setrgb(i,rval div 256,gval div 256,bval div 256);
      rval:=rval+rstep;
      gval:=gval+gstep;
      bval:=bval+bstep;
    End;
End;

PROCEDURE Wait4vrt;Assembler; { Ждем обратого хода луча }
Asm
  Mov  dx,3daH
@L1:
  In   al,dx
  And  al,08H
  Jnz  @L1
@L2:
  In   al,dx
  And  al,08H
  Jz   @L2
End;

PROCEDURE Loadraw(filename:string);  { Читаем файл texture.raw }
Var ff:file;
Begin
   Assign(ff,filename);
   Reset(ff,1);
   Blockread(ff,txrpointer^,64000);
   Close(ff);
End;

PROCEDURE Loadphong;
Var ff:file;
Begin
   Assign(ff,'PHONG.MAP');
   Reset(ff,1);
   Blockread(ff,phong^,Filesize(ff));
   Close(ff);
End;

PROCEDURE Clear(segm:word);Assembler;
Asm
  Mov  es,segm
  Db   $66;Xor  di,di
  Db   $66;Xor  ax,ax
  Mov  cx,0ffffH/4
  Db   $66;Rep  Stosw
End;

PROCEDURE Fliptovideo;Assembler; { Кидаем виртуальный экран в реальный }
Asm
  Push ds
  Mov  ds,vpageseg
  Push 0A000H
  Pop  es
  Db   $66;Xor  di,di
  Db   $66;Xor  si,si
  Mov  cx,16000
  Db   $66;Rep  Movsw
  Pop  ds
End;

PROCEDURE Allocate; { Выделем два сегмента для текстуры }
Begin
   Getmem(vpage,64000);
   vpageseg:=Seg(vpage^);
   Getmem(txrpointer,64000);
   txrseg:=Seg(txrpointer^);
   Getmem(phong,64000);
   phongseg:=Seg(phong^);
   Clear(vpageseg);
   Clear(txrseg);
   Clear(phongseg);
End;

PROCEDURE Phongbump(xlight,ylight:integer);Assembler;
Var nx,ny,xp,yp,i,j:integer;
Asm
  Mov  [nx],0
  Mov  [ny],0
  Mov  es,txrseg

  mov   ax,phongseg
  Db $8E,$E0                            { Mov fs,ax }
  mov   ax,vpageseg
  Db $8E,$E8                            { Mov gs,ax }
  Xor  si,si
  Mov  di,321

  Xor  ax,ax
  Sub  ax,Word Ptr [ylight]
  Mov  Word Ptr [yp],ax
  Mov  Word Ptr [i],198
Yloop:
  Xor  ax,ax
  Sub  ax,Word Ptr [xlight]
  Mov  Word Ptr [xp],ax
  Mov  Word Ptr [j],318
@Xloop:
  Xor  ax,ax
  Xor  bx,bx
  Mov  bl,es:[di+1]
  Mov  al,es:[di-1]
  Sub  ax,bx
  Shr  ax,1
  Add  ax,127
  Mov  Byte Ptr [nx],al

  Xor  ax,ax
  Xor  bx,bx
  Mov  bl,es:[di+320]
  Mov  al,es:[di-320]
  Sub  ax,bx
  Shr  ax,1
  Add  ax,127
  Mov  Byte Ptr [ny],al

  Inc  Word Ptr [xp]

  Mov  ax,Word Ptr [xp]
  Add  ax,Word Ptr [nx]
  Test ah,ah
  Jnz  @Zero

  Mov  bx,Word Ptr [yp]
  Add  bx,Word Ptr [ny]
  Test bh,bh
  Jnz  @Zero

  Mov  bh,al
  Db   fs; Mov  al,[bx]
  Db   gs; Mov  [di],al
  Inc  di
  Dec  Word Ptr [j]
  Jnz  @Xloop
  Jmp  @Ende
@Zero:
  Xor  al,al
  Db   gs; Mov  [di],al
  Inc  di
  Dec  Word Ptr [j]
  Jnz  @Xloop
@Ende:
  Inc  Word Ptr [yp]
  Add  di,2
  Dec  Word Ptr [i]
  Jnz  @Yloop
End;

Begin
   {Считаем таблицу синустов для построени траекториии движения}
   For x:=0 to 320 do sintable[x]:=Round(Sin(x*Pi/128)*128);
   { Инициализайия графики - 320x200x256 }
   Asm
    Mov  ax,13H
    Int  10H
   End;
   Fadepalette(0,0,0,53,23,33,0,63);
   Fadepalette(53,23,33,64,64,64,64,128);
   Allocate;
   Loadraw('TEXTURE.RAW');
   Loadphong;
  Repeat
   x:=160+sintable[anglex];
   y:=100+sintable[angley];
   Phongbump(x,y);
   Wait4vrt;
   Fliptovideo;
   Inc(anglex,3);
   anglex:=anglex and 255;
   Inc(angley,2);
   angley:=angley and 255;
  Until Port[$60]=1; { Пока не вдвили Esc }
   { Восстанавливаем текстовый режим }
   Asm
    Mov  ax,3H
    Int  10H
   End;
End.