Основы программирования

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.