
program testtmap;
uses crt,gfx3,tmap2,m3d52,catalib,cfloor2;



var l1,ode,l3,l4,fr:integer;
    l2:word;
    c1,c2,c3:byte;
    co:integer;
    Tractor,Factor:Word;
    step:integer;
    sp:array[1..255,1..3] of byte;
    st:string;
    up:boolean;
    ok:boolean;
    rndmatrix:pointer;

Procedure SetUpVirtual;
   { This sets up the memory needed for the virtual screen }
BEGIN
  GetMem (VirScr,64000);
  vaddr := seg (virscr^);
    GetMem (VirScr2,64000);
  vaddr2 := seg (virscr2^);
    GetMem (VirScr3,64000);
  vaddr3 := seg (virscr3^);
END;


Procedure Smooth2(Where:Word);assembler;
Var M:Word;

Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Mov Di,322
 @MainLoop:
  Mov M,0
  Xor Al,Al
  Mov Al,Es:[Di]
  Mov M,Ax
  Dec Di
  Mov Al,Es:[Di]
  Add M,Ax
  Add Di,2
  Mov Al,Es:[Di]
  Add M,Ax
  Sub Di,322
  Mov Al,Es:[Di]
  Add M,Ax
  Inc Di
  Mov Al,Es:[Di]
  Add M,Ax
  Inc Di
  Mov Al,Es:[Di]
  Add M,Ax
  Add Di,638
  Mov Al,Es:[Di]
  Add M,Ax
  Inc Di
  Mov Al,Es:[Di]
  Add M,Ax
  {Inc Di
  Mov Al,Es:[Di]
  Add M,Ax      }
  Shr M,3
  Mov Bx,M
  Sub Di,320
  Mov Es:[Di],Bl


  Inc Di
  Cmp Di,63361
 Jne @MainLoop
End;


{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
Procedure ShutDown;
   { This frees the memory used by the virtual screen }
BEGIN
  FreeMem (VirScr,64000);
  freemem(virscr2,64000);
    freemem(virscr3,64000);
END;


Procedure MotionClear(Var D; Step : Byte); Assembler;
Asm
  Les  di,D
  Mov  bl,Step
  Mov  cx,64000
 @Looper:
  Mov al,es:[di]
  Sub al,bl
  Jns @SkipZero
  Mov al,0
 @SkipZero:
  Mov es:[di],al
  Inc di
  Dec  cx
  Jnz @Looper
End;

procedure buildpal;
var l1:integer;
     r,g,b:byte;
begin
  for l1:=1 to 255 do begin
    r:= palar[l1,1];
    g:=palar[l1,2];
    b:=palar[l1,3];
    pal(l1,r,g,b);
  end;
end;


Procedure ShowEdges(How:Word);
Var Lw:Word;
Begin
  setup('helios.euv');
  zoff:=-150;
  d:=0.5;
  l1:=0;
  for l1:=1 to 255 do pal(l1,l1 div 5,l1 div 5,l1 div 4);
  cls(vaddr2,0);
  Pal(255,0,0,0);
{ setuprefpal;}
     Ambient:=20;
  repeat
    If Ticks>115 Then Tractor:=8;
    l1:=(l1+Tractor) mod 360;
    rotatepoints2(l1,l1,0);
    showpolys(0,vaddr);
    hline(1,319,199,0,vaddr);
    hline(1,319,198,0,vaddr);
    hline(1,319,197,0,vaddr);
    hline(1,319,196,0,vaddr);

    fedges(Factor,vaddr,vaddr2);
    flip32(vaddr2,sega000);
    cls(vaddr,0);
{
    cls(vaddr2,0);}
{     Smooth2(Vaddr);
     Smooth2(Vaddr2);}
     Smooth2(Vaddr2);
     Smooth2(Vaddr2);
  until (Ticks>How) or (keypressed);
  shut;
End;


 procedure smallscr(w:word);
var wo,w2:word;
    b:byte;
begin
  w2:=0;
  for wo:=1 to 15999 do begin
     w2:=wo*4;
     b:=mem[w:w2];
     w2:=w2+random(4);
     mem[sega000:w2]:=b;
  end;

end;


procedure spallete;
var ll:integer;
    r,g,b:byte;
begin
  for ll:=1 to 255 do begin
     getpal(ll,r,g,b);
     sp[ll,1]:=r;
     sp[ll,2]:=g;
     sp[ll,3]:=b;
  end;
end;

procedure rpallete;
var ll:integer;
    r,g,b:byte;
begin
  for ll:=1 to 255 do begin
     r:=sp[ll,1];
     g:=sp[ll,2];
     b:=sp[ll,3];
     pal(ll,r,g,b);
  end;
end;

procedure wpallete;
var ll:integer;
begin
  for ll:=1 to 255 do pal(ll,63,63,63);
end;

Procedure Fade1;
  { This fades up the pallette to white }
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
BEGIN
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]<63 then inc (Tmp[1],1);
      If Tmp[2]<63 then inc (Tmp[2],1);
      If Tmp[3]<63 then inc (Tmp[3],1);
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    END;
END;



{$i tflip}


begin
  SetUpMidas;
  PlayMusic;
  setupvirtual;
  setmcga;
  Ticks:=0;
   Cls(Sega000,0);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Factor:=50;
  Tractor:=2;
  ShowEdges(240);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Cls(Sega000,0);
  Lpcx('cebor4.pcx',sega000);
  pal(0,10,10,10);
  Repeat
  Until Ticks>345;
  pal(0,0,0,0);
  Cls(Sega000,0);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Factor:=30;
  ShowEdges(468);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Cls(Sega000,0);
  Lpcx('timamu4.pcx',sega000);
  pal(0,10,10,10);
  Repeat

  Until Ticks>570;
  pal(0,0,0,0);
  Cls(Sega000,0);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Factor:=15;
  ShowEdges(708);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);

  shut;



  tsetup('rocket.euv');


  cls32(sega000,0);
  tsetrocket('romap.pcx',vaddr);

  pal(0,10,10,10);
  tzoff:=-1000;
  txoff:=160;
  tyoff:=100;
  trotatepoints2(90,1,1);
  l1:=0;
  resett1;
  repeat
  {synch patent:
    ticks:700->750=50 ticks
    steps:1000-100=900 steps
    thisstep:=(currenttick/50 ticks)*900 steps)}
   tzoff:=-(1000-round(t1/50*900));

   tshowtext(vaddr);
   flip32(vaddr,sega000);
   if tzofF>-200 then fade1;

  until t1=50;
  l1:=0;
  cls(sega000,255);
  tshut;


  tsetup('room.euv');
  setup('helios.euv');
  Cls(Sega000,0);
  tsettmap('remap2.pcx','woodmap.pcx',vaddr);
  Getmem (RndMatrix,4100);
  SetupRNDMatrix (seg(RndMatrix^),8);
                              { ^ -> max value}

  setuprefpal;
  repeat
  until (ticks>750);


  l1:=0;
  tzoff:=-50;
  zoff:=-150;
  td:=0.5;

  d:=0.3;
  cls(vaddr2,0);
  ambient:=20;
  con:=64;
  RANDOMIZE;
  ode:=l1;
  spallete;
  repeat
    l1:=(l1+5) mod (360);

    trotatepoints2(l1,l1,0);
    tshowtext(vaddr);

    rotatepoints2(0,l1,l1);
    showpolys(128,vaddr2);

    phongit(vaddr2,vaddr);
   {  for l2:=1 to 63999 do begin
       if mem[vaddr2:l2]>0 then mem[sega000:l2]:=mem[vaddr2:l2]+128
       else mem[sega000:l2]:=mem[vaddr:l2];
     end;}


        cls32(vaddr2,0);
          if t1>6 then begin
            resett1;
            wpallete;
            waitretrace;
            waitretrace;
            rpallete;
          end;

        if (ticks >1010) and (ticks<1040) then begin
          if t1>2 then begin
            resett1;
            wpallete;
            waitretrace;
            waitretrace;
            waitretrace;
            rpallete;
          end;
       end;


  until ticks>1050;
  tshutmap;

  tshut;

  shut;

  getmap('remap2.pcx',vaddr);
  setup('beams.euv');
  tsetup('rocket.euv');
  tsetrocket('romap.pcx',vaddr);


   zoff:=-80;
   yoff:=160;
    ambient:=-200;
    con:=128;
    d:=1;
  l1:=0;
  l3:=0;
  tzoff:=-400;
  tyoff:=110;
  cls(vaddr2,0);
  buildpal;

  l4:=0;
  repeat
    l1:=(l1+8) mod 360;
    l3:=l3+1;
{    if (l3>50) and(l3<90) then begin
       l4:=l4+2;
       dec(tyoff,2);
    end;}

    putfloor(l3,vaddr);
    rotatepoints2(180,0,l1);
    showpolys(0,vaddr2);
    if l3<50 then
      trotatepoints2(180,0,l1);
  {  if (l3>50) then
       trotatepoints2(180,l4,240);}


    tshowtext(vaddr);
    for l2:=1 to 63999 do begin
       c1:=mem[vaddr2:l2];
       if c1>0 then begin
          c2:=mem[vaddr:l2];
         if c2<128 then begin
           co:=c1 shl 4+c2;
         end

         else
           co:=c2+2;
         mem[vaddr:l2]:=co;
       end;
     end;
    flip(vaddr,sega000);
    cls(vaddr2,0);
    motionclear(virscr^,15)

  until l3>70;
  shutfloor;
  tshutmap;
  tshut;


  tsetup('room.euv');
  setup('sphere.euv');



 {half palete for the room and half for the mirror}
  tset1map('remap3.pcx',2,vaddr);

     for l1:=1 to 128 do
       getpal(l1*2,palar[l1,1],palar[l1,2],palar[l1,3]);

{  setuprefpal;}
   lpcx('remap3.pcx',vaddr3);
   for l2:=1 to 63999 do {reduce colors    }
      mem[vaddr3:l2]:=(mem[vaddr3:l2] div 2)+128;

     for l1:=1 to 128 do
       getpal(l1*2,palar[l1+128,1],palar[l1+128,2],palar[l1+128,3]);
   for l1:=1 to 255 do pal(l1,palar[l1,1],palar[l1,2],palar[l1,3]);


  l1:=0;
  tzoff:=-50;
  zoff:=-550;
  td:=0.5;
  d:=2;
  cls(vaddr2,0);
  ambient:=20;
  con:=64;
  RANDOMIZE;
  ode:=l1;
  ad1:=0;
  ad2:=20;
  ad3:=30;
  tzoff:=-150;
  zoff:=-1500;
  l1:=100;


    repeat
    if tzoff<-50 then inc(tzoff,3);
    l1:=(l1+3) mod (360);

    trotatepoints2(l1,0,l1);
    tshowtext(vaddr);
    if tzoff=-114 then begin

     {got inside}
     tshutmap;
     tset1map('remap2.pcx',2,vaddr2);
   end;



    if tzoff>=-117 then begin
      rotatepoints2(l1,l1,0);
      showpolys(100,vaddr2);
      if tzoff<-50 then inc(zoff,38);
    end;

    phongit(vaddr2,vaddr3);
   { flip(vaddr
    ,sega000);}

{NOISE4(VADDR2);}
{    asmfade(virscr);}

{    flip(vaddr2,SEGA000);}
{     for l2:=1 to 63999 do begin
       if mem[vaddr2:l2]>0 then mem[sega000:l2]:=mem[vaddr2:l2]
       else mem[sega000:l2]:=mem[vaddr:l2]+random(5)-2;
     end;}

    trndflip16 (vaddr2,vaddr,seg(rndmatrix^),random($ff));
    flip32(vaddr2,sega000);
     if t1>6 then begin
           resett1;
           wpallete;
           waitretrace;
           waitretrace;
           rpallete;
     end;



{     if zoff>=-300 then ok:=true;
     if (zoff>-700) and (ok) then begin
       zoff:=zoff-5;
       if tzoff>-50 then  tzoff:=tzoff+ 1;
     end;}



        cls32(vaddr2,0);
  until ticks>1650;

  tshutmap;
  tshut;
  shut;


  setup('r3.euv');
  lpcx('remap2.pcx',vaddr2);


{  setuppal;}
  l1:=0;
  zoff:=-100;
  xoff:=160;
  yoff:=70;

  d:=1;
  RANDOMIZE;
  ad1:=0;
  ad2:=20;
  ad3:=30;
  fr:=1;
  up:=true;
  l1:=130;
  repeat

    if up then l1:=(l1+1) mod (360)
    else l1:=(l1-1) mod (360);
    if l1 mod 4=0 then begin
      if up then begin
         inc(fr);
         inc(zoff,5);
      end
      else begin
        dec(fr);
        dec(zoff,5);
      end;
      if fr<=1 then up:=true;
      if fr>=9 then up:=false;
    end;
    str(fr,st);

    lnm('r'+st+'.euv');
    {allazoun mesa sthn lnm alla ama allaxei einia allo thema..}
     zoff:=-80;
     xoff:=160;
     yoff:=70;

    rotatepoints2(l1,0,l1);
    cls(vaddr,0);
    showpolys(0,vaddr);
{`    phongit(vaddr,vaddr2);

fedges(30,vaddr,sega000);
waitretrace;
cls32(sega000,0);
waitretrace;               }
    smallscr(vaddr);



 {   flip(vaddr
    ,SEGA000);}

  until keypressed;
  shut;


  freemem (RndMatrix,4100);
  StopMusic;
  settext;
  shutdown;
end.

