program dist;

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 GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:Word;
    Segm,Offs:Word;
Begin
     Dx:=Abs(x2-x1)+1;
     Dy:=Abs(y2-y1)+1;
     GetMem(Img,Dx*Dy+4);
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Dx,Mem[Segm:Offs],2);
     Move(Dy,Mem[Segm:Offs+2],2);
     Offs:=Offs+4;
     For A:=y1 to y2 Do
     For B:=x1 to x2 Do
     Begin
          Mem[Segm:Offs]:=GetPixel(B,A,Where);
          Inc(Offs);
     End;
End;

Procedure KillImage(Var Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     FreeMem(Img,Dx*Dy+4);
End;

Procedure PutImage(X,Y,C:Integer;Var Img:Pointer;Where:Word);
Var Dx,Dy:Word;
    A,B:integer;
    Segm,Offs:Word;
Begin
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;

     for a:=y to (Y+DY-1) do
     begin
          for b:=x to (X+DX-1) do
          begin
               If (b>=MinX) then if (a>=MinY) Then
               If (b<=MaxX) then if (a<=MaxY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
          end;
     End;
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;

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

var point:array [0..5] of points;
    c:char;
    x,y,xx,px,py,deg:integer;
    dista:integer;

begin
     video_mode ( $13);
     initvirt;
     inittables;

     c:=' ';

     randomize;
     for x:=0 to 5 do point[x].x:=random (320)-159;
     for x:=0 to 5 do point[x].y:=random (200)-99;
     for x:=0 to 5 do point[x].r:=random (100);

     for x:=0 to 5 do point[x].x:=point[x].x div 2;
     for x:=0 to 5 do point[x].y:=point[x].y div 2;

     deg:=0;

     for x:=0 to 128 do setcolor (x,x div 2,x div 2,x div 2);
     for x:=128 to 255 do setcolor (x,63-(x div 2),63-(x div 2),63-(x div 2));

     repeat

      cls (0,vp[2]);

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


      for x:=0 to 1 do
       begin
            point[x].x:=point[x].x*coSines^[Deg] div 100;
            point[x].y:=point[x].y*sines^[Deg] div 100;
{            if point[x].x>159 then repeat point[x].x:=point[x].x-319 until point[x].x<159;
            if point[x].y>99 then repeat point[x].y:=point[x].y-199 until point[x].y<99;
            if point[x].x<-159 then repeat point[x].x:=point[x].x+319 until point[x].x>-159;
            if point[x].y<-99 then repeat point[x].y:=point[x].y+199 until point[x].y>-99;}
       end;

      for x:=2 to 3 do
       begin
            point[x].x:=point[x].x+64*Sines^[Deg] div 100;
            point[x].y:=point[x].y+4*Cosines^[Deg] div 100;
{            if point[x].x>159 then repeat point[x].x:=point[x].x-319 until point[x].x<159;
            if point[x].y>99 then repeat point[x].y:=point[x].y-199 until point[x].y<99;
            if point[x].x<-159 then repeat point[x].x:=point[x].x+319 until point[x].x>-159;
            if point[x].y<-99 then repeat point[x].y:=point[x].y+199 until point[x].y>-99;}
       end;

      for x:=4 to 5 do
       begin
            point[x].x:=point[x].r+Sines^[Deg] div 100;
            point[x].y:=point[x].r+16*Cosines^[Deg] div 100;
{            if point[x].x>159 then repeat point[x].x:=point[x].x-319 until point[x].x<159;
            if point[x].y>99 then repeat point[x].y:=point[x].y-199 until point[x].y<99;
            if point[x].x<-159 then repeat point[x].x:=point[x].x+319 until point[x].x>-159;
            if point[x].y<-99 then repeat point[x].y:=point[x].y+199 until point[x].y>-99; }
       end;
{
     for x:=0 to 5 do
       begin
            px:=(point[x].r*cosines^[Deg]) div 100;
            py:=(point[x].r*sines^[Deg]) div 100;
            mem[vp[2]:(px+point[x].x+159)+(py+point[x].y+99)*320]:=150;
       end;

     for x:=0 to 5 do mem[vp[2]:(px+159)+(py+99)*320]:=150;}

      for x:=-159 to 159 do for y:=-99 to 99 do
      begin
           dista:=0;
           for xx:=0 to 5 do dista:=dista+(sqr(point[xx].x-x)+sqr(point[xx].y-y));
           dista:=dista div 256;
           mem[vp[2]:(x+159)+(y+99)*320]:=dista;
      end;

      waitvbl;
      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.