{- 4INT ------------------------------------------ It's interesting -
 Msg  : 21 of 110                    Addr                        Date
 From : Victor Shantar      2:5054/26                        07.05.97
 Subj : Flame
---------------------------------------------------------------------
-=Ё> Привет тебе DENnIS. <Ё=-

 Однажды (03 May 97) DENnIS PR0nin писал(а) к All, а я вмешался:

 Dn>     Hужно исходник:
 Dn>                    Полыхающего пламени с пояснениями алгоpитма!
 Dn>     Плиз Хелп! Hу очень тpеба!

 Вот тебе огонечек

                 

Покедова...
-=Ё> Пишите письма. Они дойдут ( в обоих смыслах ;) <Ё=-

... [ HEDGEHOG HOUSE ] +7-3422-622044,PERM  [ Team Daemon's Hedgehog ]
--- Work Time 01:00-07:00 Local. Freq ONLY      [ Team Coca-Cola ]
 * Origin: ~Для кого ночь, а для кого - темное время суток.~ (2:5054/26)

{> Cut here. FileName= FLAME3.PAS }
{ Огонек }
uses crt;

var ftable : array [1..30,1..60] of byte; { Массив области с огонечком }
    x,y,i : word; { Координаты и просто переменная для циклов }
    v:integer; { переменная для инициализации графики }

{ Установка цветов }
procedure SetPalette;
var N : Integer;

procedure SetRGBColor(color,r,g,b: Byte); Assembler;
 asm
  mov dx,3C8h
  mov al,color
  out dx,al
  inc dx
  mov al,r
  out dx,al
  mov al,g
  out dx,al
  mov al,b
  out dx,al
 end;


{ Функция вычисления цвета в зависимости от коэфициента X }
function f(x:real):integer;
begin
  if (x>=0) and (x<=1) then f:=round(63*x*(2-x));
  if x<0 then f:=0;
  if x>1.0 then f:=63;
end;

begin {SetPalette}
  for N := 1 to 100 do
    setrgbcolor(n,f(n/50),f(n/50-0.2),
                f(n/50-0.5)+f(0.1-n/50)*n div 7+5);
 { Установка цветовой палитры : SetRGBColor( num, Red, Green, Blue );
       где num - номер за которым сохранить этот цвет.
           Red - кол-во красного ( 0-63 )
         Green - кол-во зеленого ( 0-63 )
          Blue - кол-во синего   ( 0-63 )
     }
end;


begin
  asm mov ax,13h;  int 10h end; { Установка режима 320x200x256 }

setpalette; { Установка нашего набора цветов }

{ Обнуление массива с огоньком }
for x:=1 to 30 do for y:=1 to 60 do ftable[x,y]:=0;

repeat

{ Рисование исходной линии ( самой нижней ) }
for x:=10 to 20 do if random(100)<50 then ftable[x,60]:=100 else
ftable[x,60]:=0;
{ За счет резкого случайного перепада цвета идет колебание огонька }

{ Изменение цвета точки, в зависимости от точек снизу и с боков }
for y:=1 to 59 do for x:=2 to 28 do
  { ахождение среднего цвета относительно 9-ти точек }
  ftable[x,y]:=(ftable[x-1, y ]+ftable[ x , y ]+ftable[x+1, y ]+
                ftable[x-1,y+1]+ftable[ x ,y+1]+ftable[x+1,y+1]+
                ftable[x-1,y+2]+ftable[ x ,y+2]+ftable[x+1,y+2]) div 9;

{ Вывод массива }
for y:=1 to 57 do for x:=1 to 30 do
  mem[$a000:x+144+(y+69)*320]:=ftable[x,y];

until keypressed;

  asm mov ax,3;  int 10h end;
end.