Скачать Flame 3

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.