program finbarrs_F;

uses crt,pal,pcxunit,fin;

const num=544;{272}

type pa=array[0..255] of array[0..2] of byte;

var pixel:array[1..num] of record
                           x,y,z:real;
                           c:byte;
                          end;
    pcos,ncos,psin,nsin:real;
    c:char;
    page:byte;
    pall:pa;
    h,v:integer;

procedure setpalette(a,b:word);
begin
 asm
  push ds
  push si
  mov ax,a
  mov ds,ax
  mov si,b
  cli
  mov dx,$3c8
  xor al,al
  out dx,al
  inc dx
  mov cx,$300
  @f:
   lodsb
   out dx,al
  loop @f
  sti
  pop si
  pop ds
 end;
end;

procedure rotx(dir:byte);
var y1,z1:real;
    i:integer;
begin
 for i:=1 to num do
  begin
   if dir=1 then
    begin y1:=pcos*pixel[i].y-psin*pixel[i].z;
    z1:=psin*pixel[i].y+pcos*pixel[i].z;end
    else begin y1:=ncos*pixel[i].y-nsin*pixel[i].z;
     z1:=nsin*pixel[i].y+ncos*pixel[i].z;end;
   pixel[i].y:=y1;pixel[i].z:=z1;
  end;
end;

procedure roty(dir:byte);
var x1,z1:real;
    i:integer;
begin
 for i:=1 to num do
  begin
   if dir=1 then
    begin x1:=pcos*pixel[i].x-psin*pixel[i].z;
     z1:=psin*pixel[i].x+pcos*pixel[i].z;end
    else begin x1:=ncos*pixel[i].x-nsin*pixel[i].z;
    z1:=nsin*pixel[i].x+ncos*pixel[i].z;end;
   pixel[i].x:=x1;pixel[i].z:=z1;
  end;
end;

procedure rotz(dir:byte);
var x1,y1:real;
    i:integer;
begin
 for i:=1 to num do
  begin
   if dir=1 then
    begin y1:=pcos*pixel[i].y-psin*pixel[i].x;
     x1:=psin*pixel[i].y+pcos*pixel[i].x;end
    else begin y1:=ncos*pixel[i].y-nsin*pixel[i].x;
     x1:=nsin*pixel[i].y+ncos*pixel[i].x;end;
   pixel[i].x:=x1;pixel[i].y:=y1;
  end;
end;

procedure display_pic;
const zeye=-60;
var i,x,y:integer;
    o:longint;
    clr:word;
begin
 asm
  mov dx,$3da
 @again:
  in al,dx
  and al,8
  jz @again
 end;
 for clr:=20500 to 44000 do mem[$a000:clr]:=0;
 for i:=1 to num do
  begin
   x:=170+round(pixel[i].x*(Zeye/(Zeye-pixel[i].z)));
   y:=100+round(pixel[i].y*(Zeye/(Zeye-pixel[i].z)));
   mem[$a000:x+(y shl 6)+(y shl 8)]:=pixel[i].c;
  end;
end;

procedure init;
var o:pcximage;
    x,y,i,j,disx,disy,count,t:integer;
    pcxname:string;

begin
 initmouse;
 asm
  mov ah,0
  mov al,13h
  int $10
 end;
 pcxname:='f_inc.dat';
 pcxinit(pcxname,o);
 readpcx(pcxname,o,x,y);
 i:=x;
 j:=y;
 disx:=x div 2;
 disy:=y div 2;
 for x:=0 to 255 do
  for y:=0 to 2 do
   pall[x][y]:=pcxpalette256[x][y] div 4;
 setpalette(seg(pall),ofs(pall));
 count:=1;
 for y:=0 to j-1 do
  for x:=0 to i-1 do
   begin
    if o[y+1]^[x+1]<>0 then
     begin
       for t:=0 to 1 do
        begin
         pixel[count+t].x:=x-disx;
         pixel[count+t].y:=y-1-disy;
         pixel[count+t].c:=o[y+1]^[x+1];
         pixel[count+t].z:=t;
         inc(count);
        end;
     end;
   end;
 pcxdone(pcxname,o);
 display_pic;
end;

procedure workout(r:integer);
begin
 pcos:=cos(r*2*pi/360);
 ncos:=cos(-r*2*pi/360);
 psin:=sin(r*2*pi/360);
 nsin:=sin(-r*2*pi/360);
end;

begin
 init;
 display_pic;
 workout(10);
 repeat
  if rclick then
   repeat
    mousemove(h,v);
    if h<0 then begin workout(-h);rotz(1);end;
    if h>0 then begin workout(h);rotz(0);end;
    if h<>0 then display_pic;
   until rrelease;
   mousemove(h,v);
   if v<0 then begin workout(v);rotx(1);end;
   if v>0 then begin workout(-v);rotx(0);end;
   if h<0 then begin workout(h);roty(1);end;
   if h>0 then begin workout(-h);roty(0);end;
   if(v<>0)or(h<>0)then display_pic;
 until (lclick)or(keypressed);
 asm
  mov ah,0
  mov al,3
  int $10
 end;
end.
