теги, поездки, контакты

mike

Салют

Комментариев:

Просто «салют». Программа писалась в прошлом веке :), на TMT Паскале, но не смотря на это эффект своей красоты не потерял.

Не работает по Windows NT/2000/XP, так как эти операционные системы блокируют
включение видеорежимов VESA.

Скачать в архиве (ZIP;22Kb)

salutss.pas

  1. program BLUR;
  2.  
  3. uses Crt,mVBE;
  4.  
  5. Type TSalut=Record
  6. X:Real;
  7. Y:Real;
  8. NX:Word;
  9. NY:Word;
  10. End;
  11.  
  12. var Scr :Array[0..256000] of Byte; {Виртуальный видео-буффер}
  13. F :File;
  14. RSize :DWord;
  15. Salut :Array[1..10,1..40] of TSalut;
  16. SalDown :Array[1..10] of Real;
  17. SalColor :Array[1..10] of DWord;
  18. SalTimer :Array[1..10] of Word;
  19. X :DWord;
  20. Exit :Boolean;
  21. Mode :Word;
  22.  
  23. Procedure PrintBuf; {Копирование виртуального видео-буфера в реальный}
  24. var I,S:Word;
  25. Begin
  26. asm
  27. cld
  28. lea esi,Scr;
  29. mov edi,[VBE_VideoMem]
  30. mov ecx,64000
  31. repe movsd
  32. end;
  33. End;
  34.  
  35. Procedure Blur; {Сам Блюр}
  36. var I:DWord;
  37. Begin
  38. asm
  39. lea edi,Scr
  40. add edi,1280
  41. mov ecx,253440
  42. xor ebx,ebx
  43. @1:
  44. xor eax,eax
  45. mov bl,[edi-4]
  46. add eax,ebx
  47. mov bl,[edi-1280]
  48. add eax,ebx
  49. mov bl,[edi+1280]
  50. add eax,ebx
  51. mov bl,[edi+4]
  52. add eax,ebx
  53.  
  54. shr eax,2
  55. mov [edi],al
  56. inc edi
  57. loop @1
  58. end;
  59. End;
  60.  
  61. Procedure Plot(X,Y,Color:DWord);
  62. var Addr:DWord;
  63. Begin
  64. asm
  65. lea ebx,Scr {ebx = адресс видео-буфера}
  66. mov edi,[X] {edi = X}
  67. cmp edi,1 {Проверка попадания в экран}
  68. jna @NoPlot
  69. cmp edi,318
  70. ja @NoPlot
  71. mov eax,[Y] {eax = Y}
  72. cmp eax,1 {Проверка попадания в экран}
  73. jna @NoPlot
  74. cmp eax,198
  75. ja @NoPlot
  76. imul eax,eax,1280 {Вычисление видео-адресса - Base+X*3+Y*960}
  77. shl edi,2
  78. add edi,eax
  79. mov eax,[Color] {И наконец выставление точки}
  80. mov [edi+ebx],eax
  81. @NoPlot:
  82. end;
  83. End;
  84.  
  85. Procedure InitSalutNum(Num:Word);
  86. var X1,Y1,X,Y:Word;
  87. Begin
  88. SalDown[Num]:=0;
  89. SalColor[Num]:=Random($FFFFFF);
  90. SalTimer[Num]:=Random(7000);
  91. X1:=Random(320);
  92. Y1:=Random(200);
  93. If Random(100)>95 then
  94. Begin
  95. SalColor[Num]:=$FFFF00;
  96. For Y:=1 to 40 do
  97. Begin
  98. Salut[Num,Y].X:=X1;
  99. Salut[Num,Y].Y:=Y1;
  100. Salut[Num,Y].NX:=Random(255);
  101. Salut[Num,Y].NX:=Random(255);
  102. End;
  103. End
  104. else
  105. Begin
  106. For Y:=1 to 40 do
  107. Begin
  108. Salut[Num,Y].X:=X1;
  109. Salut[Num,Y].Y:=Y1;
  110. Salut[Num,Y].NX:=Random(100);
  111. Salut[Num,Y].NY:=Random(100);
  112. End;
  113. End;
  114. End;
  115.  
  116. Procedure InitSalut;
  117. var X:Word;
  118. Begin
  119. RandomiZe;
  120. For X:=1 to 10 do InitSalutNum(X);
  121. End;
  122.  
  123. Procedure GetSalut;
  124. var I,J,X,Y:Word;
  125. Begin
  126. For J:=1 to 10 do
  127. For I:=1 to 40 do
  128. Begin
  129. SalDown[J]:=SalDown[J]+0.0002;
  130. SalTimer[J]:=SalTimer[J]+1;
  131. If SalTimer[J]>15000 then InitSalutNum(J);
  132. Salut[J,I].X:=Salut[J,I].X+(Salut[J,I].NX/100)-0.5;
  133. Salut[J,I].Y:=Salut[J,I].Y+(Salut[J,I].NY/100)-1+Sqrt(SalDown[J]);
  134. Plot(round(Salut[J,I].X),round(Salut[J,I].Y),SalColor[J]);
  135. Plot(round(Salut[J,I].X+1),round(Salut[J,I].Y),SalColor[J]);
  136. End;
  137. End;
  138.  
  139. {######################### Инициализация мыши ###############################}
  140. Procedure InitMouse;
  141. Begin
  142. asm
  143. mov ax,0
  144. int 33h
  145. mov ax,4
  146. xor cx,cx
  147. xor dx,dx
  148. int 33h
  149. end;
  150. End;
  151.  
  152. {######################## Датчик движения мыши ##############################}
  153. Function MouseMove:Boolean;
  154. var Q:Word;
  155. Begin
  156. asm
  157. mov ax,3
  158. int 33h
  159. or bx,cx
  160. or bx,dx
  161. mov [Q],bx
  162. end;
  163. If Q<>0 then MouseMove:=True else MouseMove:=False;
  164. End;
  165.  
  166. Begin
  167. {Инициалтзация 320x200x24}
  168. mVESAInit;If VesaError<>0 then mVesaErrorMessage;
  169. Mode:=mPutVesaMode(320,200,32);If Mode=0 then mVesaErrorMessage;
  170. mSetVESAMode(Mode);If VesaError<>0 then mVesaErrorMessage;
  171. mSetVMemory;If VesaError<>0 then mVesaErrorMessage;
  172. For X:=1 to 256000 do Scr[X]:=0;
  173. InitSalut;
  174. InitMouse;
  175. Repeat
  176. PrintBuf;
  177. GetSalut;
  178. Blur;
  179. Until KeyPressed or MouseMove;
  180. mSetVGAMode;
  181. WriteLn('¦ Coded by Mikhail Krivyy 1997');
  182. WriteLn(' http://mikhail.krivyy.com/feedback/');
  183. End.

Download this code: salutss.pas

mvbe.pas

  1. unit mVBE;
  2.  
  3. interface
  4.  
  5. uses DPMILib;
  6.  
  7. (* VBE info block structure *)
  8. type TVbeInfo = record
  9. VbeSignature : DWord;
  10. VbeVersion : Word;
  11. OemStringPtr : DWord;
  12. Capabilities : DWord;
  13. VideoModePtr : DWord;
  14. TotalMemory : Word;
  15. OEMSoftwareRev : Word;
  16. OEMVendorNamePtr : DWord;
  17. OEMProductNamePtr : DWord;
  18. OEMProductRevPtr : DWord;
  19. Reserved : array [0..221] of Byte;
  20. OEMData : array [0..255] of Byte;
  21. end;
  22.  
  23. TVbeModeInfo = record
  24. ModeAttributes : Word;
  25. WinAAttributes : Byte;
  26. WinBAttributes : Byte;
  27. WinGranularity : Word;
  28. WinSize : Word;
  29. WinASegment : Word;
  30. WinBSegment : Word;
  31. WinFuncPtr : Pointer;
  32. BytesPerScanLine : Word;
  33. XResolution : Word;
  34. YResolution : Word;
  35. XCharSize : Byte;
  36. YCharSize : Byte;
  37. NumberOfPlanes : Byte;
  38. BitsPerPixel : Byte;
  39. NumberOfBanks : Byte;
  40. MemoryModel : Byte;
  41. BankSize : Byte;
  42. NumberOfImagePages : Byte;
  43. Reserved : Byte;
  44. RedMaskSize : Byte;
  45. RedFieldPosition : Byte;
  46. GreenMaskSize : Byte;
  47. GreenFieldPosition : Byte;
  48. BlueMaskSize : Byte;
  49. BlueFieldPosition : Byte;
  50. RsvdMaskSize : Byte;
  51. RsvdFieldPosition : Byte;
  52. DirectColorModeInfo: Byte;
  53. PhysBasePtr : DWord;
  54. OffScreenMemOffset : DWord;
  55. OffScreenMemSize : Word;
  56. Reserved2 : Array [0..205] of Byte;
  57. end;
  58.  
  59. var VesaError :Byte;
  60. Regs :TRmRegs;
  61. VESAInfo :TVBEInfo;
  62. VESAModeInfo :TVBEModeInfo;
  63. VideoMem,VBE_VideoMem :DWord;
  64.  
  65. Procedure mVESAInit;
  66. Procedure mInitVESAMode(Mode:Word);
  67. Procedure mSetVESAMode(Mode:Word);
  68. Procedure mSetVGAMode;
  69. Function mPutVESAMode(X,Y,BPP:Word):Word;
  70. Procedure mVesaErrorMessage;
  71. Procedure mSetVMemory;
  72.  
  73. implementation
  74.  
  75. { Инициализация VESA }
  76. Procedure mVESAInit;
  77. Begin
  78. VesaError:=0;
  79. ClearRmRegs(Regs);
  80. Regs.AX:=$4F00;
  81. Regs.ES:=Buf_16;
  82. RealModeInt($10,Regs);
  83. Move(Pointer(Buf_32)^,VESAInfo,256);
  84. if (Regs.AX<>$004F) or (VESAInfo.VbeSignature<>$41534556) then VesaError=1;
  85. End;
  86.  
  87. { Инициализация графического режима VESA }
  88. Procedure mInitVESAMode(Mode:Word);
  89. Begin
  90. VesaError:=0;
  91. ClearRmRegs(Regs);
  92. Regs.ES:=Buf_16;
  93. Regs.ax:=$4F01;
  94. Regs.di:=$0000;
  95. Regs.cx:=Mode;
  96. RealModeInt($10,Regs);
  97. Move(Pointer(Buf_32)^,VESAModeInfo,256);
  98. if (Regs.AX<>$004F) or (VESAModeInfo.PhysBasePtr=0) then VESAError:=2;
  99. End;
  100.  
  101. { Установка графического режима VESA }
  102. Procedure mSetVESAMode(Mode:Word);
  103. Begin
  104. VesaError:=0;
  105. ClearRmRegs(Regs);
  106. Regs.AX:=$4F02;
  107. Regs.BX:=Mode;
  108. RealModeInt($10,Regs);
  109. if (Regs.AX<>$004F) then VESAError:=3;
  110. End;
  111.  
  112. { Установка стандартного режима EGA }
  113. Procedure mSetVGAMode;
  114. Begin
  115. ClearRmRegs(Regs);
  116. Regs.AX:=$0003;
  117. RealModeInt($10,Regs);
  118. End;
  119.  
  120. Function mPutVESAMode(X,Y,BPP:Word):Word;
  121. var M:Word;
  122. Begin
  123. For M:=$4100 to $4200 do
  124. Begin
  125. mInitVESAMode(M);
  126. If (VesaModeInfo.XResolution=X) and
  127. (VesaModeInfo.YResolution=Y) and
  128. (VesaModeInfo.BitsPerPixel=BPP) and
  129. (VesaError=0) then mPutVESAMode:=M;
  130. End;
  131. End;
  132.  
  133. { Вывод сообщения об ошибке }
  134. Procedure mVesaErrorMessage;
  135. Begin
  136. mSetVGAMode;
  137. WriteLn('VesaError:',VesaError);
  138. Halt(1);
  139. End;
  140.  
  141. { Узнаем логический адресс }
  142. Procedure mSetVMemory;
  143. var Tmp1,Tmp2 :Word;
  144. Begin
  145. Vbe_VideoMem:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,4096*1024);
  146. If Vbe_VideoMem=0 then VESAError=4;
  147. VideoMem:=Vbe_VideoMem;
  148. End;
  149. end.

Download this code: mvbe.pas

05.07.1999 в 02:32

Категории: Графика

«
»