{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

{some stuff like 286/386 instructions enabled
 and use function as get procedure}

program blurtest;

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 Real;
     PTable=^Table;
     Chars=Array[1..3,' '..'§'] of pointer;
        {1..3 is for 3 different fonts}
Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;
    Font:Chars;

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;

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

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

Procedure GetPalette(Var Pal:RgbList);
Var A:Byte;
Begin
     For A:=0 To 255 do GetColor(A,Pal[A].R,Pal[A].G,Pal[A].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 swapcolors (x1,y1,x2,y2,a,b:integer; where:word);
var x,y,c:integer;
begin
     for x:=x1 to x2 do
         begin
         for y:=y1 to y2 do
             begin
                  c:=Mem[Where:(y*320)+x];
                  if c=a
                  then Mem[Where:(y*320)+x]:=b
                  else if c=b then Mem[Where:(y*320)+x]:=a;
             end;
         end;
end;

Procedure swapcolors_p (a,d:integer);
var r,g,b,s,h,c:byte;
begin
     Port[$3C7]:=a;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];

     Port[$3C7]:=d;
     s:=Port[$3C9];
     h:=Port[$3C9];
     c:=Port[$3C9];

     Port[$3C8]:=a;
     Port[$3C9]:=s;
     Port[$3C9]:=h;
     Port[$3C9]:=c;

     Port[$3C8]:=d;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
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 square (x1,y1,x2,y2,c:integer;where:word);
var x,y:integer;
begin
     for x:=x1 to x2 do Mem[Where:(y1*320)+x]:=c;
     for y:=y1 to y2 do Mem[Where:(y*320)+x1]:=c;
     for x:=x1 to x2 do Mem[Where:(y2*320)+x]:=c;
     for y:=y1 to y2 do Mem[Where:(y*320)+x2]:=c;
end;

procedure square_fill (x1,y1,x2,y2,c:integer;where:word);
var x,y:integer;
begin
     for x:=x1 to x2 do
         begin
              for y:=y1 to y2 do Mem[Where:(y*320)+x]:=c;
         end;
end;

Procedure Hline(x1,x2,y:Word;Color:Byte;Where:Word); Assembler;
Asm
    mov   ax,Where
    mov   es,ax
    mov   ax,y                  { Calculate exact vga position }
    mov   di,ax
    shl   ax,8
    shl   di,6
    add   di,ax
    add   di,x1

    mov   al,Color              { Set color }
    mov   ah,al
    mov   cx,x2
    sub   cx,x1
    shr   cx,1
    jnc   @Start_Fill
    stosb                       { Plot extra pixel (odd # pixels) }
@Start_Fill:
    rep   stosw                 { Plot all remaining pixels (even # pixels) }
End;

Procedure Triangle_Fill(x1,y1,x2,y2,x3,y3: Integer; Color: Byte);
Var Temp, Loop1: Integer;
    StartX, EndX,
    LeftX, RightX: Real;
Begin

  { Sort on y-values }

  If y1 > y3 then                  { y3 must be the largest y-value }
  Begin
    Temp := y3;
    y3 := y1;
    y1 := Temp;
    Temp := x3;
    x3 := x1;
    x1 := Temp;
  End;
  If y1 > y2 then                  { y1 must be the smallest y-value }
  Begin
    Temp := y2;
    y2 := y1;
    y1 := Temp;
    Temp := x2;
    x2 := x1;
    x1 := Temp;
  End;
  If y2 > y3 then                  { y2 must be the middle value }
  Begin
    Temp := y2;
    y2 := y3;
    y3 := Temp;
    Temp := x2;
    x2 := x3;
    x3 := Temp;
  End;

  If (y3-y1) <> 0 then LeftX :=  (x3-x1) / (y3-y1) else LeftX := 0;
  If (y2-y1) <> 0 then RightX := (x2-x1) / (y2-y1) else RightX := 0;

  StartX := x1;
  If (y1-y2) <> 0 then EndX := StartX else EndX := x2;
  For Loop1 := y1 to y2 Do         { Draw first half of triangle }
  Begin
    If StartX < EndX then
      Hline(Round(StartX), Round(EndX), Loop1, Color, Vga)
    Else
      Hline(Round(EndX), Round(StartX), Loop1, Color, Vga);
    StartX := StartX + RightX;
    EndX := EndX + LeftX;
  End;

  If (y3-y2) <> 0 then RightX := (x3-x2) / (y3-y2) else RightX := 0;

  Startx := x2;
  For Loop1 := y2+1 to y3 Do       { Draw second half of triangle }
  Begin
    If StartX < EndX then
      Hline(Round(StartX), Round(EndX), Loop1, Color, Vga)
    Else
      Hline(Round(EndX), Round(StartX), Loop1, Color, Vga);
    StartX := StartX + RightX;
    EndX := EndX + LeftX;
  End;
End;

Function Sgn(A:Real):Integer;
Begin
     If A<0 then Sgn:=-1;
     If A=0 then Sgn:=0;
     If A>0 then Sgn:=+1;
End;

Procedure Line(X1,Y1,X2,Y2,Col:Integer;Where:Word);
Var Deltax,S,Deltay,Dx1,Dy1,Dx2,Dy2,S1,S2:Real;
    I:Integer;
Begin
     Deltax:=X2-X1;
     Deltay:=Y2-Y1;
     Dx1:=Sgn(Deltax);
     Dy1:=Sgn(Deltay);
     Dx2:=Sgn(Deltax);
     Dy2:= 0;
     S1:=Abs(Deltax);
     S2:=Abs(Deltay);
     If Not (S1>S2) Then
     Begin
          Dx2:=0;
          Dy2:=Sgn(Deltay);
          S1:=Abs(Deltay);
          S2:=Abs(Deltax);
     End;
     S:=Int(S1/2);
     For I:=0 To Round(S1) Do
     Begin
          if x1<320 then if x1>-1 then if y1<200 then if y1>-1 then PutPixel(X1,Y1,Col,Where);
          S:=S+S2;
          If Not (S<S1) Then
          Begin
               S:=S-S1;
               X1:=X1+Round(Dx1);
               Y1:=Y1+Round(Dy1);
          End
          Else
          Begin
               X1:=X1+Round(dx2);
               Y1:=Y1+Round(Dy2);
          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]:=Sin(B);
          Cosines^[A]:=Cos(B);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
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 CopyPage(From,Too:Word;a:integer);
var m:word;
Begin
     for m:=0 to 64000 do
         begin
              if mem[from:m]<>a then Move(Mem[From:m],Mem[Too:m],1);
         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 LoadPCX_nopal(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
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;
     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:Word;
    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;
     A:=Y;
     While (A<=Y+DY-1) And (A<MaxY) Do
     Begin
          B:=X;
          While (B<=X+DX-1) And (B<MaxX) Do
          Begin
               If (X>=MinX) And (Y>=MinY) Then
               if Mem[Segm:Offs]<>c then
                 PutPixel(B,A,Mem[Segm:Offs],Where);
               Inc(Offs);
               Inc(B);
          End;
          Inc(A);
     End;
End;

Procedure SaveImage(Var F:File;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);
     BlockWrite(F,Img^,Dx*Dy+4);
End;

Procedure LoadImage(Var F:File;Var Img:Pointer);
Var Dx,Dy:Word;
    Segm,Offs:Word;
Begin
     BlockRead(F,Dx,2);
     BlockRead(F,Dy,2);
     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;
     BlockRead(F,Mem[Segm:Offs],Dx*Dy);
End;

Procedure Loadfont(filename:string;a:integer);
var f:file;
    b:char;
begin
     assign (F,filename);
     reset (F,1);
     for b:= '0' to '9' do loadimage (F,Font[a,b]);
     loadimage (F,Font[a,' ']);
     for b:= 'A' to 'Z' do loadimage (F,Font[a,b]);
     for b:= 'a' to 'z' do loadimage (F,Font[a,b]);
     loadimage (F,Font[a, '?']);
     loadimage (F,Font[a, '!']);
     loadimage (F,Font[a, '(']);
     loadimage (F,Font[a, ')']);
     loadimage (F,Font[a, ':']);
     loadimage (F,Font[a, '-']);
     loadimage (F,Font[a, '+']);
     loadimage (F,Font[a, ',']);
     loadimage (F,Font[a, '.']);
     loadimage (F,Font[a, '=']);
     loadimage (F,Font[a, '''']);
     loadimage (F,Font[a, '#']);
     loadimage (F,Font[a, '&']);
     loadimage (F,Font[a, '@']);
     loadimage (F,Font[a, '[']);
     loadimage (F,Font[a, ']']);
     loadimage (F,Font[a, ';']);
     loadimage (F,Font[a, '$']);
     loadimage (F,Font[a, '>']);
     loadimage (F,Font[a, '<']);
     loadimage (F,Font[a, '{']);
     loadimage (F,Font[a, '}']);
     loadimage (F,Font[a, '%']);
     loadimage (F,Font[a, '/']);
     loadimage (F,Font[a, '\']);
     loadimage (F,Font[a, '_']);
     loadimage (F,Font[a, '*']);
     loadimage (F,Font[a, '^']);
     close (F);
end;

Procedure UnLoadfont(a:integer);
var f:file;
    b:char;
begin
     for b:= '0' to '9' do killimage (Font[a,b]);
     killimage (Font[a,' ']);
     for b:= 'A' to 'Z' do killimage (Font[a,b]);
     for b:= 'a' to 'z' do killimage (Font[a,b]);
     killimage (Font[a, '?']);
     killimage (Font[a, '!']);
     killimage (Font[a, '(']);
     killimage (Font[a, ')']);
     killimage (Font[a, ':']);
     killimage (Font[a, '-']);
     killimage (Font[a, '+']);
     killimage (Font[a, ',']);
     killimage (Font[a, '.']);
     killimage (Font[a, '=']);
     killimage (Font[a, '''']);
     killimage (Font[a, '#']);
     killimage (Font[a, '&']);
     killimage (Font[a, '@']);
     killimage (Font[a, '[']);
     killimage (Font[a, ']']);
     killimage (Font[a, ';']);
     killimage (Font[a, '$']);
     killimage (Font[a, '>']);
     killimage (Font[a, '<']);
     killimage (Font[a, '{']);
     killimage (Font[a, '}']);
     killimage (Font[a, '%']);
     killimage (Font[a, '/']);
     killimage (Font[a, '\']);
     killimage (Font[a, '_']);
     killimage (Font[a, '*']);
     killimage (Font[a, '^']);
end;

Procedure Savefont(filename:string;a:integer);
var f:file;
    b:char;
begin
     assign (F,filename);
     rewrite (F,1);
     for b:= '0' to '9' do saveimage (F,Font[a,b]);
     saveimage (F,Font[a,' ']);
     for b:= 'A' to 'Z' do saveimage (F,Font[a,b]);
     for b:= 'a' to 'z' do saveimage (F,Font[a,b]);
     saveimage (F,Font[a, '?']);
     saveimage (F,Font[a, '!']);
     saveimage (F,Font[a, '(']);
     saveimage (F,Font[a, ')']);
     saveimage (F,Font[a, ':']);
     saveimage (F,Font[a, '-']);
     saveimage (F,Font[a, '+']);
     saveimage (F,Font[a, ',']);
     saveimage (F,Font[a, '.']);
     saveimage (F,Font[a, '=']);
     saveimage (F,Font[a, '''']);
     saveimage (F,Font[a, '#']);
     saveimage (F,Font[a, '&']);
     saveimage (F,Font[a, '@']);
     saveimage (F,Font[a, '[']);
     saveimage (F,Font[a, ']']);
     saveimage (F,Font[a, ';']);
     saveimage (F,Font[a, '$']);
     saveimage (F,Font[a, '>']);
     saveimage (F,Font[a, '<']);
     saveimage (F,Font[a, '{']);
     saveimage (F,Font[a, '}']);
     saveimage (F,Font[a, '%']);
     saveimage (F,Font[a, '/']);
     saveimage (F,Font[a, '\']);
     saveimage (F,Font[a, '_']);
     saveimage (F,Font[a, '*']);
     saveimage (F,Font[a, '^']);
     close (F);
end;

Procedure Putchar(X,Y,C:Integer;N:Char;a:integer;Where:Word);
Var Dx,Dy:Word;
    D,B:Word;
    Segm,Offs:Word;
    Img:Pointer;
Begin
     Img:=Font[a,N];
     Segm:=Seg(Img^);
     Offs:=Ofs(Img^);
     Move(Mem[Segm:Offs],Dx,2);
     Move(Mem[Segm:Offs+2],Dy,2);
     Offs:=Offs+4;
     D:=Y;
     While (D<=Y+DY-1) And (D<MaxY) Do
     Begin
          B:=X;
          While (B<=X+DX-1) And (B<MaxX) Do
          Begin
               If (X>=MinX) And (Y>=MinY) Then
               if Mem[Segm:Offs]<>c then
                 Mem[Where:(d*320)+b]:=Mem[Segm:Offs];
               Inc(Offs);
               Inc(B);
          End;
          Inc(D);
     End;
End;

Procedure Putstring(x,y,col,lx,s:integer;n:string;a:integer;Where:word);
var index:byte;
    dx:integer;
begin
     Dx:=x;
     for index:=0 to length(n)-1 do
         begin
              putchar (Dx,y,col,n[index+1],a,Where);
              dx:=dx+lx+s;
         end;
end;

{-------------------------------------------------------}
{keyboard shit now}

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;
{ determine if key pressed and return it as a Char}
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 keyboardlock; assembler;
asm
   in  al,21h
   or  al,00000010b
   out 21h,al
end;

procedure keyboardunlock; assembler;
asm
   in  al,21h
   and al,11111101b
   out 21h,al
end;

{this comes down to here because of the keyb stuff...}

procedure Getstring(x,y,col,dx,count,a:integer;return:string);
var f,k:boolean;
    garbage:pointer;
    ax:integer;
    c:char;
begin
     f:=true;
     ax:=x;
     getimage (x,y,x+dx,y+dx,garbage,vga);
     repeat
           k:=true;
           if f=true then repeat until getchar(c)=true;
           if c=chr(013) then f:=false;
           if c=chr(008) then
              begin
                   if ax>=x then ax:=ax-dx;
                   if ax>=x then putimage (ax,y,col,garbage,vga);
                   if ax>=x then count:=count+1;
                   k:=false;
              end;
           if k=true then if f=true then putchar (ax,y,col,c,a,vga);
           if k=true then if f=true then ax:=ax+dx;
           if k=true then if f=true then return:=return+c;
           if k=true then if f=true then count:=count-1;
           if count=0 then f:=false;
     until f=false;
     killimage (garbage);
end;

{------------------------------------------------------------}
{-------------ok now we start coding-------------------------}
{------------------------------------------------------------}

type pos= record
                c:integer;
                x,y,x1,y1:real;
                end;

var position: array [0..50] of pos;
    sc1,sc2:word;
    a,aa,count: integer;
    c: char;

procedure blur(from,too:word);
var x,y,x1,y1,aaa,ccc,counter:integer;
    cccc: array [1..9] of integer;
begin
     for x:=0 to 320 do for y:=0 to 200 do
         begin
          cccc[1]:=mem[from:(x+1)+(y+1)*320];
          cccc[2]:=mem[from:(x)+(y+1)*320];
          cccc[3]:=mem[from:(x-1)+(y+1)*320];
          cccc[4]:=mem[from:(x+1)+(y)*320];
          cccc[5]:=mem[from:(x)+(y)*320];
          cccc[6]:=mem[from:(x-1)+(y)*320];
          cccc[7]:=mem[from:(x+1)+(y-1)*320];
          cccc[8]:=mem[from:(x)+(y-1)*320];
          cccc[9]:=mem[from:(x-1)+(y-1)*320];
          ccc:=0;
          counter:=1;
          for aaa:=1 to 9 do
              begin
{                   if cccc[aaa]<>0 then
                      begin}
                           counter:=counter+1;
                           ccc:=ccc+cccc[aaa];
                      {end;  }
              end;
          if ccc>0 then mem[too:x+y*320]:=round(ccc div counter);
      end;
end;

procedure putball (x,y,col:integer;where:word);
var aaa:integer;
begin
     for aaa:=-2 to 2 do mem[where:(x+aaa)+(y-5)*320]:={mem[where:(x+aaa)+(y-5)*320]+}col;
     for aaa:=-3 to 3 do mem[where:(x+aaa)+(y-4)*320]:={mem[where:(x+aaa)+(y-4)*320]+}col;
     for aaa:=-4 to 4 do mem[where:(x+aaa)+(y-3)*320]:={mem[where:(x+aaa)+(y-3)*320]+}col;
     for aaa:=-5 to 5 do mem[where:(x+aaa)+(y-2)*320]:={mem[where:(x+aaa)+(y-2)*320]+}col;
     for aaa:=-5 to 5 do mem[where:(x+aaa)+(y-1)*320]:={mem[where:(x+aaa)+(y-1)*320]+}col;
     for aaa:=-5 to 5 do mem[where:(x+aaa)+(y)*320]:={mem[where:(x+aaa)+(y)*320]+}col;
     for aaa:=-5 to 5 do mem[where:(x+aaa)+(y+1)*320]:={mem[where:(x+aaa)+(y+1)*320]+}col;
     for aaa:=-5 to 5 do mem[where:(x+aaa)+(y+2)*320]:={mem[where:(x+aaa)+(y+2)*320]+}col;
     for aaa:=-4 to 4 do mem[where:(x+aaa)+(y+3)*320]:={mem[where:(x+aaa)+(y+3)*320]+}col;
     for aaa:=-3 to 3 do mem[where:(x+aaa)+(y+4)*320]:={mem[where:(x+aaa)+(y+4)*320]+}col;
     for aaa:=-2 to 2 do mem[where:(x+aaa)+(y+5)*320]:={mem[where:(x+aaa)+(y+5)*320]+}col;
{originally i would ADD a col to the value of the pixel but i remixed the proc}
end;

begin
     video_mode ( $13);
     initvirt;

     randomize;
     c:=' ';
     for a:=0 to 255 do setcolor (a div 16,a div 4, a div 4, a div 4);
     cls (0,vp[2]);
     cls (0,vp[1]);

     for a:=0 to 50 do
         begin
              position[a].x:=random(320)-160;
              position[a].y:=random(200)-100;
              position[a].x1:=(random(11)/10)*random(3)-1 ;
              position[a].y1:=(random(11)/10)*random(3)-1 ;
              position[a].c:=15;
         end;

     count:=0;

     repeat
           count:=count+1;
           if count>round(3.1415926535*40) then count:=0;
           for a:=0 to 50 do
               begin
                    {position[a].x:=position[a].x+position[a].x1;
                    if position[a].x>160 then position[a].x:=-160;
                    if position[a].x<-160 then position[a].x:=160;

                    position[a].y:=position[a].y+position[a].y1;
                    if position[a].y>100 then position[a].y:=-100;
                    if position[a].y<-100 then position[a].y:=100;}

                    {position[a].x:=5*a*cos(count/10);
                    position[a].y:=5*a*sin(count/10);}

                    {position[a].x:=5*a*cos(count/10);
                    position[a].y:=5*a*sin(count/5);}

                    {position[a].x:=a*cos(count/10);
                    position[a].y:=5*a*sin(count/10);}

                    {position[a].x:=5*a*cos(count/10)*cos(count/5);
                    position[a].y:=5*a*sin(count/10)*cos(count/5);}

                    {position[a].x:=5*a*cos(count/10)*sin(a);
                    position[a].y:=5*a*sin(count/10)*cos(a);}

                    {position[a].x:=2*a*sin(a)*cos(count/10);
                    position[a].y:=2*a*cos(a)*sin(count/10);}

                    position[a].x:=2*a*sin(a)+sin(count)*5;
                    position[a].y:=2*a*cos(a)+cos(count)*5;

               {-hum... i could apply a rotozoomer using another 2 x and y
                variables but im to lazy to do it today... :P}
             { anyway... only apply one fx at any one time! theres 9 of them }

               end;

{          for a:=0 to 10 do
               begin}
               for aa:=0 to 50 do putball(160+round(position[aa].x),100-round(position[aa].y),position[aa].c,vp[2]);

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

{               end;  }
               for a:=0 to 319 do for aa:=0 to 199 do mem[vga:a+aa*320]:=mem[vp[1]:a +aa*320];

     getchar(c);
     until c=#27;

     closevirt;
     video_mode ( 03);
end.