uses crt,gfx3,polygons;
const Xstep=20;

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




Function MByte(vc:Integer):Byte;
Begin
{ N:=Vc;
 If vc>255 Then MByte:=255 Else
 If Vc<0 Then MByte:=0
  Else MByte:=Vc;}
  If Byte(Vc)=0 Then MByte:=0 Else MByte:=Byte(Vc);
End;



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;
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
  CenterX:=160;
  CenterY:=100;
  SetMCGA;
  SetUpVirtual;
  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);
  repeat
    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;
    if keypressed then ch:=readkey;
    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);
    line(0,0,0,200,0,vaddr);
    inc(C);
    LightX:=round(cos(CounterL/13)*56+117);
    LightY:=round(sin(CounterL/23)*66+100);
    LightX2:=round(cos((CounterL+100)/13)*56+117);
    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);
    Cls32(vaddr,0);
  until ch=#27;
  ShutDown;
  FreeMem(Myp,sizeof(myp));
  SetText;
end.