program testtmap;
uses crt,gfx3,tmap2,m3d52,catalib,cfloor2,tcamlib2,polygons,burn,
sea6;


const Xstep=20;

Var
w,Image : Word;
m1,m2   : longint;

var l1,ode,l3,l4,fr:integer;
    l2:word;
    c1,c2,c3:byte;
    co:integer;
    Cx,Cy:Array[0..320] of Word;
    Tractor,Factor:Word;
    o:Word;
    step:integer;
    sp:array[1..255,1..3] of byte;
    st:string;
    up:boolean;
    ok:boolean;
    rndmatrix:pointer;
    virscr3 : VirtPtr;                     { Our first Virtual screen }
    vaddr3  : word;                        { The segment of our virtual screen}
    ch:char;
    CurTime:LongInt;


function malloc (s : word):Word;
var
ptemp:pointer;

Begin
Getmem (Ptemp,s);
malloc:=Seg(Ptemp^);
End;


Procedure DoTunnel;
var
  Helpp,Help:Word;
  TempP:Pointer;
  SegT,OfsT:Word;
  LightX,LightY:Integer;
  LightX2,LightY2:Integer;
  LightX3,LightY3:Integer;
  CounterL:Word;
  MyP:pointer;
  segp,OfsP:word;
  ch:char;
  centerx,centery:integer;
  counter,counter2:real;
  SinAr:array[0..1449] of integer;
  o:word;
  r:array[0..1449] of Real;
  SA,CA:array[0..256] of integer;
  speed:byte;
  speed2:integer;
  cnt,YStep:byte;
  N:Integer;
  u1,u2,v1,v2,oldx,oldy:integer;
  nj,x3,y3,x4,y4,x1,y1,x2,y2,tempx,tempy,tempx2,tempy2:integer;
  i,j:word;
  c:byte;
  x,y:integer;
  starting:integer;



procedure ShowPolys;
Var Tv1,Tv2,Tu1,Tu2:Byte;
begin
  V1:=Byte(V1);
  V2:=Byte(V2);
  U1:=Byte(U1);
  U2:=Byte(U2);
  If Abs(V1-V2)>50 Then Begin V1:=256-v1; End;
  If Abs(u1-u2)>200 Then Begin u1:=0; End;
  PhongClipPolygon(x1,y1,x2,y2,x3,y3,
  v1,u1,v1,u2,v2,u1,
  Vaddr,myp);
  PhongClipPolygon(x3,y3,x2,y2,x4,y4,
  v2,u1,v1,u2,v2,u2
  ,Vaddr,myp);
  inc(i,xstep);
end;




procedure flip32a(source,dest,size:Word); assembler;
  { This copies the entire screen at "source" to destination }
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, Size
  Shr     Cx,2
  db      $F3, $66, $A5
  pop     ds
end;



procedure DoClipping;
begin
  if x1>319 then x1:=319;
  if x1<0 then x1:=0;
  if y1<0 then y1:=0;
  if y1>199 then y1:=199;
  if x2<0 then x2:=0;
  if x2>319 then x2:=319;
  if y2<0 then y2:=0;
  if y2>199 then y2:=199;
  if x3<0 then x3:=0;
  if x3>319 then x3:=319;
  if y3<0 then y3:=0;
  if y3>199 then y3:=199;
  if x4<0 then x4:=0;
  if x4>319 then x4:=319;
  if y4<0 then y4:=0;
  if y4>199 then y4:=199;
end;


Function m(col:byte; num:integer):byte;
begin
 if col+num<0 then begin m:=0; exit; end;
 if col+num>63 then begin m:=63; exit; end;
 m:=col+num;
end;

Procedure GetMap;
var counter2,counter:real;
    r,g,b:byte;
    i,j:Word;
begin
  GetMem(myp,65535);
  GetMem(TempP,65535);
  segp:=seg(myp^);
  LPCX('amumap3.pcx',Vaddr);
 counter2:=0;
 for i:=0 to 128 do
  begin
   counter:=0;
  for j:=0 to 128 do
   begin
    counter:=counter+0.78123;
    c:=getpixel(round(counter2),round(counter),vaddr);
    mem[segp:(j shl 8+i+1) mod 65534]:=c;
   end;
  counter2:=counter2+0.8;
  end;

 counter2:=0;
 for i:=0 to 128 do
  begin
  counter:=101;
  for j:=128 to 255 do
   begin
    counter:=counter-0.7873;
    c:=getpixel(round(counter2),round(counter),vaddr);
    mem[segp:(j shl 8+i+1) mod 65534]:=c;
   end;
  counter2:=counter2+0.8;
  end;

 counter2:=100;
 for i:=128 to 255 do
  begin
  counter:=101;
  for j:=128 to 255 do
   begin
    counter:=counter-0.783;
    c:=getpixel(round(counter2),round(counter),vaddr);
    mem[segp:Word(j shl 8+i+1) mod 65534]:=c;
   end;
  counter2:=counter2-0.79;
  end;


 counter2:=100;
 for i:=128 to 255 do
  begin
  counter:=0;
  for j:=0 to 128 do
   begin
    counter:=counter+0.7813;
    c:=getpixel(round(counter2),round(counter),vaddr);
    mem[segp:(j shl 8+i+1) mod 65534]:=c;
   end;
  counter2:=counter2-0.77;
  end;
  flip32a(Seg(MyP^),Seg(TempP^),65534);
end;


Procedure PutpixelAtMap(X,Y,Col:byte);
Begin
 Mem[Segp:X+y shl 8]:=Col;
End;



Function GetPixelFromMap(X,Y:byte):Byte;
Begin
 GetPixelFromMap:=Mem[Segp:X+y shl 8];
End;

Procedure PutLight(X,Y,XX,YY,xxx,yyy:Integer);
var x1,y1:integer;
    Dist:Word;
    c1,c2,c3:byte;
Begin
 Flip32a(Seg(TempP^),Seg(MyP^),65534);
 For x1:=-20 to 20 do
  For y1:=-20 to 20 do
   Begin
    Dist:=Round(sqrt(Abs(Sqr(X1)+Sqr(Y1))));
    If Dist<22 Then
     Begin
      C1:=GetPixelFromMap(byte(X1+x),byte(Y1+y));
      If C1+(90-dist*4)<250 Then C1:=C1+(90-Dist*4) Else C1:=250;
      C2:=GetPixelFromMap(byte(X1+xx),byte(Y1+yy));
      If C2+(90-dist*4)<250 Then C2:=C2+(90-Dist*4) Else C2:=250;
      C3:=GetPixelFromMap(byte(X1+xxx),byte(Y1+yyy));
      If C3+(90-dist*4)<250 Then C3:=c3+(90-Dist*4) Else C3:=250;

      PutpixelAtMap(byte(X1+x),byte(Y1+y),c1);
      PutpixelAtMap(byte(X1+xx),byte(Y1+yy),c2);
      PutpixelAtMap(byte(X1+xxx),byte(Y1+yyy),c3);
     End;
   End;
End;






begin
  If Keypressed Then Readkey;
  CenterX:=160;
  CenterY:=100;
  GetMap;
  cls(sega000,0);
  for i:=0 to 255 do begin
    CA[i]:=round(cos(pi*i/128)*50);
    SA[i]:=round(sin(pi*i/128)*30);
  End;
  x:=30; y:=90;
  cnt:=0;
  cls(vaddr,0);
  c:=0;
  nj:=2;
  starting:=0;
  for i:=1 to 1449 do r[i]:=sin(2*pi*i/360);
  Pal(0,0,0,0);
  repeat
    Cls32(vaddr,0);
    c:=c+1;
    YStep:=20;
    j:=20;
    u1:=0;
    u2:=0;
    if starting <360 then starting:=starting+2;
    v1:=0;
    if starting<340 then
     for i:=0 to 1449 do SinAr[i]:=round(r[i]{sin(2*pi*i/360)}*starting/4);
    v2:=0;
    counter:=0;
     Help:=0;
    while j<350 do
     begin
      i:=0;
      c:=0;
      counter:=counter+(YStep*2/255)*255;
      u1:=(round(counter)-c*2);
      u2:=(round(counter+(YStep*2/255)*255)-c*2);
      counter2:=0;
      while i<360 do
      begin
      
        counter2:=counter2+14.222222222;
        v1:=(round(counter2)+c*0);
        v2:=(round(counter2+14.222222222)+c*0);
        inc(cnt);
        tempx:=CA[(x+(200-j)) mod 255];
        tempy:=SA[(y+(200-j)) mod 255];
        x1:=CenterX+tempx+(j*SinAr[90+i]) div (128-20);
        y1:=CenterY+tempy+((j*SinAr[i]) div 128);
        x3:=CenterX+tempx+(j*SinAr[90+(i)+xstep]) div (128-20);
        y3:=CenterY+tempy+(j*SinAr[(i)+xstep]) div 128;
        tempx:=(CA[(x+(200-(j+YStep))) mod 255]);
        tempy:=(SA[(y+(200-(j+YStep))) mod 255]);
        x2:=CenterX+tempx+((j+YStep)*SinAr[90+(i)]) div (128-20);
        y2:=CenterY+tempy+((j+YStep)*SinAr[i]) div 128;
        x4:=CenterX+tempx+((j+YStep)*SinAr[90+((i)+xstep)]) div (128-20);
        y4:=CenterY+tempy+((j+YStep)*SinAr[(i)+xstep]) div 128;
        DoClipping;
        ShowPolys;
       end;
      inc(j,YStep);
      if (j mod 3)=0 then inc(YStep);
      nj:=YStep;
      if ((j+YStep) mod 3)=0 then nj:=nj+1;
     end;
    x:=4+x;
    y:=3+y;
    hline(0,320,0,0,vaddr);
    hline(0,320,199,0,vaddr);
    line(0,0,0,200,0,vaddr);
    inc(C);
    LightX:=round(cos(CounterL/13)*56+157);
    LightY:=round(sin(CounterL/23)*66+100);
    LightX2:=round(cos((CounterL+100)/13)*56+137);
    LightY2:=round(sin((CounterL+100)/23)*76+10);
    LightX3:=round(cos((CounterL+200)/13)*76+117);
    LightY3:=round(sin((CounterL+200)/23)*46+10);
    Inc(CounterL,1);
    PutLight(LightX,LightY,LightX2,LightY2,LightX3,LightY3);
    waitretrace;
    Flip32(vaddr,sega000);

  until (Ticks>2450) or (Keypressed){ppp};
  FreeMem(Myp,sizeof(myp));
  Burn.Init(1);
  w:=0;
  repeat
   waitretrace;
   burn.burnit (vaddr,sega000);
   waitretrace;
   inc (w);
  Until w>160;
 Burn.DeInit;
end;





Procedure Smooth(Where:Word);assembler;
Var M:Word;
Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Xor bh,bh
 Xor Ch,Ch
 Xor Dh,Dh
 @MainLoop:
  Inc Di
  Dec Di
  Mov Al,Es:[Di]
  Add Di,2
  Mov Bl,Es:[Di]
  Add Di,320
  Mov Cl,Es:[Di]
  Sub Di,2
  Mov Dl,Es:[Di]
  Sub Di,319
  Mov M,Ax
  Add M,Bx
  Add M,Cx
  Add M,Dx
  Shr M,2
  Mov Ax,M
  Mov Es:[Di],Al
  Xor Ah,Ah

  Cmp Di,63678
 Jne @MainLoop
End;



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,64300);
  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 optdobump; {Now u guess what this one does..hehehe}
var difx,   {The X axis difference}
    dify,   {The Y axis difference}
    col:byte; {Used in many points..}
    l1:integer; {General use}
    o:word;
    Loop:word;
    r,g,b:byte;
    deg,nx,ny,vlx,vly,lx,ly:integer;
begin
  Loop:=0;
  Time:=0;
  lx:=-160; {The starting position of the light source}
  ly:=100; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  l1:=0;
  deg:=0;
  repeat
    Inc(Loop);
    inc(l1);
    lx:=round(cos(l1/13)*90+160);
    ly:=round(sin(l1/23)*40+100);
    x:=0;
    y:=0;
      For o:=640 to 63678 do
       Begin
        Inc(x);
        If X=320 Then
         Begin
          Inc(Y);
          X:=0;
         End;
{        vlx:=X-lx; {Calculate the L vector}
{        vly:=Y-ly; {>>>>>>>>>>>>>>>>>>>>>>}
         Vlx:=(sqr(x-lx) shr 4) shr 3;
         Vly:=(sqr(y-ly) shr 4) shr 3;

        if (vlx<130) and (vlx>-130) and (vly>-130) and (vly<130 ) then begin
          Asm
           Mov Es,Vaddr
           Mov Di,o
           Inc Di
           Mov Al,Es:[Di]
           xor ah,ah
           Sub Di,2
           Mov Bl,Es:[Di]
           xor Bh,Bh
           Mov Nx,Ax
           Sub Nx,Bx
           Add Di,321
           Mov Al,Es:[Di]
           Sub Di,640  (******)
           Mov Bl,Es:[Di]
           Mov Ny,Ax
           Sub Ny,Bx

           Mov Ax,Vlx
           Cmp Ax,Nx
           Jl  @jumpit
           sub Ax,Nx
           Mov Col,Al
           Jmp @nextt
           @jumpit:
           Mov Bx,Nx
           Sub Bl,Al
           Mov Col,Bl
           @nextt:
          End;
{          nx:=mem[vaddr:o+1]-mem[vaddr:o-1];
          ny:=mem[vaddr:o+320]-mem[vaddr:o-320];
          col:=abs(vlx-nx);}
          if col>127 then col:=127;
          difx:=127-col;
          if difx<0 then difx:=1;
          col:=byte(abs(vly-ny));
         if col>127 then col:=127;
         dify:=127-col;
        if dify<0 then dify:=1;
        col:=(difx+dify);
        If Col>185 Then
         Begin

          Col:=Col-185;
{          col:=col+85;}
{         col:=col+185;}

{          If Mem[Vaddr3:o]>128 Then Col:=Col+85;
          If Mem[Vaddr3:o]=1 Then Col:=Col+170;}
          mem[vaddr2:o]:=col;
         End;
      end;
    End;
   HLine(0,319,199,0,vaddr2);
   HLine(0,319,0,0,vaddr2);
   Line(0,0,0,199,0,Vaddr2);
   Line(319,0,319,199,0,Vaddr2);
   cls(vaddr3,0);
{      for l1:=1 to 10 do}
{      hline(0,319,100,0,vaddr2);}



  dp(80,100, 320-80,100, 319,199,1,199,
          106,100, 212,100, 212,199, 100,199,vaddr2,vaddr3);
{  dp(80,1, 320-80,10, 320-80,100,80,100,
           106,1, 212,1, 212,199, 106,199,vaddr2,vaddr3);

  dp(1,1, 80,20, 80,100, 1,199,
           1,1, 106,1, 106,199, 1,199,vaddr2,vaddr3);
  dp(240,20, 319,1, 319,199, 240,100
  ,212,1, 319,1, 319,199, 212,199,vaddr2,vaddr3);

  dp(80,100, 320-80,100, 319,199,1,199,
          1,1, 320,1, 320,200, 1,200,vaddr2,vaddr3);}
  dp(80,1, 320-80,10, 320-80,100,80,100,
            106,1, 212,1, 212,100, 106,100,vaddr2,vaddr3);




  dp(1,1, 80,1, 80,100, 1,199,
           1,1, 106,1, 106,199, 1,199,vaddr2,vaddr3);

  dp(240,1, 319,1, 319,199, 240,100
  ,212,1, 319,1, 319,199, 212,199,vaddr2,vaddr3);


  deg:=(deg+5) mod 360;
  rotatepoints2(140,0,0);
  showshadow((160-lx),-40-(ly shr 4),vaddr3);
  showpolys(89,vaddr3);

  flip(vaddr3,sega000);

  xoff:=160;
  yoff:=180;
  zoff:=-200;
  m3d52.lx:=(160-lx)*10;
{ m3d52.lx:=-5000;}
{  m3d6.ly:=(160-ly)*10;}
  m3d52.ly:=(100-ly)*20;
  ambient:=0;
{  ambient:=50-round(sqrt(sqr(xoff-lx)+sqr(yoff-ly)));}

{  zoff:=(ly*20-3400);}



{   flip32(vaddr2,sega000);}
   cls32(vaddr2,0);
  until Keypressed;
end;










procedure fpal;
begin
Pal(1,16,14,13);
Pal(2,17,15,14);
Pal(3,18,15,15);
Pal(4,19,17,16);
Pal(5,20,18,17);
Pal(6,21,18,18);
Pal(7,22,19,19);
Pal(8,23,20,20);
Pal(9,24,21,21);
Pal(10,25,22,22);
Pal(11,26,23,23);
Pal(12,27,24,24);
Pal(13,28,25,25);
Pal(14,28,26,26);
Pal(15,29,27,27);
Pal(16,30,28,28);
Pal(17,31,29,29);
Pal(18,32,29,30);
Pal(19,33,30,31);
Pal(20,34,31,32);
Pal(21,35,32,32);
Pal(22,36,33,33);
Pal(23,37,34,34);
Pal(24,38,35,35);
Pal(25,40,37,36);
Pal(26,42,40,37);
Pal(27,43,41,38);
Pal(28,44,41,39);
Pal(29,45,42,40);
Pal(30,45,42,40);
Pal(31,46,43,41);
Pal(32,47,44,42);
Pal(33,48,45,43);
Pal(34,48,46,43);
Pal(35,49,46,44);
Pal(36,49,47,46);
Pal(37,53,48,47);
Pal(38,56,50,48);
Pal(39,57,51,49);
Pal(40,56,51,49);
Pal(41,55,51,50);
Pal(42,55,52,51);
Pal(43,55,52,52);
Pal(44,56,53,52);
Pal(45,58,54,53);
Pal(46,58,55,54);
Pal(47,58,56,55);
Pal(48,59,56,56);
Pal(49,60,57,57);
Pal(50,61,58,57);
Pal(51,61,58,59);
Pal(52,63,59,60);
Pal(53,63,60,61);
Pal(54,63,61,61);
Pal(55,63,62,62);
Pal(56,63,63,63);
Pal(57,63,63,63);
Pal(58,63,63,63);
Pal(59,63,63,63);
Pal(60,63,63,63);
Pal(61,63,63,63);
Pal(62,63,63,63);
Pal(63,63,63,63);
Pal(64,63,63,63);
Pal(65,63,63,63);
Pal(66,63,63,63);
Pal(67,63,63,63);
Pal(68,63,63,63);
Pal(69,63,63,63);
Pal(70,63,63,63);
Pal(71,63,63,63);
Pal(72,63,63,63);
Pal(73,63,63,63);
Pal(74,63,63,63);
Pal(75,63,63,63);
Pal(76,63,63,63);
Pal(77,63,63,63);
Pal(78,63,63,63);
Pal(79,63,63,63);
Pal(80,63,63,63);
Pal(81,63,63,63);
Pal(82,63,63,63);
Pal(83,63,63,63);
Pal(84,63,63,63);
Pal(85,63,63,63);
Pal(86,8,4,0);
Pal(87,8,4,0);
Pal(88,8,4,0);
Pal(89,8,4,0);
Pal(90,8,4,0);
Pal(91,6,4,2);
Pal(92,6,4,2);
Pal(93,6,4,4);
Pal(94,6,4,4);
Pal(95,6,6,6);
Pal(96,6,6,6);
Pal(97,6,6,8);
Pal(98,6,6,8);
Pal(99,6,6,10);
Pal(100,6,6,10);
Pal(101,6,6,12);
Pal(102,6,6,12);
Pal(103,6,6,14);
Pal(104,6,6,14);
Pal(105,6,8,16);
Pal(106,6,8,16);
Pal(107,6,8,16);
Pal(108,6,8,18);
Pal(109,6,8,18);
Pal(110,6,8,18);
Pal(111,6,8,20);
Pal(112,6,8,20);
Pal(113,6,8,22);
Pal(114,6,8,22);
Pal(115,6,8,22);
Pal(116,6,8,24);
Pal(117,6,8,24);
Pal(118,6,10,26);
Pal(119,6,10,26);
Pal(120,6,10,26);
Pal(121,8,10,28);
Pal(122,10,12,30);
Pal(123,10,14,32);
Pal(124,12,16,32);
Pal(125,12,16,34);
Pal(126,14,18,34);
Pal(127,16,18,37);
Pal(128,16,20,37);
Pal(129,16,20,39);
Pal(130,18,22,41);
Pal(131,22,26,41);
Pal(132,24,26,43);
Pal(133,24,28,43);
Pal(134,26,28,43);
Pal(135,26,30,45);
Pal(136,28,30,45);
Pal(137,28,32,47);
Pal(138,30,32,47);
Pal(139,30,34,47);
Pal(140,32,34,49);
Pal(141,32,37,49);
Pal(142,34,37,51);
Pal(143,34,39,51);
Pal(144,37,39,51);
Pal(145,37,41,53);
Pal(146,39,41,53);
Pal(147,39,43,53);
Pal(148,41,43,53);
Pal(149,43,45,55);
Pal(150,43,45,55);
Pal(151,45,47,55);
Pal(152,45,47,57);
Pal(153,47,49,57);
Pal(154,47,49,57);
Pal(155,49,51,57);
Pal(156,51,51,59);
Pal(157,51,53,59);
Pal(158,53,53,59);
Pal(159,53,55,59);
Pal(160,55,55,61);
Pal(161,55,57,61);
Pal(162,57,57,61);
Pal(163,57,59,61);
Pal(164,59,59,61);
Pal(165,59,59,61);
Pal(166,61,61,63);
Pal(167,61,61,63);
Pal(168,63,63,63);
Pal(169,63,63,63);
Pal(170,12,6,10);
Pal(171,14,6,10);
Pal(172,14,6,10);
Pal(173,14,6,12);
Pal(174,14,8,12);
Pal(175,16,8,12);
Pal(176,16,8,12);
Pal(177,16,8,12);
Pal(178,16,8,12);
Pal(179,16,8,12);
Pal(180,18,8,14);
Pal(181,18,8,14);
Pal(182,18,8,14);
Pal(183,18,8,14);
Pal(184,18,8,14);
Pal(185,18,8,14);
Pal(186,18,8,14);
Pal(187,18,8,14);
Pal(188,18,10,14);
Pal(189,18,10,14);
Pal(190,18,10,14);
Pal(191,18,10,14);
Pal(192,18,10,14);
Pal(193,18,10,14);
Pal(194,20,10,14);
Pal(195,20,10,14);
Pal(196,20,10,14);
Pal(197,20,10,14);
Pal(198,20,10,14);
Pal(199,20,10,14);
Pal(200,22,10,16);
Pal(201,22,10,16);
Pal(202,22,10,16);
Pal(203,22,10,16);
Pal(204,22,10,16);
Pal(205,22,10,16);
Pal(206,24,10,16);
Pal(207,24,10,16);
Pal(208,24,10,16);
Pal(209,24,10,18);
Pal(210,24,10,18);
Pal(211,24,10,18);
Pal(212,26,10,18);
Pal(213,26,10,18);
Pal(214,26,10,18);
Pal(215,26,10,18);
Pal(216,26,10,20);
Pal(217,26,10,20);
Pal(218,28,10,20);
Pal(219,28,12,20);
Pal(220,28,12,20);
Pal(221,28,12,20);
Pal(222,28,12,22);
Pal(223,28,12,22);
Pal(224,30,12,22);
Pal(225,30,12,22);
Pal(226,30,14,22);
Pal(227,30,14,22);
Pal(228,30,14,24);
Pal(229,33,14,24);
Pal(230,33,14,24);
Pal(231,33,14,24);
Pal(232,33,16,24);
Pal(233,33,16,26);
Pal(234,33,16,26);
Pal(235,35,16,26);
Pal(236,35,16,26);
Pal(237,35,18,26);
Pal(238,35,18,26);
Pal(239,35,18,28);
Pal(240,37,18,28);
Pal(241,37,20,28);
Pal(242,37,20,30);
Pal(243,39,24,33);
Pal(244,41,26,35);
Pal(245,43,28,37);
Pal(246,45,30,37);
Pal(247,47,33,41);
Pal(248,49,37,43);
Pal(249,51,37,45);
Pal(250,53,41,47);
Pal(251,63,53,57);
Pal(252,63,53,57);
Pal(253,63,53,57);
Pal(254,63,53,57);
Pal(255,8,4,0);
end;


procedure bumppal;
begin
Pal(1,2,0,0);
Pal(2,2,0,0);
Pal(3,2,0,0);
Pal(4,2,0,0);
Pal(5,2,0,0);
Pal(6,2,0,0);
Pal(7,2,0,0);
Pal(8,2,0,0);
Pal(9,2,0,0);
Pal(10,2,0,0);
Pal(11,3,1,1);
Pal(12,5,3,2);
Pal(13,6,4,3);
Pal(14,6,4,3);
Pal(15,6,4,3);
Pal(16,6,4,3);
Pal(17,6,4,3);
Pal(18,6,4,3);
Pal(19,6,3,3);
Pal(20,5,3,3);
Pal(21,5,3,2);
Pal(22,5,3,2);
Pal(23,5,3,2);
Pal(24,5,3,2);
Pal(25,7,3,2);
Pal(26,6,5,2);
Pal(27,4,4,3);
Pal(28,5,3,4);
Pal(29,4,2,2);
Pal(30,4,2,2);
Pal(31,4,2,2);
Pal(32,4,2,2);
Pal(33,4,2,2);
Pal(34,4,2,2);
Pal(35,4,2,2);
Pal(36,4,2,1);
Pal(37,4,2,2);
Pal(38,6,4,3);
Pal(39,8,6,5);
Pal(40,10,8,7);
Pal(41,12,10,9);
Pal(42,14,12,11);
Pal(43,16,14,13);
Pal(44,18,15,15);
Pal(45,20,18,17);
Pal(46,22,19,19);
Pal(47,24,21,21);
Pal(48,26,23,23);
Pal(49,28,25,25);
Pal(50,29,27,27);
Pal(51,31,29,29);
Pal(52,33,30,31);
Pal(53,35,32,32);
Pal(54,37,34,34);
Pal(55,40,37,36);
Pal(56,43,41,38);
Pal(57,45,42,40);
Pal(58,46,43,41);
Pal(59,48,45,43);
Pal(60,49,46,44);
Pal(61,53,48,47);
Pal(62,57,51,49);
Pal(63,55,51,50);
Pal(64,55,52,52);
Pal(65,58,54,53);
Pal(66,58,56,55);
Pal(67,60,57,57);
Pal(68,61,58,59);
Pal(69,63,60,61);
Pal(70,63,62,62);
Pal(71,63,63,63);
Pal(72,63,63,63);
Pal(73,63,63,63);
Pal(74,63,63,63);
Pal(75,63,63,63);
Pal(76,63,63,63);
Pal(77,63,63,63);
Pal(78,63,63,63);
Pal(79,63,63,63);
Pal(80,63,63,63);
Pal(81,63,63,63);
Pal(82,63,63,63);
Pal(83,63,63,63);
Pal(84,63,63,63);
Pal(85,63,63,63);
Pal(86,6,4,0);
Pal(87,6,4,0);
Pal(88,6,4,0);
Pal(89,6,4,0);
Pal(90,6,4,0);
Pal(91,6,4,0);
Pal(92,6,4,0);
Pal(93,6,4,0);
Pal(94,6,4,0);
Pal(95,4,2,0);
Pal(96,2,0,0);
Pal(97,2,0,0);
Pal(98,2,0,0);
Pal(99,2,0,0);
Pal(100,2,0,0);
Pal(101,2,0,0);
Pal(102,2,0,0);
Pal(103,2,0,0);
Pal(104,2,0,0);
Pal(105,2,0,0);
Pal(106,4,2,0);
Pal(107,6,4,0);
Pal(108,6,4,0);
Pal(109,6,4,0);
Pal(110,6,4,0);
Pal(111,6,4,0);
Pal(112,6,4,0);
Pal(113,6,4,0);
Pal(114,6,4,0);
Pal(115,6,4,0);
Pal(116,6,4,0);
Pal(117,6,4,0);
Pal(118,6,4,0);
Pal(119,6,4,0);
Pal(120,6,4,0);
Pal(121,6,4,0);
Pal(122,6,4,0);
Pal(123,6,4,0);
Pal(124,6,4,0);
Pal(125,6,4,0);
Pal(126,6,4,0);
Pal(127,6,4,0);
Pal(128,8,4,0);
Pal(129,8,4,0);
Pal(130,8,4,0);
Pal(131,8,4,0);
Pal(132,8,4,0);
Pal(133,8,4,0);
Pal(134,8,4,0);
Pal(135,8,4,0);
Pal(136,6,4,2);
Pal(137,6,4,4);
Pal(138,6,6,6);
Pal(139,6,6,10);
Pal(140,6,6,12);
Pal(141,6,6,14);
Pal(142,6,8,16);
Pal(143,6,8,18);
Pal(144,6,8,18);
Pal(145,6,8,20);
Pal(146,6,8,22);
Pal(147,6,8,24);
Pal(148,6,10,26);
Pal(149,10,12,30);
Pal(150,12,16,32);
Pal(151,14,18,34);
Pal(152,16,20,39);
Pal(153,22,26,41);
Pal(154,24,28,43);
Pal(155,28,30,45);
Pal(156,30,32,47);
Pal(157,32,34,49);
Pal(158,34,37,51);
Pal(159,37,41,53);
Pal(160,39,43,53);
Pal(161,43,45,55);
Pal(162,45,47,57);
Pal(163,47,49,57);
Pal(164,51,51,59);
Pal(165,53,53,59);
Pal(166,55,57,61);
Pal(167,57,59,61);
Pal(168,59,59,61);
Pal(169,63,63,63);
Pal(170,0,0,0);
Pal(171,0,0,0);
Pal(172,0,0,0);
Pal(173,0,0,0);
Pal(174,0,0,0);
Pal(175,0,0,0);
Pal(176,0,0,0);
Pal(177,0,0,0);
Pal(178,0,0,0);
Pal(179,0,0,0);
Pal(180,0,0,0);
Pal(181,0,0,0);
Pal(182,0,0,0);
Pal(183,0,0,0);
Pal(184,0,0,0);
Pal(185,0,0,0);
Pal(186,0,0,0);
Pal(187,0,0,0);
Pal(188,0,0,0);
Pal(189,0,0,0);
Pal(190,0,0,0);
Pal(191,0,0,0);
Pal(192,0,0,0);
Pal(193,0,0,0);
Pal(194,0,0,0);
Pal(195,0,0,0);
Pal(196,0,0,0);
Pal(197,0,0,0);
Pal(198,0,0,0);
Pal(199,0,0,0);
Pal(200,0,0,0);
Pal(201,0,0,0);
Pal(202,0,0,0);
Pal(203,0,0,0);
Pal(204,0,0,0);
Pal(205,0,0,0);
Pal(206,0,0,0);
Pal(207,0,0,0);
Pal(208,0,0,0);
Pal(209,0,0,0);
Pal(210,0,0,0);
Pal(211,0,0,0);
Pal(212,0,0,0);
Pal(213,0,0,0);
Pal(214,0,0,0);
Pal(215,0,0,0);
Pal(216,0,0,0);
Pal(217,0,0,0);
Pal(218,0,0,0);
Pal(219,0,0,0);
Pal(220,0,0,0);
Pal(221,0,0,0);
Pal(222,0,0,0);
Pal(223,0,0,0);
Pal(224,0,0,0);
Pal(225,0,0,0);
Pal(226,0,0,0);
Pal(227,0,0,0);
Pal(228,0,0,0);
Pal(229,0,0,0);
Pal(230,0,0,0);
Pal(231,0,0,0);
Pal(232,0,0,0);
Pal(233,0,0,0);
Pal(234,0,0,0);
Pal(235,0,0,0);
Pal(236,0,0,0);
Pal(237,0,0,0);
Pal(238,0,0,0);
Pal(239,0,0,0);
Pal(240,0,0,0);
Pal(241,0,0,0);
Pal(242,12,4,8);
Pal(243,16,8,12);
Pal(244,18,8,14);
Pal(245,18,10,14);
Pal(246,20,10,14);
Pal(247,22,10,16);
Pal(248,24,10,16);
Pal(249,26,10,18);
Pal(250,28,12,22);
Pal(251,30,14,24);
Pal(252,35,16,26);
Pal(253,37,20,30);
Pal(254,49,37,43);
Pal(255,6,4,0);
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 Noise4a(Where:Word;Fact:Byte);
Var o:word;
    Seq:integer;
    Fx:integer;
    c:byte;
    c1,curp:byte;
Begin
Fact:=Fact shr 1;
Fx:=0;
 For o:=0 to 15999 do
  Begin
   Inc(Fx);
   If Fx=319 Then Fx:=0;
   If Fx=0 Then Seq:=Random(5);     {<-----------}

   If (Random(Seq)=1) then
    Begin
     Mem[Where:o]:={Mem[Where:o]+}Fact;
     Mem[Where:o+15999]:={Mem[Where:o+15999]+}Fact;
     Mem[Where:o+31999]:={Mem[Where:o+31999]+}Fact;
     Mem[Where:o+47999]:={Mem[Where:o+47999]+}Fact;
    End;
  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);
  Ambient:=20;
  repeat
    If Ticks>115 Then Tractor:=8;
    If Ticks>710 Then Tractor:=14;
    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);
    cls32(vaddr,0);
    noise4a(Vaddr2,Factor);
    Smooth2(Vaddr);
    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;


Procedure RotatedCamera;
Begin
TXoff:=80;
TYOff:=100;
Tzoff:=-2430;
Path:=0;
Zobs2:=700;
 repeat
   If Left Then
    trotatepoints2(90,0,(360-Whe)+FG)
     Else
      trotatepoints2(90,0,Whe+Fg);
   Dir:=Dir mod 360;
   If Path<43 Then Tzoff:=Tzoff+50 Else TZoff:=TZoff-50;
   If TYoff<120 Then TYOff:=TYoff+1;
   If (Path>32) And (Path<51)  Then
    Begin
     Dir:=Dir-20;
     Fg:=Fg+10;
    End;
   inc(path);
   MakeVoxel(x,y,dir);
   TShowText(Vaddr);
   If (Path Mod 10 in[1..4]) Then PutRec;
   PutAlways;
   WaitRetrace;
   Flip32(Vaddr,Sega000);
 until Keypressed;
End;


Procedure RocketCamera;
Var Tc:Word;
Begin
TXoff:=160;
Tzoff:=-400;
TYOff:=120;
X:=100;
Y:=50;
Tc:=0;
 repeat
    Inc(Tc);
    TXoff:=Round(Cos(TC/10)*70)+160;                {Move Armonically}
    TYoff:=Round(Sin(TC/5)*10)+120;                 {............... }
    Whe:=Abs(360+Round(Cos((TC+120)/16)*7)) mod 360;{...........     }
    deg2:=Sin(TC/10)*15;                            {............... }
    deg:=1+Sin(TC/10)*2;                            {............... }
    zobs2:=600+Round(Sin(TC/10)*45);                {............... }
    Tzoff:=-250-Tc*10;{Round(Sin(TC/10)*145);       {............... }
    if keypressed then ch:=readkey;
    If Left Then
     trotatepoints2(278,180,(360-Whe))
      Else
       trotatepoints2(278,180,Whe);
    Dir:=Dir mod 360;

    inc(path);
    MakeVoxel(x,y,dir);
    TShowText(Vaddr);
    If (Path Mod 10 in[1..4]) Then PutRec;
    PutAlways;
    WaitRetrace;
    Flip32(Vaddr,Sega000);
    if ch='3' then begin deg:=deg+0.2;  end;
    if ch='9' then begin deg:=deg-0.2;  end;
    if ch='4' then
     Begin
      If (Left=False) And (Whe>0) Then
       Begin
        Dec(Whe,4);
        Dec(Dir,4);
       End
       Else
        Begin
         Left:=True;
         dec(dir,4);
         If Whe<30 Then Inc(Whe,4);
        End;
     End
      Else
       If (Whe>0) and (Left) Then Dec(Whe,4);

    if ch='6' then
     Begin
      If (Left) And (Whe>0) Then
       Begin
        Dec(Whe,4);
        Inc(Dir,4);
       End
       Else
        Begin
         Left:=False;
         Inc(dir,4);
          If Whe<30 Then Inc(Whe,4);
        End;
       End Else
         If (Whe>0) and (Left=False) Then Dec(Whe,4);

{    if (ch='m') And (Deg2>-2) then deg2:=deg2-0.5;
    if (ch='n') And (Deg2<2) then deg2:=deg2+0.5;}
{    if ch='-' then zobs2:=zobs2-13;
    if ch='+' then zobs2:=zobs2+13;}
{    if ch='8' then}
      begin
        y:=y+round(3*cos(dir/180*pi));
        x:=x+round(3*sin(dir/180*pi));
      end;
    if ch='2' then
      begin
        y:=y-round(6*cos(dir/180*pi));
        x:=x-round(6*sin(dir/180*pi));
      end;
until Ticks>1000;
End;





Procedure RocketCamera2;
Var Tc:Word;
Begin
TXoff:=160;
Tzoff:=-400;
TYOff:=120;
X:=170;
Y:=50;
Tc:=0;
zobs2:=800;
CurTime:=Ticks;
 repeat
    Ticks:=0;
    Inc(Tc);
    TXoff:=Round(Cos(TC/10)*70)+160;                {Move Armonically}
    If CurTime<1310 Then
    TYoff:=Round(Sin(TC/5)*10)+120;               {............... }
    Whe:=Abs(360+Round(Cos((TC+120)/16)*7)) mod 360;{...........     }
    deg2:=Sin(TC/10)*15;                           {............... }
    deg:=1+Sin(TC/10)*2;                           {............... }
    if keypressed then ch:=readkey;
    If Left Then
     trotatepoints2(278,180,(360-Whe))
      Else
       trotatepoints2(278,180,Whe);
    Dir:=Dir mod 360;

    inc(path);
    MakeVoxel(x,y,dir);
    TShowText(Vaddr);
    If (Path Mod 10 in[1..4]) Then PutRec;
    PutAlways;
    WaitRetrace;
    {ooooo}
    If (CurTime>1195) And (CurTime<1205) Then Ch:='4' Else
    If (CurTime>1220) And (CurTime<1230) Then Ch:='6'
     Else ch:=' ';
    Flip32(Vaddr,Sega000);
    if ch='3' then begin deg:=deg+0.2;  end;
    if ch='9' then begin deg:=deg-0.2;  end;
    if ch='4' then
     Begin
      If (Left=False) And (Whe>0) Then
       Begin
        Dec(Whe,4);
        Dec(Dir,2);
       End
       Else
        Begin
         Left:=True;
         dec(dir,2);
         If Whe<30 Then Inc(Whe,4);
        End;
     End
      Else
       If (Whe>0) and (Left) Then Dec(Whe,4);

    if ch='6' then
     Begin
      If (Left) And (Whe>0) Then
       Begin
        Dec(Whe,4);
        Inc(Dir,2);
       End
       Else
        Begin
         Left:=False;
         Inc(dir,2);
          If Whe<30 Then Inc(Whe,4);
        End;
       End Else
         If (Whe>0) and (Left=False) Then Dec(Whe,4);

{    if (ch='m') And (Deg2>-2) then deg2:=deg2-0.5;
    if (ch='n') And (Deg2<2) then deg2:=deg2+0.5;}
    if ch='-' then zobs2:=zobs2-13;
    if ch='+' then zobs2:=zobs2+13;
{    if ch='8' then}
      begin
        y:=y+round(3*cos(dir/180*pi));
        x:=x+round(3*sin(dir/180*pi));
      end;
    if ch='2' then
      begin
        y:=y-round(6*cos(dir/180*pi));
        x:=x-round(6*sin(dir/180*pi));
      end;
   CurTime:=CurTime+Ticks;
     If CurTime>1310 Then
      Begin
       Inc(Zobs2,Ticks*20);
       Inc(TYoff,Ticks*3);
      End;
until (CurTime>1350) or (Keypressed);
Ticks:=CurTime;
End;



Procedure ASmooth(Where:Word);assembler;
Var M:Word;
Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Xor bh,bh
 Xor Ch,Ch
 Xor Dh,Dh
 @MainLoop:
  Inc Di
  Dec Di
  Mov Al,Es:[Di]
  Add Di,2
  Mov Bl,Es:[Di]
  Add Di,320
  Mov Cl,Es:[Di]
  Sub Di,2
  Mov Dl,Es:[Di]
  Sub Di,319
  Mov M,Ax
  Add M,Bx
  Add M,Cx
  Add M,Dx
  Shr M,2
  Mov Ax,M
  Cmp Al,2
  Jl  @donot
  Sub Al,2
  @Donot:
  Mov Es:[Di],Al
  Xor Ah,Ah

  Cmp Di,63678
 Jne @MainLoop
End;


Procedure Scale;
Var X,Y:Integer;
    O,Co:Word;
    Temp:Byte;
Begin
 For Y:=0 to 199 do
  Begin
   o:=Y*320;
   Co:=Cy[y]*320;
   For X:=0 To 319 Do
    Begin
     Temp:=Mem[Vaddr:Co+Cx[X]];
     Mem[Vaddr2:O+x]:=Temp+Mem[Vaddr3:Co+Cx[X]+Temp];
    End;
  End;
End;

Procedure GetPallete(Fil:String;Where:Word);
Var TCol:Byte;
    Pale:Array[1..3,0..255] of Byte;
Begin
 LPcx(Fil,Where);
 For TCol:=0 to 160 do
   GetPal(Getpixel(160-TCol,100,Where),Pale[1,TCol],Pale[2,TCol],Pale[3,TCol]);
 For TCol:=0 to 160 do
  Pal(TCol,Pale[1,160-TCol],Pale[2,160-TCol],Pale[3,160-TCol]);
End;


Procedure DoTGPoly;
type rgb=record
      r,g,b:Byte;
     End;

Var i:Word;
    TProb,Prob:Array[1..200,1..2] of Integer;
    LookSin:Array[1..628] of Integer;
    Counter:Word;
    MaxProbs:Word;


Procedure TGouraudPoly(X1, Y1, X2, Y2, X3, Y3, C1, C2, C3:Integer; PgSeg : Word);

Var
  xTop, yTop : Integer;
  xBot, yBot : Integer;
  xMid, yMid : Integer;
  cTop, cBot, cMid : Integer;
  Count : Integer;
  xVal1, xStep1 : Integer;
  xVal2, xStep2 : Integer;
  cVal1, cStep1 : Integer;
  DColor : Integer;
  crMid : Integer;
  xrMid : Integer;
  hCount, cVal : Integer;

Begin
  Asm
    Mov  ax,Y1
    Mov  bx,X1
    Mov  cx,Y2
    Mov  dx,X2
    Mov  si,C1
    Mov  di,C2

    Mov  xTop,bx
    Mov  yTop,ax
    Mov  xBot,dx
    Mov  yBot,cx
    Mov  cTop,si
    Mov  cBot,di
    Cmp  ax,cx
    Jle @Skip2Top
      Mov  xTop,dx
      Mov  yTop,cx
      Mov  xBot,bx
      Mov  yBot,ax
      Mov  cTop,di
      Mov  cBot,si
   @Skip2Top:
    Mov  ax,Y3
    Mov  bx,X3
    Mov  cx,C3
    Cmp  ax,yTop
    Jge @CheckY3Bottom
      Mov  dx,yTop
      Mov  yMid,dx
      Mov  dx,xTop
      Mov  xMid,dx
      Mov  dx,cTop
      Mov  cMid,dx
      Mov  yTop,ax
      Mov  xTop,bx
      Mov  cTop,cx
      Jmp @Fini
   @CheckY3Bottom:
      Cmp ax,yBot
      Jle @Y3Mid
        Mov  dx,yBot
        Mov  yMid,dx
        Mov  dx,xBot
        Mov  xMid,dx
        Mov  dx,cBot
        Mov  cMid,dx
        Mov  yBot,ax
        Mov  xBot,bx
        Mov  cBot,cx
        Jmp @Fini
     @Y3Mid:
        Mov  yMid,ax
        Mov  xMid,bx
        Mov  cMid,cx
   @Fini:
  End;

  If (yBot-yTop) = 0
    Then Begin
      xrMid := xMid;
      crMid := cMid;
    End
    Else Begin
      xrMid := (yMid-yTop)*(xBot-xTop) Div (yBot-yTop) + xTop;
      crMid := (yMid-yTop)*(cBot-cTop) Div (yBot-yTop) + cTop;
    End;

  Asm
    Mov  es,PgSeg
  End;

  If xMid < XrMid
    Then Begin
      DColor := (crMid-cMid) Shl 8 Div (xrMid-xMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := xTop Shl 6;
      xVal2 := xVal1;
      xStep1 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);
      cStep1 := (cMid-cTop) Shl 8 Div (yMid-yTop+1);
      xStep2 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok
            Mov Dl,50
            @Ok:
            Cmp Dh,50
            Jl  @ok2
            Mov Dh,50
            @Ok2:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal2 := xVal2 - xStep2;

      cVal1 := cMid Shl 8;
      xVal1 := xMid Shl 6;
      xStep1 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      cStep1 := (cBot-cMid) Shl 8 Div (yBot-yMid+1);
      For Count := yMid+1 to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok3
            Mov Dl,50
            @Ok3:
            Cmp Dh,50
            Jl  @ok4
            Mov Dh,50
            @ok4:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End
    Else Begin
      DColor := (cMid-crMid) Shl 8 Div (xMid-xrMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := (xTop) Shl 6;
      xVal2 := xVal1;
      xStep1 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      cStep1 := (cBot-cTop) Shl 8 Div (yBot-yTop+1);
      xStep2 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);

      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok5
            Mov Dl,50
            @Ok5:
            Cmp Dh,50
            Jl  @ok6
            Mov Dh,50
            @Ok6:

            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal1 := xVal1 - xStep1;
      cVal1 := cVal1 - cStep1;
      xVal2 := (xMid) Shl 6;
      xStep2 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      For Count := yMid+1 to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok7
            Mov Dl,50
            @Ok7:
            Cmp Dh,50
            Jl  @ok8
            Mov Dh,50
            @Ok8:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End;

End;








Procedure ShowProbs;
Var TempX1,TempX2,TempY1,TempY2:Integer;
    I,Light:Word;

Procedure PseudoCliping;
Begin
 If TempX1<0 Then TempX1:=0;
 If TempX2<0 Then TempX2:=0;
 If TempY1<0 Then TempY1:=0;
 If TempY2<0 Then TempY2:=0;
 If TempX1>319 Then TempX1:=319;
 If TempX2>319 Then TempX2:=319;
 If TempY1>199 Then TempY1:=199;
 If TempY2>199 Then TempY2:=199;
End;

Begin
 For i:=1 to MaxProbs do
  Begin
   TempX1:=TProb[i,1]-20;
   TempX2:=TempX1+30;
   TempY1:=TProb[i,2]-20;
   TempY2:=TempY1+30;
   PseudoCliping;
   Light:=Round(Abs(100-Abs(TempX1-160))/2);
   Light:=Light shr 1 +Round(Abs(100-Abs(TempY1-100))/2);
   TGouraudPoly(160,100,TempX1,TempY1,TempX2,TempY2,
   0,Light,Light,Vaddr);
  End;
End;





Procedure MoveProbs(Count:Word);
Var i,Speed1,Speed2:Word;
Begin

 Speed1:=LookSin[Count Mod 628]+160;
 Speed2:=Looksin[(Count+500) Mod 628]+100;
 For i:=1 to MaxProbs do
  Begin
   TProb[i,1]:=Speed1+PRob[i,1];
   TPRob[i,2]:=Speed2+PRob[i,2];
  End;
End;


Procedure GetPallete2(Fil:String);
Var TCol:Byte;
    Pale:Array[1..3,0..255] of Byte;
Begin
 LPcx(Fil,Vaddr);
 For TCol:=0 to 100 do
   GetPal(Getpixel(160-TCol,100,Vaddr),Pale[1,TCol],Pale[2,TCol],Pale[3,TCol]);
 For TCol:=0 to 100 do
  Pal(TCol,Pale[1,100-TCol],Pale[2,100-TCol],Pale[3,100-TCol]);
End;



Begin

 If Keypressed Then Readkey;

 MaxProbs:=100;
 Cls32(Sega000,0);
 GetPallete2('LenPal3.PCX');
 For i:=1 to MaxProbs do
  Begin
   Prob[i,1]:=Round(Cos(i)*(i*15));
   Prob[i,2]:=Round(Sin(i)*(i*15));
  End;
 Cls(Vaddr,0);
 For i:=1 to 628 do
  LookSin[i]:=Round(Sin(i/100)*100);
 l1:=0;
 Repeat
  Cls(Vaddr,0);
  Inc(Counter,12);
  MoveProbs(Counter);
  ShowProbs;
  Smooth(Vaddr);
  Smooth(Vaddr);
  Line(0,0,0,199,0,vaddr);
  Line(1,0,1,199,0,vaddr);
  Line(319,0,319,199,0,vaddr);
  Line(318,0,318,199,0,vaddr);
  WaitRetrace;
  Flip32(Vaddr,Sega000);
 Until (Ticks>2190) or (Keypressed);
 FadeDown;
 Cls32(Sega000,0);
End;





Procedure RWriter;

CONST
      XSize = 28;
      YSize = 31;
TYPE
        Letter = Array[1..xsize,1..ysize] of Byte;
        Letters = Array[' '..']'] of Letter;


VAR Font : ^Letters;
    messages:array[1..20] of string;
    I:Word;
    Times:Word;
    Cur:Word;
    CurMessage:String;
    Counter:Word;
    CurTime:Longint;




Procedure SetupRWriter;
VAR f:file;
    loop1:char;
    loop2,loop3:integer;
BEGIN
  getmem (font,sizeof (font^));
    Assign (f,'BOLDS');
    reset (f,1);
    blockread (f,font^,sizeof (font^));
    close (f);
END;

PROCEDURE showletter(c:char;x,y:integer);
var l1,l2:integer;
begin
  for l1:=1 to xsize do
    for l2:=1 to ysize do
      if (l2+y>0) and (l2+y<199) and (l1+x>0) and (l1+x<320) And
      (font^[c,l1,l2]<>0) then
       putpixel(l1+x,l2+y,63,vaddr);
end;


procedure Showmsg(Str:string;X,Y:INTEGER);
var i:integer;
begin
 for i:=1 to length(str) do
  begin
   showletter(str[i],X+xsize*(i-1),Y);
  end;
end;


Procedure Noise4(Where:Word);
Var o:word;
    Seq:integer;
    Fx:integer;
Begin
Fx:=0;
 For o:=0 to 15999 do
  Begin
   Inc(Fx);
   If Fx=319 Then Fx:=0;
   If Fx=0 Then Seq:=Random(5);     {<-----------}
   If Random(Seq)=1 then
    Begin
     Mem[Where:o]:=Mem[Where:o]+2;
     Mem[Where:o+15999]:=Mem[Where:o+15999]+2;
     Mem[Where:o+31999]:=Mem[Where:o+31999]+2;
     Mem[Where:o+47999]:=Mem[Where:o+47999]+2;
    End;
  End;
End;




Procedure Smooth(Where:Word);assembler;
Var M:Word;
Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Xor bh,bh
 Xor Ch,Ch
 Xor Dh,Dh
 @MainLoop:
  Inc Di
  Dec Di
  Mov Al,Es:[Di]
  Add Di,2
  Mov Bl,Es:[Di]
  Add Di,320
  Mov Cl,Es:[Di]
  Sub Di,2
  Mov Dl,Es:[Di]
  Sub Di,319
  Mov M,Ax
  Add M,Bx
  Add M,Cx
  Add M,Dx
  Shr M,2
  Mov Ax,M
  Mov Es:[Di],Al
  Xor Ah,Ah

  Cmp Di,63678
 Jne @MainLoop
End;


begin

 SetupRWriter;
 messages[1]:='THIS';
 messages[2]:='WEAPON';
 messages[3]:='DOES NOT';
 messages[4]:='LOOK';
 messages[5]:='HUMAN';
 messages[6]:='BRIGHTER';
 messages[7]:='THAN';
 messages[8]:='MIDDAY';
 messages[9]:='SUN';
 messages[10]:='CAUSES';
 messages[11]:='MORE';
 messages[12]:='DEATHS';
 MESSAGES[13]:='IN LESS';
 MESSAGES[14]:='SECONDS';





 cls(sega000,0);
 cls32(vaddr,0);
 For i:=0 to 63 do Pal(i,i,i,i);

 CurTime:=Ticks;
 Times:=20;
 Cur:=1;
 repeat
  If Ticks-CurTime>35 Then
   Begin
    Inc(Cur);
    CurTime:=Ticks;
    If Cur>14 Then Cur:=1;
    Counter:=0;
   End;
  CurMessage:=Messages[Cur];
  Inc(Counter);
  If Counter mod 5=1 Then
   showmsg(CurMessage,Random(320-Length(CurMessage)*XSize),
  Random(100-YSize)+70);
  HLine(0,319,199,0,Vaddr);
  Putpixel(319,199,0,Vaddr);
  Smooth(Vaddr);Smooth(Vaddr);Smooth(Vaddr);Smooth(Vaddr);

  Noise4(Vaddr);
  Putpixel(319,198,0,Vaddr);
  WaitRetrace;
  flip32(vaddr,sega000);
 until (Ticks>2880) or (Keypressed);
End;



{$i tflip}


begin
  SetUpMidas;
  PlayMusic;
  setupvirtual;
  if keypressed then readkey;
  setmcga;
  Ticks:=0;
   Cls(Sega000,0);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);

  Getmem (RndMatrix,4100);
  SetupRNDMatrix (seg(RndMatrix^),5);
                              { ^ -> max value}


  Factor:=30;
  Tractor:=2;
  ShowEdges(250);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Cls(Sega000,0);
  Lpcx('cebor4.pcx',sega000);
  pal(0,10,10,10);
  Repeat
  Until (Ticks>345) or (keypressed);
  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>580) or (keypressed);
  pal(0,0,0,0);
  Cls(Sega000,0);
  Cls(Vaddr,0);
  Cls(Vaddr2,0);
  Factor:=15;
  ShowEdges(708);
  Cls(Vaddr,0);

  shut;

(*{-------------------------------------------------------------------------}
{End of faces part}


  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) or (keypressed);
  l1:=0;
  cls(sega000,255);
  tshut;
{------------------------------------------------------------------------}
{end of coming rocket part}*)
{-------------------------------------------------------------------------}
{start of the i3 part  ( psfioooouuuuu............)}



 For l2:=0 to 64255 do Mem[Vaddr3:l2]:=Random(7);
 For I:=0 to 320 do
  Begin
   Cx[i]:=Round(23.7+0.85*i);
   Cy[i]:=Round(14+0.85*i);
  End;
{ For i:=0 to 255 do Pal(i,i shr 3,i shr 2,i shr 3);}
  for l1:=1 to 255 do pal(l1,l1 div 5,l1 div 5,l1 div 4);
 Pal(255,0,0,0);
 Cls32(Vaddr,0);
 Flip32(Vaddr2,Vaddr);
 Repeat
  Scale;
  Flip32(Vaddr2,Vaddr);
  Flip32(Vaddr2,Sega000);
  ASmooth(Vaddr);
  If Ticks>780 Then
   For i:=1 to 150 do
    Putpixel(150+Random(20),90+Random(20),255,Vaddr)
     Else
     For i:=1 to 50 do
      Putpixel(150+Random(20),90+Random(20),255,Vaddr);

 Until (Ticks>790) or (Keypressed);
FadeDown;

{End of the i3 part }
{-------------------------------------------------------------------------}



  tsetup('room.euv');
  setup('helios.euv');
  Cls(Sega000,0);
  tsettmap('remap2.pcx','woodmap.pcx',vaddr);

  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;}

    trndflip16 (vaddr2,vaddr,seg(rndmatrix^),random($ff));
   flip32(vaddr2,sega000);


        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) or (keypressed);
  Cls32(Sega000,0);
  tshutmap;
  tshut;
  shut;
{-------------------------------------------------------------------------}
{end of rotating logo part}

  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;
  CurTime:=Ticks;
  repeat
   Ticks:=0;
    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);
    Smooth2(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);
    CurTime:=CurTime+Ticks;
    Dec(TYOff,Ticks*2);
  until (l3>70) or (keypressed);
  Ticks:=CurTime;
  Cls32(Sega000,0);
  shutfloor;
  tshutmap;
  tshut;
{------------------------------------------------------------------------}
{end of rocket part}



{------------------------------------------------------------------------}
{Start of Rocket Camera Part}
 If Keypressed Then Readkey;
 SetUpCamerasForVoxel;
  RocketCamera2;
 Cls32(Sega000,0);
 ShutDownCamerasForVoxel;
{------------------------------------------------------------------------}
{End of Rocket Camera Part}
{------------------------------------------------------------------------}
{Town Before dsrt}
If Keypressed Then Readkey;
LPcx('twnfinal.pcx',Vaddr);
Flip32(Vaddr,Sega000);
For o:=0 to 63999 do
 Begin
  GetPal(Mem[Vaddr:o],r,g,b);
  Mem[Vaddr2:o]:=(r+g+b) div 3;
 End;
Repeat
Until (Ticks>1430) or (Keypressed);
FadeUp;
Flip32(Vaddr2,Sega000);
For o:=0 to 63 do
 Begin
{  WaitRetrace;}
  For i:=63 downto o do
   Pal(O,i,i,i);
 End;
For i:=64 to 255 do pal(i,0,0,0);
HLine(0,320,0,0,Sega000);
HLine(0,320,199,0,Sega000);
Flip32(Sega000,Vaddr);
  Burn.Init(6);
  w:=0;
  repeat
   burn.burnit (vaddr,sega000);
{   waitretrace;}
   inc (w);
  Until w>300;
 Burn.DeInit;



{------------------------------------------------------------------------}





  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
     wpallete;
     {got inside}

     tshutmap;
     tset1map('remap2.pcx',2,vaddr2);
     spallete;
     wpallete;


{     rpallete;}
   end;



    if tzoff>=-117 then begin
      rotatepoints2(l1,l1,0);

      showpolys(0,vaddr2);

      if tzoff<-50 then begin
         inc(zoff,38);
         waitretrace;
         waitretrace;

      end;

    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;}
    if tzoff>-114 then rpallete;
    trndflip16 (vaddr2,vaddr,seg(rndmatrix^),random($ff));
    flip32(vaddr2,sega000);



{     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>1740) or (keypressed);
  tshutmap;
  tshut;
  shut;

{----------------------------------------------------------------------------}
{end of rotating sphere-mirror part}

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


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




{   flip(vaddr
    ,SEGA000);}

  until (ticks>1980) or (keypressed);
  shut;
 FadeDown;
 Cls32(Sega000,0);
{-----------------------------------------------------------------------}
 {End of animated hand part}

 {start tgpoly part}

DoTgPoly;

{end tgpoly part}
{-----------------------------------------------------------------------}



{-----------------------------------------------------------------------}
{Tunnel part and burn}
 DoTunnel;
{-----------------------------------------------------------------------}



{-----------------------------------------------------------------------}
{Rwrite Part}
If Keypressed Then Readkey;
RWriter;
{-
----------------------------------------------------------------------}

LPcx('desfinal.pcx',Vaddr);
Flip32(Vaddr,Sega000);
For o:=0 to 63999 do
 Begin
  GetPal(Mem[Vaddr:o],r,g,b);
  Mem[Vaddr2:o]:=(r+g+b) div 3;
 End;
Repeat
Until (Ticks>2910) or (Keypressed);
FadeUp;
Flip32(Vaddr2,Sega000);
For o:=0 to 63 do
 Begin
{  WaitRetrace;}
  For i:=63 downto o do
   Pal(O,i,i,i);
 End;
For i:=64 to 255 do pal(i,0,0,0);
HLine(0,320,0,0,Sega000);
HLine(0,320,199,0,Sega000);
Flip32(Sega000,Vaddr);
  Burn.Init(3);
  w:=0;
  repeat
   burn.burnit (vaddr,sega000);
{   waitretrace;}
   inc (w);
  Until w>300;
 Burn.DeInit;


{Greetings Part}
sea6.init;

o:=0;
repeat
sea6.nextframe;
inc (o);
until o>1150;

sea6.deinit;
fadedown;

cls32 (sega000,0);

  lpcx('remap2.pcx',vaddr);
  hline(106,212,100,0,vaddr);
  line(212,1,212,199,0,vaddr);
  line(106,1,106,199,0,vaddr);
   setup('statue.euv');
  smooth2(vaddr);
  smooth2(vaddr);
  smooth2(vaddr);
  d:=1;
  ad1:=0;
  ad2:=0;
  ad3:=0;
  ambient:=-20; {Allaxe to auto na deis pos allazei h skhnh}
  zoff:=-400;
  con:=80;
  bumppal;
  Pal(0,0,0,0);
  optdobump;   {do it.. :)}
  shut;


{-----------------------------------------------------------------------------}
{End of Bumpy room part}

(*
 SetUpCamerasForVoxel;
 Pal(255,0,0,0);
 Repeat
  RotatedCamera;
  If Readkey=#27 Then
   Begin
    ShutDown;
    ShutDownCamerasForVoxel;
    SetText;

    Halt;
   End;
  RocketCamera2;
 Until 1=2;
  *)

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