program Salut;

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.

unit mVBE;

interface

uses DPMILib;

 (* VBE info block structure *)
type  TVbeInfo = record
              VbeSignature       : DWord;
              VbeVersion         : Word;
              OemStringPtr       : DWord;
              Capabilities       : DWord;
              VideoModePtr       : DWord;
              TotalMemory        : Word;
              OEMSoftwareRev     : Word;
              OEMVendorNamePtr   : DWord;
              OEMProductNamePtr  : DWord;
              OEMProductRevPtr   : DWord;
              Reserved           : array [0..221] of Byte;
              OEMData            : array [0..255] of Byte;
      end;

      TVbeModeInfo = record
              ModeAttributes     : Word;
              WinAAttributes     : Byte;
              WinBAttributes     : Byte;
              WinGranularity     : Word;
              WinSize            : Word;
              WinASegment        : Word;
              WinBSegment        : Word;
              WinFuncPtr         : Pointer;
              BytesPerScanLine   : Word;
              XResolution        : Word;
              YResolution        : Word;
              XCharSize          : Byte;
              YCharSize          : Byte;
              NumberOfPlanes     : Byte;
              BitsPerPixel       : Byte;
              NumberOfBanks      : Byte;
              MemoryModel        : Byte;
              BankSize           : Byte;
              NumberOfImagePages : Byte;
              Reserved           : Byte;
              RedMaskSize        : Byte;
              RedFieldPosition   : Byte;
              GreenMaskSize      : Byte;
              GreenFieldPosition : Byte;
              BlueMaskSize       : Byte;
              BlueFieldPosition  : Byte;
              RsvdMaskSize       : Byte;
              RsvdFieldPosition  : Byte;
              DirectColorModeInfo: Byte;
              PhysBasePtr        : DWord;
              OffScreenMemOffset : DWord;
              OffScreenMemSize   : Word;
              Reserved2          : Array [0..205] of Byte;
         end;

var VesaError             :Byte;
    Regs                  :TRmRegs;
    VESAInfo              :TVBEInfo;
    VESAModeInfo          :TVBEModeInfo;
    VideoMem,VBE_VideoMem :DWord;

Procedure mVESAInit;
Procedure mInitVESAMode(Mode:Word);
Procedure mSetVESAMode(Mode:Word);
Procedure mSetVGAMode;
Function  mPutVESAMode(X,Y,BPP:Word):Word;
Procedure mVesaErrorMessage;
Procedure mSetVMemory;

implementation

{######################## Инициализация VESA ################################}
Procedure mVESAInit;
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.AX:=$4F00;
  Regs.ES:=Buf_16;
  RealModeInt($10,Regs);
  Move(Pointer(Buf_32)^,VESAInfo,256);
  if (Regs.AX<>$004F) or (VESAInfo.VbeSignature<>$41534556) then VesaError=1;
End;

{############## Инициализация графического режима VESA ######################}
Procedure mInitVESAMode(Mode:Word);
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.ES:=Buf_16;
  Regs.ax:=$4F01;
  Regs.di:=$0000;
  Regs.cx:=Mode;
  RealModeInt($10,Regs);
  Move(Pointer(Buf_32)^,VESAModeInfo,256);
  if (Regs.AX<>$004F) or (VESAModeInfo.PhysBasePtr=0) then VESAError:=2;
End;

{################# Установка графического режима VESA #######################}
Procedure mSetVESAMode(Mode:Word);
Begin
  VesaError:=0;
  ClearRmRegs(Regs);
  Regs.AX:=$4F02;
  Regs.BX:=Mode;
  RealModeInt($10,Regs);
  if (Regs.AX<>$004F) then VESAError:=3;
End;

{################# Установка стандартного режима EGA ########################}
Procedure mSetVGAMode;
Begin
  ClearRmRegs(Regs);
  Regs.AX:=$0003;
  RealModeInt($10,Regs);
End;

Function  mPutVESAMode(X,Y,BPP:Word):Word;
 var M:Word;
Begin
 For M:=$4100 to $4200 do
  Begin
   mInitVESAMode(M);
    If (VesaModeInfo.XResolution=X) and
       (VesaModeInfo.YResolution=Y) and
       (VesaModeInfo.BitsPerPixel=BPP) and
       (VesaError=0) then mPutVESAMode:=M;
  End;
End;

{##################### Вывод сообщения об ошибке ############################}
Procedure mVesaErrorMessage;
Begin
  mSetVGAMode;
  WriteLn('VesaError:',VesaError);
  Halt(1);
End;

{###################### Узнаем логический адресс ############################}
Procedure mSetVMemory;
var Tmp1,Tmp2   :Word;
Begin
  Vbe_VideoMem:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,4096*1024);
  If Vbe_VideoMem=0 then VESAError=4;
  VideoMem:=Vbe_VideoMem;
End;
{############################################################################}
end.