{$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 setonecolor(c,r,g,b:byte);assembler;
asm
  mov dx,3c8h
  mov al,c
  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 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;


var
Aantal, T1: longint;
Timer                : Longint ABSOLUTE $0040:$006C;
q:word;
start_time,old_time, elapsed_time:longint;
cx, z, sx, xt,n,x,y:integer;
i, col, xtr,ytr:word;
tcos, tsin:integer;
horizont:shortint;
w,h:byte;
rotate:single;

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


asm
mov ax, 13h
int 10h
end;{}

LoadTga('hex4.tga', 65535, vaddr2);


{precalc table}
for y:=0 to 255 do
for x:=0 to 255 do begin
      z:=y shl 1 +1;
      xt:=((x-160)*128 div z);
      mem[vaddr3:word((x-160)*256+y)]:=byte(xt);
end;

for n:=0 to 511 do begin
mem[vaddr+4000:n]:=round(abs(sin(pi*2/512 *n)*20-25));
end;


w:=0;
for col:=0 to 63 do begin
if col>58 then w:=w+1;
SetOneColor(63-col, col shr 4+w , col shr 3+w, col shr 2+w );
end;{}



Aantal:=0; T1:=Timer;

repeat
q:=q+1;


w:=q and 255;
h:=q and 255;

rotate:=cos(q/150)*2;

Tcos := round(cos(rotate)*120);
Tsin := round(sin(rotate)*120);

WaitVR;{}

for x:=0 to 319 do begin
  {horizont:=abs(round(sin(x/180+q/50)*20-25));}
  horizont:=mem[vaddr+4000: (x shr 1+q) and 511];

  sx:=Tcos*(x-160);
  cx:=Tsin*(x-160);
  xtr:= word((sx - Tsin shl 7)) and 65280;
  ytr:= word((cx + Tcos shl 7)) and 65280;
  ytr:= ytr-xtr;

asm
  mov di, x
  mov si, xtr
  mov bx, ytr
  mov dl, w
  mov dh, h

  {------self-modify-------}
  mov cs:[offset @ytr+3], bx
  mov cs:[offset @wh1+1], dx
  mov cs:[offset @wh2+1], dx
  mov cs:[offset @wh3+1], dx
  mov cs:[offset @wh4+1], dx
  jmp @clear_prefetch; @clear_prefetch:
  {-------------------------}


  mov ax, VGA
  mov es, ax
  mov ax, vaddr2 {texture}
  db $8E,$E0 {mov fs, ax}

  xor ax, ax
  mov cx, 200
  mov al, horizont
  sub cl, al
  push cx

  shr cx, 2

  push bp
  push ds
  mov ds, vaddr3 {table}


  {draw sky column}
  @sky:
    mov byte ptr es:[di], al
    add di, 320
    dec al
  jnz @sky

  mov bp, cx
  @y:
      db $66; mov cx, ds:[si]
      @ytr: db $66; mov dx, ds:[si+1234h]

      @wh1: mov bx, 1234h
      add bl, cl
      add bh, dl
      db $64; mov al, [bx]

      test al, al
      jz @zero
      mov ah, al
      jmp @draw
          @zero:
          mov al, ah
      @draw:
      mov es:[di], al

      @wh2: mov bx, 1234h
      add bl, ch
      add bh, dh
      db $64; mov al, [bx]
      test al, al
      jz @zero2
      mov ah, al
      jmp @draw2
          @zero2:
          mov al, ah
          sub ah, 6
          sbb bl, bl
          not bl
          and ah, bl
      @draw2:
      mov es:[di+320], al

      db $66; shr cx, 16
      db $66; shr dx, 16

      @wh3: mov bx, 1234h
      add bl, cl
      add bh, dl
      db $64; mov al, [bx]
      test al, al
      jz @zero3
      mov ah, al
      jmp @draw3
          @zero3:
          mov al, ah
      @draw3:
      mov es:[di+320*2], al

      @wh4: mov bx, 1234h
      add bl, ch
      add bh, dh
      db $64; mov al, [bx]
      test al, al
      jz @zero4
      mov ah, al
      jmp @draw4
          @zero4:
          mov al, ah
          sub ah, 6
          sbb bl, bl
          not bl
          and ah, bl
      @draw4:
      mov es:[di+320*3], al

  add si, 4
  add di, 320*4
  dec bp
  jnz @y
  pop ds
  pop bp

  {draw bottom 1..3 pixels of column}
  pop cx
  and cx, 3
  jz @exit
  @sky1:
    mov byte ptr es:[di], al
    add di, 320
    dec cl
  jnz @sky1
  @exit:

end;


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.