program BLUR;

uses Crt,mVBE;

Type TSalut=Record
        X:Real;
        Y:Real;
        NX:Word;
        NY:Word;
     End;

var Scr                   :Array[0..256000] of Byte;  {Виртуальный видео-буффер}
    F                     :File;
    RSize                 :DWord;
    Salut                 :Array[1..10,1..40] of TSalut;
    SalDown               :Array[1..10] of Real;
    SalColor              :Array[1..10] of DWord;
    SalTimer              :Array[1..10] of Word;
    X                     :DWord;
    Exit                  :Boolean;
    Mode                  :Word;

Procedure PrintBuf;   {Копирование виртуального видео-буфера в реальный}
var I,S:Word;
Begin
 asm
   cld
   lea     esi,Scr;
   mov     edi,[VBE_VideoMem]
   mov     ecx,64000
   repe    movsd
 end;
End;

Procedure Blur;   {Сам Блюр}
 var I:DWord;
Begin
 asm
   lea      edi,Scr
   add      edi,1280
   mov      ecx,253440
   xor      ebx,ebx
@1:
   xor      eax,eax
   mov      bl,[edi-4]
   add      eax,ebx
   mov      bl,[edi-1280]
   add      eax,ebx
   mov      bl,[edi+1280]
   add      eax,ebx
   mov      bl,[edi+4]
   add      eax,ebx

   shr      eax,2
   mov      [edi],al
   inc      edi
   loop     @1
 end;
End;

Procedure Plot(X,Y,Color:DWord);
 var Addr:DWord;
Begin
 asm
   lea     ebx,Scr       {ebx = адресс видео-буфера}
   mov     edi,[X]       {edi = X}
   cmp     edi,1         {Проверка попадания в экран}
   jna     @NoPlot
   cmp     edi,318
   ja      @NoPlot
   mov     eax,[Y]       {eax = Y}
   cmp     eax,1         {Проверка попадания в экран}
   jna     @NoPlot
   cmp     eax,198
   ja      @NoPlot
   imul    eax,eax,1280   {Вычисление видео-адресса - Base+X*3+Y*960}
   shl     edi,2
   add     edi,eax
   mov     eax,[Color]   {И наконец выставление точки}
   mov     [edi+ebx],eax
@NoPlot:
 end;
End;

Procedure InitSalutNum(Num:Word);
 var X1,Y1,X,Y:Word;
Begin
 SalDown[Num]:=0;
 SalColor[Num]:=Random($FFFFFF);
 SalTimer[Num]:=Random(7000);
 X1:=Random(320);
 Y1:=Random(200);
 If Random(100)>95 then
  Begin
   SalColor[Num]:=$FFFF00;
   For Y:=1 to 40 do
    Begin
     Salut[Num,Y].X:=X1;
     Salut[Num,Y].Y:=Y1;
     Salut[Num,Y].NX:=Random(255);
     Salut[Num,Y].NX:=Random(255);
    End;
  End
 else
  Begin
   For Y:=1 to 40 do
    Begin
     Salut[Num,Y].X:=X1;
     Salut[Num,Y].Y:=Y1;
     Salut[Num,Y].NX:=Random(100);
     Salut[Num,Y].NY:=Random(100);
    End;
   End;
End;

Procedure InitSalut;
 var X:Word;
Begin
 RandomiZe;
 For X:=1 to 10 do InitSalutNum(X);
End;

Procedure GetSalut;
 var I,J,X,Y:Word;
Begin
 For J:=1 to 10 do
  For I:=1 to 40 do
   Begin
    SalDown[J]:=SalDown[J]+0.0002;
    SalTimer[J]:=SalTimer[J]+1;
    If SalTimer[J]>15000 then InitSalutNum(J);
    Salut[J,I].X:=Salut[J,I].X+(Salut[J,I].NX/100)-0.5;
    Salut[J,I].Y:=Salut[J,I].Y+(Salut[J,I].NY/100)-1+Sqrt(SalDown[J]);
    Plot(round(Salut[J,I].X),round(Salut[J,I].Y),SalColor[J]);
    Plot(round(Salut[J,I].X+1),round(Salut[J,I].Y),SalColor[J]);
   End;
End;

{######################### Инициализация мыши ###############################}
Procedure InitMouse;
Begin
 asm
   mov   ax,0
   int   33h
   mov   ax,4
   xor   cx,cx
   xor   dx,dx
   int   33h
 end;
End;

{######################## Датчик движения мыши ##############################}
Function MouseMove:Boolean;
var Q:Word;
Begin
 asm
   mov   ax,3
   int   33h
   or    bx,cx
   or    bx,dx
   mov   [Q],bx
 end;
 If Q<>0 then MouseMove:=True else MouseMove:=False;
End;

Begin
 {Инициалтзация 320x200x24}
 mVESAInit;If VesaError<>0 then mVesaErrorMessage;
 Mode:=mPutVesaMode(320,200,32);If Mode=0 then mVesaErrorMessage;
 mSetVESAMode(Mode);If VesaError<>0 then mVesaErrorMessage;
 mSetVMemory;If VesaError<>0 then mVesaErrorMessage;
 For X:=1 to 256000 do Scr[X]:=0;
 InitSalut;
 InitMouse;
 Repeat
  PrintBuf;
  GetSalut;
  Blur;
 Until KeyPressed or MouseMove;
 mSetVGAMode;
 WriteLn('¦ Coded by Mikhail Krivyy  1997');
 WriteLn('  http://mikhail.krivyy.com/feedback/');
End.
