{ MATRiX #2 DEMO  (x) 2000 Z0MBiE  }
{ compiler: TMT Pascal 2.11        }

{$OPTFRM+,OPT+,OPTREG+,A+,R-,I-,P-,T-,X+,B-,CC+,Q-,V-,S-,W+,D-,L-}

uses crt, zentimer;

{$i bkgr.inc}           { bkgr.bmp       256x128    64 colors }
{$i texture.inc}        { texture.bmp    320x200   256 colors }
{$i text.inc}           { text.bmp  TEXTSIZEx100     2 colors }

const
  TEXTSIZE = 4000;              { pixels }

type
  tvideo = array[0..200-1,0..320-1] of byte;
  pvideo = ^tvideo;

procedure apply_bkgr(p:pvideo; deltax,deltay:dword);
  var
     x,y:integer;
  begin

  asm
    mov edi, p

    xor edx, edx

    mov ebx, &deltay
    shl ebx, 8

@@1:
    {
    mov edi, edx
    xor edi, 1
    imul edi, 320
    add edi, p
    }

    mov ecx, &deltax

    lea esi, bkgr + bkgr_num - 256 + 256
    sub esi, ebx
    sub esi, &deltax

    mov eax, ecx
    and eax, 3
    shr ecx, 2
    rep movsd
    mov ecx, eax
    rep movsb

    mov ecx, 320
    sub ecx, &deltax

    lea esi, bkgr + bkgr_num - 256
    sub esi, ebx

    mov eax, ecx
    and eax, 3
    shr ecx, 2
    rep movsd
    mov ecx, eax
    rep movsb

    add ebx,   1*256
    and ebx, 127*256

    inc edx
    cmp edx, 200
    jb  @@1
  end;
{
    for y:=0 to 12 do
    for x:=0 to 319 do
      if p^[y shl 4+8,x ]<>62 then
         inc(p^[y shl 4+8,x ],64);
    for x:=0 to  19 do
    for y:=0 to 199 do
      if p^[y ,x shl 4+8]<>62 then
         inc(p^[y ,x shl  4+8 ],64);
}
  end;

const
  text_x : longint = 0;

procedure apply_text(p:pvideo);
  begin
    asm
      mov edi, p
      add edi, 320*50          { x0=0 y0=50 }

      lea esi, text + text_num - TEXTSIZE/8

      mov eax, text_x
      shr eax, 3
      add esi, eax

      mov eax, text_x
      and eax, 7
      sub eax, 7
      not eax
      add edi, eax

      mov edx, 100
@@1:
      mov ecx, 320/8

@@4:

      lodsb

      mov ebx, 8
@@3:
      inc edi
      shl al, 1
      jc  @@2

      xor byte ptr [edi-1], 63 + 64

@@2:  dec ebx
      jnz @@3

      dec ecx
      jnz @@4

      sub esi, 320/8+TEXTSIZE/8
      dec edx
      jnz @@1
    end;
  end;

var
  video : tvideo absolute $a000:0;
  p,o,icolor : tvideo;
  pal:array[0..255] of record r,g,b:byte end;
  index,mode : longint;
  xcoord, ycoord : array[0..199,0..319] of integer;

  j,i,t,q,c1,c2,lim : longint;
  rz,rx,ry,x,y,z : longint;

begin

  asm
    mov ax, 13h
    int 10h
  end;

  for i:=0 to 63 do
  begin
    pal[i].r:=(bkgr[1+$36+i*4+2] * 63 div 255);
    pal[i].g:=(bkgr[1+$36+i*4+1] * 63 div 255);
    pal[i].b:=(bkgr[1+$36+i*4+0] * 63 div 255);
  end;
  for i:=0 to 63 do
  begin
    pal[64+i].r:=(bkgr[1+$36+i*4+2] * 63 div 255) * 2 div 3;
    pal[64+i].g:=(bkgr[1+$36+i*4+1] * 63 div 255) * 2 div 3;
    pal[64+i].b:=(bkgr[1+$36+i*4+0] * 63 div 255) * 2 div 3;
  end;

  pal[64+1].r:=0;
  pal[64+1].g:=0;
  pal[64+1].b:=0;

  index:=0;
  mode:=1;

  ZTimerInit;
  LZTimerOn;

  t:=0;
  lim:=1;

  c1:=0;
  c2:=0;

  for y:=0 to 199 do
  for x:=0 to 319 do
  begin
    t := texture[1+$36+1024+(199-y)*320+x];
    xcoord[y,x]:= x + t * ( x div 3 ) div 256;
    ycoord[y,x]:= y + t * ( y div 2 ) div 256;
    icolor[y,x]:=128*byte(t<>0);
  end;

  repeat

    if mode<>0 then
    begin

      if mode=1 then begin inc(index); if index=63 then mode:=0; end;
      if mode=2 then begin dec(index); if index=0 then mode:=3; end;

      port[$3c8]:=0;
      for i:=0 to 127 do
      begin
        port[$3c9]:=pal[i].r*index div 63;
        port[$3c9]:=pal[i].g*index div 63;
        port[$3c9]:=pal[i].b*index div 63;
      end;
      for i:=0 to 127 do
      begin
        port[$3c9]:=pal[i].r;
        port[$3c9]:=pal[i].g;
        port[$3c9]:=pal[i].b;
      end;
    end;

    q:=lztimerlap;

    inc(t);
    apply_bkgr(@p,round(5000+sin(t/500)*2000+
                             cos(t/60)*100
                       ) mod 256,
                  round(5000+cos(t/300)*1000+
                             sin(t/50)*100

                       ) mod 128);

    text_x := (text_x + 1) mod TEXTSIZE;
    if text_x>=TEXTSIZE-320-64 then if mode=0 then mode:=2;

    apply_text(@p);

    for y:=0 to 199 do
    for x:=0 to 319 do
      o[y,x]:=p[ycoord[y,x],xcoord[y,x]]+icolor[y,x];

    asm
      lea esi, o
      mov edi, 0A0000h
      mov ecx, 320*200/4
      rep movsd
    end;

    if keypressed then
    case upcase(readkey) of
      'Q': break;
      #32: lim := lim xor 1;
      #27: mode:=2;
    end;

    if lim=1 then
      repeat
      until abs(lztimerlap-q) >= 1000000 div 60; { LIMIT FPS }

    c1:=c1+abs(lztimerlap-q);
    c2:=c2+1;

  until mode=3;

  asm
    mov ax, 3
    int 10h
  end;

  writeln(1000000 / (c1 / c2) :6:2,' fps');
end.