{$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 GenUVTable1(x0,y0: word; buf1,buf2:word);
var
x,y:integer;
r:single;
u,v:byte;
begin
    for y:=0 to 199 do
     for x:=0 to 319 do
       begin
          r:=sqrt((y-y0)*(y-y0)+(x-x0)*(x-x0));
          v:= ((X-x0)*64) div round(192-r);
          u:= ((Y-y0)*64) div round(192-r);{}
          if y<100 then memw[buf1:word((x+y*320) shl 1)]:=v+u*256
          else memw[buf2:word((x+(y-100)*320) shl 1)]:=v+u*256;
       end;
end;


Procedure GenUVTable2(x0,y0: word; buf1,buf2:word);
var
x,y:integer;
a:single;
r:single;
color,u,v:byte;
begin
    for y:=0 to 199 do
     for x:=0 to 319 do
       begin
          if (x-x0>0) and (y-y0>=0) then a:=arctan((y-y0) / (x-x0));
          if (x-x0>0) and (y-y0<0)  then a:=arctan((y-y0) / (x-x0))+2*pi;
          if (x-x0=0) and (y-y0>=0) then a:=arctan(y-y0);
          if (x-x0=0) and (y-y0<0)  then a:=arctan(y-y0)+2*pi;

          if (x-x0<0) then a:=arctan((y-y0) / (x-x0))+pi;
          a:=a / (2*pi);

          r:=sqrt((y-y0)*(y-y0)+(x-x0)*(x-x0));

          u:=byte(round(a*256));
          {u:=byte(round(u-r*3)); {twirl}
          v:=byte(round(r));

          if y<100 then memw[buf1:word((x+y*320) shl 1)]:=v+u*256
          else memw[buf2:word((x+(y-100)*320) shl 1)]:=v+u*256;
       end;
end;



var
distort_type, q_, vdi, vbp, q, mapseg, n:word;
y:integer;

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


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

distort_type:=1;

if distort_type=0 then GenUVTable1(160,99,vaddr2,vaddr3);
if distort_type=1 then GenUVTable2(160,99,vaddr2,vaddr3);


for n:=0 to 511 do
memw[vaddr2:n shl 1 +64000]:=integer(round(sin(6.283185307/512 *n)*128));{}

asm
mov ax, 13h
int 10h
end;

LoadTga('blob2.Tga', 65535, vaddr);


q:=0; Aantal:=0; T1:=Timer;
repeat
q:=q+1;
q_:=q*6;

vbp:=0;
vdi:=0;

WaitVR;{}

for y:=0 to 199 do begin

   if distort_type=0 then
        n:=word(integer(memw[vaddr2:64000 +( (q_ -y shr 1) and 511) shl 1]) div 3 +128 + q shl 10)
   else n:=word(integer(memw[vaddr2:64000 +( (q_ shr 1 -y) and 511) shl 1]) shl 8 +q shl 8 + 32);

   if vbp>=64000 then vbp:=0;

   if y<100 then mapseg:=vaddr2 else mapseg:=vaddr3;
   asm
   push ds
   push bp

   mov ax, VGA
   mov es, ax

   mov ax, vaddr
   db $8e,$e0 {mov fs, ax}

   mov si, n
   mov dx, vbp
   mov di, vdi
   mov ds, mapseg
   mov bp, dx
   mov cx, 80/4
   @x:            { Draw line }
      db $66; mov bx, ds:[bp+4]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; shl ax, 16
      db $66; mov bx, ds:[bp]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; mov es:[di], ax

      db $66; mov bx, ds:[bp+4 +8]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; shl ax, 16
      db $66; mov bx, ds:[bp   +8]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; mov es:[di       +4], ax

      db $66; mov bx, ds:[bp+4 +16]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; shl ax, 16
      db $66; mov bx, ds:[bp   +16]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; mov es:[di       +8], ax

      db $66; mov bx, ds:[bp+4 +24]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; shl ax, 16
      db $66; mov bx, ds:[bp   +24]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; mov es:[di       +12], ax

      add di, 4*4
      add bp, 8*4
   dec cx
   jnz @x
   pop bp
   pop ds
   end;

vbp:=vbp+640;
vdi:=vdi+320;

end;



Inc(Aantal);
until port[$60]=1;


asm
mov ax, 03h
int 10h
end;
T1:=timer-T1;
WriteLn(Aantal/(T1/18.2):2:1,' Frames per second');

end.