{better version of 2D bump but so slooow}
Program twodbump;
uses crt,mygraph,fpack;
    {This is a unit from the Asphyxia Trainers to
    load pcx images}
const maxframe=3;
TYPE
     Virtual = Array [1..64000] of byte;
     VirtPtr = ^Virtual;

var

 x,y,
 vlx,vly,
 lx,ly,
 Nx,ny:integer;  {This will be used to store the Pseudo-normal}
 l1:word;
 Virscr,virscr2 : VirtPtr;
 Vaddr,vaddr2  : word;              { The segment of our virtual screen}
 sincosx : array [0..360] of byte;
 sincosy : array [0..360] of byte;
 timer:word;

procedure gensincos;
begin
for l1:=0 to 360 do
 begin
  sincosx[l1]:=round(cos(pi/45*l1)*60+150);
  sincosy[l1]:=round(sin(pi/45*l1)*60+100);
 end;
end;

procedure virtputpixel(where: word;x,y : word; c : byte);assembler;
 asm
  mov es,[where]
  mov ax,[y]
  shl ax,6
  mov di,ax
  shl ax,2
  add di,ax
  add di,[x]
  mov al,c
  mov [es:di],al
 end;






Procedure Cls32 (Where:word;Col : Byte); assembler;
asm
   push    es
   mov     cx, 16000;
   mov     es,[where]
   xor     di,di
   mov     al,[col]
   mov     ah,al
   mov     dx, ax
   db      $66, $C1, $E0, $10         {shl eax, 16}
   mov     ax, dx
   db      $F3, $66, $AB              {rep stosd}
   pop     es
End;

procedure flip32(source,dest:Word); assembler;
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 16000
  db      $F3, $66, $A5
  pop     ds
end;

Procedure Pal(Col,R,G,B : Byte); assembler;
asm
   mov    dx,3c8h
   mov    al,[col]
   out    dx,al
   inc    dx
   mov    al,[r]
   out    dx,al
   mov    al,[g]
   out    dx,al
   mov    al,[b]
   out    dx,al
end;


Procedure SetUpVirtual;
BEGIN
  GetMem (VirScr,64000);
  vaddr := seg (virscr^);   {The segment for page 1}
  GetMem (VirScr2,64000);
  vaddr2 := seg (virscr2^); {The segment for page 2}
END; {Setupvirtual}

Procedure ShutDown;
BEGIN
  FreeMem (VirScr,64000);
  FreeMem (VirScr2,64000);
END;  {Shutdown}

procedure checkpismo(a:byte);
begin
         for a:=0 to 3 do
         begin
          if mem[vaddr:x+y*320+a]=0 then
             begin
              nx:=40;ny:=40;
             end;
          if mem[vaddr:x+(y+a)*320]=0 then
             begin
              nx:=40;ny:=40;
             end;

          if mem[vaddr:x+(y-a)*320]=0 then
           begin
              nx:=40;ny:=40;
             end;

          if mem[vaddr:x+y*320-a]=0  then
            begin
              nx:=40;ny:=40;
             end;


         end;
end;

function checkpismo2(a:byte):boolean;
var i:integer;
begin
checkpismo2:=false;
         for i:=-1 to 1 do
         begin
          if mem[vaddr:x+y*320+i]=0 then
             begin
              checkpismo2:=true
             end;
          if mem[vaddr:x+(y+i)*320]=0 then
             begin
              checkpismo2:=true
             end;

          if mem[vaddr:x+(y-i)*320]=0 then
           begin
              checkpismo2:=true
            end;

          if mem[vaddr:x+y*320-i]=0  then
            begin
              checkpismo2:=true
             end;


         end;
end;

procedure uprav;
var a:byte;
    c:real;
    navr:boolean;
begin
navr:=false;
for x:=1 to 318 do
 for y:=1 to 198 do
  Begin
   a:=mem[vaddr:x+y*320];
   navr:=checkpismo2(a);
   if navr=true then
    begin
     nx:=mem[vaddr:x+y*320+1]-mem[vaddr:x+y*320-1];
     ny:=mem[vaddr:x+(y+1)*320]-mem[vaddr:x+(y-1)*320];
     mem[vaddr:x+y*320]:=round((2+abs(nx)+abs(ny))*0.5);
    end;
   end;
end;




procedure setuppal;
var l1:integer; {General purpose}
begin
  for l1:=0 to 127 do
   begin
    activepal[l1,1]:=0;
    activepal[l1,2]:=0;
    activepal[l1,3]:=0;
   end;
  for l1:=128 to 255 do
   begin
    activepal[l1,1]:=l1 div 2;
    activepal[l1,2]:=l1 div 2;
    activepal[l1,3]:=0;
   end;
{ulozi paletu}
{vymaze paletu na fadein}
setpalette;
getpalette;
nullpalette;
end; {Setuppal}

procedure Lpcx(fn:string;where:word);
var bo:boolean;
begin
  total:=1;
  infodat[1]:=fn;
  bo:=loadpcx(1,where,true);
end;

procedure fade;
var a:integer;
begin
 for a:= 128 to 255 do
  begin
   If StorePal[a,1] > ActivePal[a,1] then
    activepal[a,1]:=ActivePal[a,1]+1;
   If StorePal[a,2] > ActivePal[a,2] then
    activepal[a,2]:=ActivePal[a,2]+1;
  end;
   SetPalette;
end;

procedure fade2;
var a:integer;
begin
 for a:= 128 to 255 do
  begin
   If ActivePal[a,1] > 0 then
    activepal[a,1]:=ActivePal[a,1]-1;
   if ActivePal[a,2] > 0 then
    activepal[a,2]:=ActivePal[a,2]-1;
  end;
   SetPalette;
end;



procedure dobump2; {Now u guess what this one does..hehehe}
var difx,   {The X axis difference}
    dify,   {The Y axis difference}
    col,a:byte; {Used in many points..}
    l1:integer; {General use}
    konec:boolean;

begin
konec:=false;
  for timer:=1 to maxframe do
  begin
   for l1:=0 to 90 do
    begin
    lx:=sincosx[l1];
    ly:=sincosy[l1];
    {^^^^ those two make sure the light moves in a nice round path..}
     for x:=1 to 318 do
      for y:=1 to 198 do begin
      {This were the important stuff is done}
      {Here we will light the point x,y if lx,ly is the light position}

        vlx:=x-lx; {Calculate the L vector}
        vly:=y-ly; {>>>>>>>>>>>>>>>>>>>>>>}
        if (vlx<150) and (vlx>-150) and (vly>-150) and (vly<150 ) then begin
        {This is some stupid way to gain speed.. if the light vector is too
        far away from the point we want to light then don't bother..it
        will probably get no light..}
          nx:=mem[vaddr:x+y*320+1]-mem[vaddr:x+y*320-1];
          ny:=mem[vaddr:x+(y+1)*320]-mem[vaddr:x+(y-1)*320];
{Those two lines are the heart of bumping}
{We have a pixel, say x,y and we want to find how its normal vector
is facing.. (that is its slope...) normaly we would have to mess with
cos and sin and other shitty stuff but here we only care about something
like a pseudo-normal.. in other words we only care about the Sign.. that
is there are three possible pseudo normals:
1) nx<0 (Normal facing right)
   nx>0 (Normal facing left)
   nx=0 (Normal sticking out of the screen)
and its the same story with ny.. (it can be facing up,down or sticking out..}
{To find this orientation we get 2 pixels.. the one left and the one right (or
the one up and the one down for ny) and we sub.. the result is the N vector
for our point 10,10}

{The rest is easy.. we have two vectors now.. N,L.. we want their coordinates
to be as close as possible (the closer they are the more light gets the pixel}
          col:=abs(vlx-nx);
          {that is what I just said written in mathematics hehehe}
          if col>127 then col:=127;
          {Just not to overflow}
           difx:=127-col;
          {^^^^ that is the first component of the final color.. the
          light we get from the X axis}
          if difx<0 then difx:=1;

          {Now we do the same stuff for the Y axis }
          col:=abs(vly-ny);
         if col>127 then col:=127;
         dify:=127-col;
        if dify<0 then dify:=1;
        {finaly we add the two intensities and we're done..}
        col:=(difx+dify) ;
        if col>128 then
         begin
           virtputpixel(vaddr2,x,y,col);
         end;
          {That's it.. put the damn pixel}
       {putpixel(x,y,col,vaddr2);}
     end;
    end;
   if ((l1<64)and(timer=1)) then fade;
   if ((l1>(90-64))and(timer=maxframe)) then
    begin
     fade2;
    end;
   waitretrace;
   flip32(vaddr2,sega000);
   cls32(vaddr2,0);
   waitretrace;
   if port[$60]=$01 then
    begin
     l1:=90;
     konec:=true;
     timer:=maxframe;
    end;
   end;
 end;
end;






begin
  asm
    mov ax,13h
    int 10h
  end;
  setupvirtual;
  cls32(vaddr,0);
  cls32(vaddr2,0);
  lpcx('remap3.pcx',vaddr);
  {This will add some noise to the picture.. enable it if u like
  for l1:=1 to 63999 do
  mem[vaddr:l1]:=mem[vaddr:l1]+random(20);}

  setuppal; {Set the pallete}
  gensincos;
  uprav;
  dobump2;   {do it.. :)}
  shutdown;
  asm
    mov ax,3h
    int 10h
  end;
end.
