{$N+,A+,G+,F+,D-,E+,L-,R-,S-,Q-,Y-,I-}

{ The effect was coded especially for Demoded }
{ Code: bitl/7dump 2025 }

const
VGA=$a000;

type
  Virtualscreen = Array[1..65535] of byte;
  Virscr = ^VirtualScreen;
var
  scr, scr2, scr3: virscr;
  vaddr, vaddr2, vaddr3: word;

procedure SetUpVirtual(VAR screenname:virscr;VAR add : word);
var n:word;
begin
  GetMem (Screenname,65535);
  add := seg (Screenname^);
  for n:=0 to 65535 do mem[add:n]:=0;
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 LoadTga(TgaName:string; size:longint; where:word);
var
InF: File of byte;
n: word;
pal:array[0..767] of byte;
begin
  Assign(Inf,TgaName);
  Reset(Inf);
  seek(Inf, 18);
  for n:=0 to 767 do read(Inf,pal[n]);
  for n:=0 to size-1 do read(Inf, mem[where:n]);
  Close(Inf);
  port[$3C8]:=0;
  n:=0;
  while n<767 do {set palette}
    begin
      port[$3C9]:=pal[n+2] shr 2;
      port[$3C9]:=pal[n+1] shr 2;
      port[$3C9]:=pal[n]   shr 2;
      n:=n+3;
    end;
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 CreateNoice(where:word);
var i,j:word;
begin
   RandSeed:=0;
   for i := 0 to 204 do for j := 0 to 319
   do mem[where:word(j+i*320)]:=byte(random(255));
end;

Procedure CreateBumpmap(from,  where,where2:word);
var  i,j:integer;
     nx,ny:shortint;
begin
for j := 0 to 199 do
for i := 0 to 319 do begin

  nx:=shortint(mem[from:word(i-2+j*320+640)]   - mem[from:word(i+2+j*320+640)]);
  ny:=shortint(mem[from:word(i+(j-2)*320+640)] - mem[from:word(i+(j+2)*320+640)]);

  if j<100 then
    memw[where:word((i+j*320) shl 1)]       :=byte(nx) + word(ny shl 8)
    else
    memw[where2:word((i+(j-100)*320) shl 1)]:=byte(nx) + word(ny shl 8);
 end;
end;


Procedure Draw(lightx, lighty:integer; texture, outp:word);
var offset_di, offset_si:integer;
begin
offset_di:=0; offset_si:=0;
if lightx<0 then begin offset_di:=abs(lightx); offset_si:=offset_di; end;
if lightx>319-255 then begin
offset_di:=0; offset_si:=-(lightx-(319-255)); lightx:=319-255;end;
asm
mov es, outp
mov ax, texture
db $8e,$e0 {mov fs, ax}
mov si, lighty
mov di, lightx
add di, offset_di
sub si, offset_si
push ds
push bp
mov ds, vaddr
mov bp, di
shl bp, 1

mov ch, 99
@j:
    mov cl, 0
    @i:
        db $66; mov bx, ds:[bp]
        add bx, cx
        db $64; mov al, [bx+si]
        db $66; shr bx, 16
        add bx, cx
        db $64; mov ah, [bx+si-1]
        mov es:[di], ax

        db $66; mov bx, ds:[bp    +4]
        add bx, cx
        db $64; mov al, [bx+si    -2]
        db $66; shr bx, 16
        add bx, cx
        db $64; mov ah, [bx+si-1  -2]
        mov es:[di+2], ax

        add di, 2 *2
        add bp, 4 *2
        sub cl, 2 *2
    jnz @i
    add di, 64
    add bp, 128
dec ch
jns @j
pop bp
pop ds

push ds
push bp
mov di, lightx
add di, offset_di
mov ds, vaddr2
mov bp, di
shl bp, 1
add di, 320*100
mov ch, 0
@j2:
    mov cl, 0
    @i2:
        db $66; mov bx, ds:[bp]
        add bx, cx
        db $64; mov al, [bx+si]
        db $66; shr bx, 16
        add bx, cx
        db $64; mov ah, [bx+si-1]
        mov es:[di], ax

        db $66; mov bx, ds:[bp    +4]
        add bx, cx
        db $64; mov al, [bx+si    -2]
        db $66; shr bx, 16
        add bx, cx
        db $64; mov ah, [bx+si-1  -2]
        mov es:[di+2], ax

        add di, 2 *2
        add bp, 4 *2
        sub cl, 2 *2
    jnz @i2
    add di, 64
    add bp, 128
dec ch
cmp ch, 157
jae @j2
pop bp
pop ds
end;
end;




var
n,m:integer;
xx,yy,i,j,x,y,q:word;
lightx,lighty:integer;
Aantal, T1: longint;
Timer: Longint ABSOLUTE $0040:$006C;


begin
SetUpVirtual(scr,vaddr);
SetUpVirtual(scr2, vaddr2);
SetUpVirtual(scr3, vaddr3);



asm
mov ax, 13h
int 10h
end;


CreateNoice(vaddr3);{}

{---- draw smile ----}
for n:=0 to 63 do begin xx:=round(sin(n/10)*65+160); yy:=round(cos(n/10)*55+100);
for y:=0 to 9 do for x:=0 to 9 do mem[vaddr3:x+xx+(y+yy)*320]:=60; end;
for n:=50 to 76 do begin xx:=round(sin(n/10)*40+160); yy:=round(cos(n/10)*30+100);
for y:=0 to 9 do for x:=0 to 9 do mem[vaddr3:x+xx+(y+yy)*320]:=60; end;
for y:=0 to 15 do for x:=0 to 15 do begin mem[vaddr3:x+135+(y+80)*320]:=0; mem[vaddr3:x+175+(y+80)*320]:=0; end;
{--------------------}

{blur}
for i:=0 to 6 do Fblur(vaddr3);

{Make bump map}
CreateBumpMap(vaddr3, vaddr,vaddr2);

LoadTGA('texture.tga', 256*256, vaddr3);

Aantal:=0; T1:=Timer;
repeat
q:=q+1;

lightx:=round(-sin(q/35)*45+35);
lighty:=round(cos(q/60)*50+128);

WaitVR;{}

Draw(lightx,lighty*256, vaddr3, vga);{ Frame render }


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');

end.