Unit cfloor2;
interface

Procedure GetMap(s:string;w:word);
procedure shutfloor;
Procedure PutFloor(CurPointOfView,Where:Word);

var
  fw:integer;
  zobs:longint;



implementation
Uses crt,gfx3;
type lrgarr=array[0..65534] of byte;

var
  map:^lrgarr;
  rng:array[0..320] of byte;
  i,x21,y21:integer;
  Loop,dir:integer;
  Counter:integer;




Procedure GetMap(s:string;w:word);
var counter2,counter:real;
    c,r,g,b:byte;
    j:integer;
begin
  New(Map);
  zobs:=700;   { <--------- Height of Floor (!) }
  FW:=40;      { <--------- Angle of Floor  (!) }
 LPCX(s,w);
 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),w) div 2;
    map^[word(j shl 8+i+1) mod 65535]:=c;
    {reduce colors to half}

   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),w) div 2;
    map^[word(j shl 8+i+1) mod 65535]:=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),w) div 2;
    map^[word(j shl 8+i+1) mod 65535]:=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),w) div 2;
    map^[Word(Word(j shl 8)+Word(i)+1 mod 65532)]:=c;
   end;
  counter2:=counter2-0.77;
  end;
  for j:=1 to 128 do begin
      getpal(j*2,r,g,b);
    palar[j,1]:=r;
    palar[j,2]:=g;
    palar[j,3]:=b;
 end;
end;

procedure shutfloor;
begin
  dispose(map);
end;

Procedure DrawFloor(xp,yp:integer; dir:integer; Where:Word);
var z,ix,iy,
    iy1,iyp,
    ixp,x,y,
    s,y2,csf,
    snf,mpc,i21,j21:integer;
    Temp2,Temp:Word;
    TempCol:Byte;
    Speed,Speed2:Integer;
begin
  FillChar(rng,sizeof(rng),200);
  csf:=round(256*cos(dir/180*pi));
  snf:=round(256*sin(dir/180*pi));
  for iy:=yp to yp+80 do begin
    Speed2:=iy-yp;
    iy1:=1+(Speed2) shl 1;
    s:=1+300 div iy1;
    for ix:=xp+yp-iy to xp-yp+iy do begin
      Speed:=ix-xp; 
      ixp:=xp+(Speed*csf+Speed2*snf) shr 8;
      iyp:=yp+(Speed2*csf-Speed*snf) shr 8;
      x:=160+360*(Speed) div iy1;
      if (x>=0) and (x+s<=318) then
       begin
        z:=50;
        mpc:=z;
        y:=FW+(zobs-z) shl 4 div iy1;
        if (y<=199) and (y>=0) then
        for j21:=x to x+s do
         begin
          Temp2:=Word(iyp shl 8+ixp);
          TempCol:=Map^[(Temp2) mod 65535];
          Temp:=Word((y shl 8)+(y shl 6)+j21);
          for i21:=y to rng[j21]-1 Do
           begin
             Mem[Where:Temp]:=TempCol;
             Temp:=Temp+320;
           end;
          if y<rng[j21] then rng[j21]:=y
        end;
      end;
    end;
  end;
end;



Procedure PutFloor(CurPointOfView,Where:Word);
Begin
  X21:=Round(Cos(CurPointOfView/10)*30);
  Y21:=Round(Sin(CurPointOfView/10)*30);
  Dir:=Round(-(CurPointOfView+15)*(361/63));
  DrawFloor(x21,y21,dir,Where);
End;




begin
{  SetMCGA;
  setupvirtual;

  New(Map);
  zobs:=200;   { <--------- Height of Floor (!)
  FW:=80;      { <--------- Angle of Floor  (!)
  GetMap;
  Cls(Vaddr,0);
  repeat
   Inc(Counter,1);  { <------- Speed Of Rotation (!)
   PutFloor(Counter,Vaddr);

   flip32(Vaddr,sega000);
  until Keypressed;
 SetText;
 ShutDown;                                           }
end.
