uses crt, dos;

const
VGA=$a000;

TYPE
  Virtualscreen = Array[1..65535] of byte;
  Virscr = ^VirtualScreen;

var
 scr, scr2, scr3, scr4, scr5, scr6, scr7: virscr;
 vaddr, vaddr2, vaddr3, noise1, bumpmap1, bumpmap2 : word;

  Aantal, T1: longint;
  Timer                : Longint ABSOLUTE $0040:$006C;


Procedure FlipScreen(source, dest : word);
Assembler; {386 only}
asm
  mov     dx, ds
  mov     ax, [dest]
  mov     es, ax
  mov     ax, [source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 16000
  db      $66
  rep     movsw
  mov     ds,dx    {mov's are faster than push / pops }
end;


PROCEDURE Clear(size,where:word);assembler;
     ASM
        mov ax,where
        mov es,ax
        mov cx, size
        shr cx, 2
        db $66
        xor ax,ax
        xor di,di
        cld
        db $66
        rep stosw
END;

procedure Fblur(where:word); assembler;
 asm
  mov es, where
  mov di, 0
  mov cx, 65535
  @here:
    xor dx, dx
    xor ax, ax
    mov dl, es:[di+1]
    mov al, es:[di-1]
    add dx, ax
    mov al, es:[di+320]
    add dx, ax
    mov al, es:[di-320]
    add dx, ax

    shr dx, 2
    mov es:[di], dl
    add di, 1
    dec cx
  jnz @here
 end;


PROCEDURE SetUpVirtual(VAR screenname:virscr;VAR add : word);
BEGIN
  GetMem (Screenname,65535);
  add := seg (Screenname^);
  clear(65535,add);
END;


Procedure WaitVR; Assembler;
ASM
  mov  dx, 3DAh
@w1:
    in   al, dx
    test al, 8h
  jnz  @w1
@w2:
    in   al, dx
    test al, 8h
  jz   @w2
End;

Procedure CreateNoice(where:word);
var i,j:integer;
begin
for i := 0 to 204 do for j := 0 to 319 do mem[where:word(j+i*320)]:=random(255);
end;

Procedure CreateBumpmap(from, where1,where2:word);
var  i,j:integer;
     nx,ny:shortint;
begin
for j := 0 to 199 do
for i := 0 to 319 do begin
  nx:=mem[from:word(i-2+j*320+640)]-mem[from:word(i+2+j*320+640)];
  ny:=mem[from:word(i+(j-2)*320+640)]-mem[from:word(i+(j+2)*320+640)];
  if j<100 then begin
    mem[where1:word((i+j*320) shl 1)]:=byte(nx) and 254;
    mem[where1:word((i+j*320) shl 1+1)]:=byte(ny);
    end
    else begin
    mem[where2:word((i+(j-100)*320) shl 1)]:=byte(nx) and 254;
    mem[where2:word((i+(j-100)*320) shl 1+1)]:=byte(ny);
    end;
 end;
end;



var
count_pixels:word;
path_color:byte;
procedure ScanBall(x,y:word);
var h, xx,yy:word;
begin
 h:=9;
 for xx:=x-h to x+h do for yy:=y-h to y+h do
   if mem[vaddr2:word(xx+yy*320)]=255 then
     begin
         if path_color<mem[vaddr3:x+y*320] then
            if mem[vaddr3:x+y*320]<path_color+4 then path_color:=mem[vaddr3:x+y*320];

         if (path_color=mem[vaddr3:word(xx+yy*320)]) or
            (path_color+1=mem[vaddr3:word(xx+yy*320)])

            then begin
            mem[vaddr2:word(xx+yy*320)]:=0;
            mem[vga:xx+yy*320]:=byte(mem[vga:xx+yy*320]+15);{}
{            if yy<100 then memw[vga:xx+yy*320]:=memw[bumpmap1:(xx+yy*320) shl 1]+1
                      else memw[vga:xx+yy*320]:=memw[bumpmap2:(xx+(yy-100)*320) shl 1]+1;{}


            memw[vaddr:count_pixels shl 2]:=word(xx+yy*320);

            if yy<100 then memw[vaddr:count_pixels shl 2+2]:=memw[bumpmap1:(xx+yy*320) shl 1]+1
                      else memw[vaddr:count_pixels shl 2+2]:=memw[bumpmap2:(xx+(yy-100)*320) shl 1]+1;
            inc(count_pixels);
            end;
     end;
   {WaitVR;{}
end;


procedure line(xEnd, yEnd, xBeg, yBeg:integer; clr:byte; where:word);
var
n, x, y, T, E, dx, dy, denom, xInc, yInc, vLng, tmp:integer;
begin
  xInc:=1; yInc:=1; vLng:=0;
  dx := xEnd - xBeg;
  dy := yEnd - yBeg;
  if(dx < 0) then begin xInc := -1; dx := -dx; end;
  if(dy < 0) then begin yInc := -1; dy := -dy; end;
  if(dy > dx) then begin vLng := 1; tmp:=dx; dx:=dy; dy:=tmp; end;
  denom := dx shl 1;
  T := dy shl 1;
  E := -dx;
  x := xBeg;
  y := yBeg;
  for n:=0 to dx do
  begin
        mem[where:word(x+y*320)]:= clr;{}
        ScanBall(x,y);{}
    E:=E+T;
    if(E>0) then begin
      if(vLng=1) then x:= x+xInc else y:=y+yInc;
      E := E-denom;
    end;
    if(vLng=1) then Y := y+yInc else x := x+xInc;
  end;
end;




var
TunTex            : Pointer;
TunTexSeg         : Word;

Procedure LoadTga(TgaName : String);
Var
  InF   : File; Loop : Word;
  Dummy : Array[1..18] of Byte;
  Pal   : Array[1..768] of Byte;

Begin
  Assign(Inf,TgaName);
  Reset(Inf,1);
  BlockRead(Inf,Dummy,18);
  BlockRead(Inf,Pal,768);
  BlockRead(Inf,TunTex^,64000);
  Close(Inf);
  Port[$3C8]:=0;
  Loop:=1;
  While Loop<768 Do
    Begin
      Port[$3C9]:=Pal[Loop+2] Div 4;
      Port[$3C9]:=Pal[Loop+1] Div 4;
      Port[$3C9]:=Pal[Loop] Div 4;
      Inc(Loop,3);
    End;

End;


var
fw1,fw2:file;

c, x,y,n,m:word;
num_point, col, found:byte;
point_x, point_y, point_col:array[0..255] of word;
temp:word;
fr:file;
b:byte;
size:word;

begin
SetUpVirtual(scr,vaddr);
SetUpVirtual(scr2, vaddr2);
SetUpVirtual(scr3, vaddr3);
SetUpVirtual(scr4, Noise1);
SetUpVirtual(scr5, BumpMap1);
SetUpVirtual(scr6, BumpMap2);

asm
mov ax, 13h
int 10h
end;


GetMem(TunTex,65535); TunTexSeg:=Seg(TunTex^);
LoadTga('title_p.tga');
for n:=0 to 63999 do mem[vga:n]:=mem[TunTexSeg:n];
for n:=0 to 63999 do mem[vaddr:n]:=mem[TunTexSeg:n];

LoadTga('title_f.tga');
for n:=0 to 63999 do mem[vaddr2:n]:=mem[TunTexSeg:n];

LoadTga('title_z.tga');
for n:=0 to 63999 do mem[vaddr3:n]:=mem[TunTexSeg:n];


CreateNoice(Noise1);

for n:=0 to 64000 do
if mem[vaddr2:n]<>0 then mem[Noise1:n]:=1; {add text to noise-map}

for n:=0 to 6 do Fblur(Noise1);

CreateBumpmap(Noise1, BumpMap1, BumpMap2); {whith text}


for n:=0 to 255 do point_col[n]:=0;

num_point:=0;
for col:=1 to 120 do begin
found:=0;
for y:=0 to 199 do begin for x:=0 to 319 do begin
    if mem[vaddr:x+y*320]=col then
        begin
          point_x[num_point]:=x;
          point_y[num_point]:=y;
          inc(num_point);
          found:=1;
          break;
        end;
  end;
  if found=1 then break;
end;
end;

Clear(64000, vaddr);
Count_Pixels:=0;


for n:=1 to num_point-1 do
   Line(point_x[n],point_y[n], point_x[n-1], point_y[n-1], 7, vga);

readkey;

Clear(64000, vga);


  Assign(fw1, 'title.bin');
  Rewrite(fw1,1);
  Reset(fw1, 1);


for n:=0 to (count_pixels-1) div 32 do
begin
   for y:=0 to 31 do begin
   x:=memw[vaddr:m shl 2];
   c:=memw[vaddr:m shl 2+2];
   mem[vga:x]:=15;
   inc(m);
        BlockWrite(fw1, x, 2);
        BlockWrite(fw1, c, 2);
   end;
{WaitVR;{}
end;
Close(fw1);

Clear(64000, vaddr);
Clear(64000, vga);

Assign(fr, 'title.bin');
Reset(fr, 1);
Size:=FileSize(fr);
for n:=0 to (Size-1) div 4 do
   begin
      BlockRead(fr, x, 2);
      BlockRead(fr, c, 2);
      memw[vaddr:n*4]:=x;
      memw[vaddr:n*4+2]:=c;
      {mem[vga:memw[vaddr:n*4]]:=1;}
   end;
Close(fr);

for n:=0 to (Size-1) div 4 do begin
x:=memw[vaddr:n*4];
mem[vga:x]:=mem[vaddr:n*4+2];{}
end;

readkey;

Aantal:=0; T1:=Timer;
repeat
{Clear(64000, vaddr);}

n:=n+1;




WaitVR;{}
{FlipScreen(vaddr,vga);{}
Inc(Aantal);
until port[$60]=1;

asm
mov ax, 3h
int 10h
end;
T1:=timer-T1;
WriteLn(Aantal/(T1/18.2):2:1,' Frames per second');
WriteLn(count_pixels);
WriteLn(temp);
readkey;
repeat until keypressed;

end.