Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:


Алгоритм пламени

Поиск:
Заведем два массива 1 и 2 - один массив будет содержать текущий кадр пламени,а во второй мы будем заносить результаты вычислений. Создадим палитру пламени от 250 до 100 это будет сплошной белый цвет - пламя в очаге. Далее белый, плавно проходя через желтый, перейдет в красный и черный. Эту палитру можете посмотреть если определен Debug.

В чем состоит основа алгоритма - для каждой точки из массива 1, мы делаем следующее : берем сумму всех окружающих ее точек и делим на их количество. Для хорошего качества точек берем 8. Что же получается? Если очаг пламени организовать внизу, т.е. внизу на каждом шаге случайно ставить точки с большим значением, усреденные суммы дадут нужное затухание. Т.к. мы ставим в очаге точки случайно , то появляются красивые языки.

Последовательность действий:

    * Массив 1 содержит текущий кадр пламени.
    * Создаем в массиве 1 внизу случайные очаги ( просто ставим точки)
    * Каждый элемент массива 2 получаем как усреденную сумму, соответствующих элементов окружающий данный в массиве 1
    * Массив 2 копируем на экран
    * Переносим массив 2 в массив 1
    * Переход на начало



Код

{.$DEFINE DEBUG}
Program Fire; 

Uses DemoVga,Crt; 

Type
   PFireMem = ^TFireMem; 
   TFireMem = Array[0..201,0..319] Of Byte; 
Var
   FireMem        : PFireMem; 
   I,J            : Integer; 
   R,G,B,dR,dG,dB : Real; 

Procedure PlotFireHead; 
Var
  I : Integer; 
Begin
For I := 0 To 319 Do
  If Random( 2) = 1 Then Begin
   FireMem^[ 199] [ I] := 255; 
   FireMem^[ 198] [ I] := 255; 
  End; 
End; 

Procedure FireLoop; Assembler; 
Asm
   Push    DS
   Les           DI,DBuffer
   Lds           SI,FireMem
   Add           SI,320*2
   Mov           CX,64000
@@F: 
   Xor           AX,AX
   Add           AL,[SI-321] 
   Adc           AH,0
   Add           AL,[SI-320] 
   Adc           AH,0
   Add           AL,[SI-319] 
   Adc           AH,0
   Add           AL,[SI-1] 
   Adc           AH,0
   Add           AL,[SI+1] 
   Adc           AH,0
   Add           AL,[SI+319] 
   Adc           AH,0
   Add           AL,[SI+320] 
   Adc           AH,0
   Add           AL,[SI+321] 
   Adc           AH,0
   Shr           AX,3
   Or           AL,AL
   Jz           @@1
   Dec           AL
@@1: 
   Stosb
   Inc           SI
   Loop    @@F
   Pop           DS
End; 

Begin
InitDemoPart; 
GetMem( FireMem, 65000); 
R := 0; G := 0; B := 0; 
dR := 0.63; dG := 0.91; dB := 1.5; 
For I := 1 To 100 Do Begin
  SetRGBColor( I, Round( R), Round( G), Round( B)); 
  R := R + dR; 
  If I > 30 Then G := G + dG; 
  If I > 60 Then B := B + dB; 
End; 
For I := 100 To 250 Do SetRGBColor( I, 60, 60, 60); 
{$IFDEF DEBUG}
For I := 1 To 100 Do
  For J := 1 To 100 Do
   Mem[$A000: J * 320 + I] := I; 
ReadKey; 
{$ENDIF}
FillChar( FireMem^, 65000, 0); 
Repeat
  PlotFireHead; 
  FireLoop; 
  Move( DBuffer^, FireMem^, 64000); 
  Move( DBuffer^, Ptr( $A000, 0)^, 64000-320*4); 
Until KeyPressed; 
ReadKey; 
FreeMem( FireMem, 65000); 
RestoreDemo; End; 




модуль demovga.pas:
Код

Unit DemoVga;

Interface

Const

  Name = 'DEMOVGA : Ѓ §®ўл© ¬®¤г«м ¤«п Ї®бв஥­Ёп ¤Ґ¬®Є ў 320x200x256!!!';

  Font8  = 3; 
  Font14 = 2; 
  Font16 = 6; 

Var
DBuffer,Origin : Pointer; 
MemStor : Pointer; 

Procedure InitDemoPart; 
Procedure RestoreDemo; 
Procedure SetRGBColor( C, R, G, B : Byte); 
Procedure ClearDBuffer; 
Procedure DBuff2Video;
Function GetFontPtr( Size : Byte) : Pointer; 

Implementation

Uses Crt;

Procedure InitDemoPart; 
Begin
Mark( MemStor); 
GetMem( DBuffer, 65500); 
Origin := DBuffer; 
Inc( LongInt( DBuffer), $10000); 
LongInt( DBuffer) := LongInt( DBuffer) And $FFFF0000; 
SegA000 := Seg( DBuffer^); 
ClearDBuffer; 
Asm
  Mov        AX,13h
  Int        10h
End; 
End;

Procedure RestoreDemo; 
Begin
FreeMem( Origin, 65500); 
Release( MemStor); 
Asm
  Mov        AX,3h
  Int        10h
End; 
End; 

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

Procedure ClearDBuffer;Assembler;
Asm
   Les         DI,DBuffer
   Db         $66; Xor   AX,AX
   Mov         CX,16200
   Db         $66; Rep   Stosw
End;

Procedure DBuff2Video;Assembler; 
Asm
   Push  DS
   Mov         DS,SEGA000
   Xor         SI,SI
   Mov         AX,0A000h
   Mov         ES,AX
   Xor         DI,DI
   Mov         CX,16001
   Db         $66; Rep   Movsw
   Pop         DS
End; 

Function GetFontPtr( Size : Byte) : Pointer; 
Var
  Font : Pointer; 
Begin
Asm
  Push         BP
  Mov         AX,1130h
  Mov         BH,Size
  Int         10h
  Mov         AX,BP
  Pop         BP
  Mov         Word Ptr [Font],AX
  Mov         Word Ptr [Font+2],ES
End; 
GetFontPtr := Font; 
End; 

Procedure RunDemoVga; Far; 
Var
  I : Integer;
Begin
InitDemoPart;

Repeat
  For I := 0 To 199 Do
   FillChar( Ptr( $A000, I * 320)^, 320 , I);
Until KeyPressed;

ReadKey;
RestoreDemo;
End;

Begin

End.


Сайт: www.codenet.ru






Просмотров: 3682

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную