program fuk;

Const VGA=$A000;
      Npages=2;
      MinX=0;
      MaxX=319;
      MinY=0;
      MaxY=199;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
     Table=Array[0..1799] Of integer;
     PTable=^Table;

Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
end;

Procedure PutPixel(X,Y:word;Col:Byte;Where:Word);
Begin
     if x>-1 then if x<320 then if y>-1 then if y<200 then
     Mem[Where:(y*320)+x]:=Col;
End;

Function GetPixel(X,Y:word;Where:Word):Byte;
Begin
     GetPixel:=Mem[Where:(y*320)+x];
End;

Procedure Cls(Col:Byte;Where:Word);
Begin
     Fillchar(Mem[Where:0000],64000,Col);
End;

Procedure WaitVBL; Assembler;
Label A1,A2;
Asm
   Mov DX,3DAh
   A1:
      In AL,DX
      And AL,08h
      Jnz A1
   A2:
      In AL,DX
      And AL,08h
      Jz A2
End;

Function GetKey (Var Key : Word) : Boolean; Assembler;
{ determine if key pressed and return it as a Word }
{ if Lo(key) = 0 and Hi(key) <> 0 then we have a FN key ! }
Asm
  MOV     AH, 1
  INT     16H
  MOV     AL, 0
  JE      @@1
  xor     AH, AH
  INT     16H
  LES     DI, Key
  MOV     Word PTR ES : [DI], AX
  MOV     AL, 1
 @@1 :
end;

Function GetChar (Var Key : Char) : Boolean;
var c : Word;
begin
  Key := #0;
  if GetKey (c) then
  begin
    GetChar := True;
    if (LO (c) = 0) and (HI (c) <> 0) then
      Key := CHR ( HI (c) + 128 )  { add 128 For FN keys }
    else
      Key := CHR (LO (c) );
  end
  else
    GetChar := False;
end;

Procedure SetColor(Col,R,G,B:Byte);
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
End;

Procedure SetPalette(Pal:RgbList);
Var A:Byte;
Begin
     WaitVBL;
     For A:=0 To 255 do SetColor(A,Pal[A].R,Pal[A].G,Pal[A].B);
End;

Procedure InitVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          GetMem(Virt[A],64000);
          VP[A]:=Seg(Virt[A]^);
     End;

End;

Procedure CloseVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          Freemem(Virt[A],64000);
          VP[A]:=$A000;
     End;
End;

Procedure LoadPCX(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
    PCXPal:RgbList;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     BlockRead(Fil,M,1);
     If M=12 Then
     Begin
          BlockRead(Fil,PCXPal,768);
          For M:=0 To 255 Do
          Begin
               PCXPal[M].R:=PCXPal[M].R Div 4;
               PCXPal[M].G:=PCXPal[M].G Div 4;
               PCXPal[M].B:=PCXPal[M].B Div 4;
          End;
          SetPalette(PCXPal);
     End;
     Close(Fil);
End;

Procedure InitTables;
Var A:Word;
    B:Real;
Begin
     Getmem(Sines,Sizeof(Sines^));
     Getmem(Cosines,Sizeof(Cosines^));
     B:=0;
     For A:=0 To 1799 Do
     Begin
          Sines^[A]:=round(Sin(B)*100);
          Cosines^[A]:=round(Cos(B)*100);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
End;

Procedure Circle(X,Y,R:Integer;Col:Byte;Where:Word);
Var Px,Py:Integer;
    Deg:Word;
Begin
     For Deg:=0 to 1799 Do
     Begin
          Px:=Trunc(R*Sines^[Deg]+X);
          Py:=Trunc(R*Cosines^[Deg]+Y);
          PutPixel(Px,Py,Col,Where);
     End;
End;

procedure circles (x,y,n,r,c1:integer;where:word);
var b:integer;
begin
     for b:=1 to r*n do
         begin
              circle(x,y,b,c1*(b div r),where);
         end;
end;

type points=record
            x,y,r:integer;
            end;
     cthingies=record
               x,y:integer;
               end;

var point:array [0..5] of points;
    c:char;
    x,y,xx,px,py,deg:integer;
    dista:integer;
    colo: integer;
    cthing: array [1..4] of cthingies;
    add:integer;

function value(numba: integer; x,y:integer):integer;
begin
     if x>cthing[numba].x then if y>cthing[numba].y then value:=mem[vp[1]:(320-x+cthing[numba].x)+
     (200-y+cthing[numba].y)*320];
     if x>cthing[numba].x then if y<cthing[numba].y then value:=mem[vp[1]:(320-x+cthing[numba].x)+
     (200+y-cthing[numba].y)*320];
     if x<cthing[numba].x then if y>cthing[numba].y then value:=mem[vp[1]:(320+x-cthing[numba].x)+
     (200-y+cthing[numba].y)*320];
     if x<cthing[numba].x then if y<cthing[numba].y then value:=mem[vp[1]:(320+x-cthing[numba].x)+
     (200+y-cthing[numba].y)*320];

     if x=cthing[numba].x then if y<cthing[numba].y then value:=mem[vp[1]:(320+x-cthing[numba].x-1)+
     (200+y-cthing[numba].y)*320];
     if x=cthing[numba].x then if y>cthing[numba].y then value:=mem[vp[1]:(320-x+cthing[numba].x-1)+
     (200-y+cthing[numba].y)*320];

     if y=cthing[numba].y then if x>cthing[numba].x then value:=mem[vp[1]:(320-x+cthing[numba].x)+
     (200-y+cthing[numba].y-1)*320];
     if y=cthing[numba].y then if x<cthing[numba].x then value:=mem[vp[1]:(320+x-cthing[numba].x)+
     (200+y-cthing[numba].y-1)*320];

     if y=cthing[numba].y then if x=cthing[numba].x then value:=mem[vp[1]:(320-x+cthing[numba].x-1)+
     (200-y+cthing[numba].y-1)*320];

end;

begin
     video_mode ( $13);
     initvirt;
     inittables;

     loadpcx ('fuk.pcx',vp[1]);

     deg:=0;
     add:=30;

     repeat

     deg:=deg+add;
     if deg>1700 then repeat deg:=deg-1269 until deg<1700;

     cthing[1].x:=40*Sines^[Deg] div 100;
     cthing[1].y:=40*Cosines^[Deg] div 100;

     cthing[2].x:=50*CoSines^[Deg] div 100;
     cthing[2].y:=10*sines^[Deg] div 100;


     for x:=-160 to 160 do for y:=-100 to 100 do
         begin
              colo:=0;
{              colo:=colo+value(1,x,y);}
              colo:=colo+value(2,x,y);
              if colo>255 then colo:=255;
              mem[vp[2]:(x+159)+(99-y)*320]:=colo;
         end;

     move (mem[vp[2]:0],mem[vga:0],64000);

     if getchar(c)=true then c:=#27;
     until c=#27;

     cleartables;
     closevirt;
     video_mode (03);
end.
