program fire;
uses graphx,crt;
const
  zhaseni1 = 1;
type
  tvirt= array [1..65280] of byte;
  {jestli se divite proc pole neni dlouhe 64000 (320x200) tak vezte
  ze zde mame k dobru 4 radky proto 320x204 = 65280}

var
  pvirt:^tvirt;
  vaddr:word;
  save:tpal;
  soub:file of tpal;
  mezi:byte;
  font:pointer;


procedure fire1;
var
  i,j:integer;
  temp:tpal;
  hlp:word;

begin
  read(soub, temp);
  close(soub);
  fillchar(mem[vaddr:0],sizeof(pvirt^),0);  {vycisteni pomocneho pole}
  setVGApal(temp);
  repeat
    hlp:=203*320;       {takto se dostaneme na posledni radek pole}
    for i:=0 to 319 do  {umistime nejake "zarodecne" pixely}
      begin             {proto se plamen mihota}
        mem[vaddr:i+hlp]:=random(2)*255;
        mem[vaddr:i+hlp-320]:=random(2)*255;
        mem[vaddr:i+hlp-640]:=random(2)*255;
      end;
    for j:=1 to 201 do
     for i:=0 to 319 do
      begin
       mezi:=(mem[vaddr:i+(j+2)*320-1]+
              mem[vaddr:i+(j+1)*320-1]+
              mem[vaddr:i+(j+2)*320+1]+
              mem[vaddr:i+(j+1)*320+1]+
              mem[vaddr:i+(j+2)*320] )div 5;

       if mezi < zhaseni1 then mezi:=0
        else mezi:= mezi-zhaseni1;

       mem[vaddr:(j-1)*320+i]:=mezi;
      end;
    waitretrace;
    flip(vaddr,VGA);
  until keypressed;
  readkey;
end;


procedure fire2;
var
  i,j:integer;
  temp:tpal;
  hlp:word;

begin
  read(soub, temp);
  close(soub);
  fillchar(mem[vaddr:0],sizeof(pvirt^),0);  {vycisteni pomocneho pole}
  setVGApal(temp);
  repeat
    hlp:=203*320;       {takto se dostaneme na posledni radek pole}
    for i:=0 to 319 do  {umistime nejake "zarodecne" pixely}
      begin             {proto se plamen mihota}
        mem[vaddr:i+hlp]:=random(2)*255;
        mem[vaddr:i+hlp-320]:=random(2)*255;
        mem[vaddr:i+hlp-640]:=random(2)*255;
      end;
    for j:=1 to 201 do
     for i:=0 to 319 do
      begin
       mezi:=(mem[vaddr:i+(j+2)*320-1]+
              mem[vaddr:i+(j+1)*320-1]+
              mem[vaddr:i+(j+2)*320+1]+
              mem[vaddr:i+(j+1)*320+1]+
              mem[vaddr:i+(j+2)*320] )div 5;

       if mezi < zhaseni1 then mezi:=0
        else mezi:= mezi-zhaseni1;

       mem[vaddr:(j-1)*320+i]:=mezi;
      end;
    waitretrace;
    flip(vaddr,VGA);
  until keypressed;
  readkey;
end;


procedure fire3;
var
  i,j:integer;
  temp:tpal;
  hlp:word;

begin
  read(soub, temp);
  close(soub);
  fillchar(mem[vaddr:0],sizeof(pvirt^),0);  {vycisteni pomocneho pole}
  setVGApal(temp);
  repeat
    hlp:=203*320;       {takto se dostaneme na posledni radek pole}
    for i:=0 to 319 do   {umistime nejake "zarodecne" pixely}
      begin
        mem[vaddr:i+hlp]:=random(2)*255;
        mem[vaddr:i+hlp-320]:=random(2)*255;
      end;
    for j:=1 to 201 do   {vlastni vypocet}
     for i:=0 to 319 do
      begin
       mezi:=(mem[vaddr:i+(j+1)*320]+
              mem[vaddr:i+(j+2)*320] )div 2;

       if mezi < zhaseni1 then mezi:=0
        else mezi:= mezi-zhaseni1;

       mem[vaddr:(j-1)*320+i]:=mezi;
      end;
    waitretrace;
    flip(vaddr,VGA);
  until keypressed;
  readkey;
end;


procedure efekt1;
var
  i,j:integer;
  temp:tpal;
  hlp:word;

begin
  read(soub, temp);
  close(soub);
  fillchar(mem[vaddr:0],sizeof(pvirt^),0);  {vycisteni pomocneho pole}
  setVGApal(temp);
  repeat
    for j:=1 to 201 do   {vlastni vypocet}
     for i:=0 to 319 do
      begin
       mezi:=(mem[vaddr:i+(j+1)*320]+
              mem[vaddr:i+(j+2)*320] )div 2;

       if mezi < zhaseni1 then mezi:=0
        else mezi:= mezi-zhaseni1;
       mem[vaddr:j*320+i]:=mezi;
       mem[vaddr:(j-1)*320+i]:=mezi;
      end;
    xytextB(font,random(250),180,255,chr(random(100)+40)+#0,vaddr);
    waitretrace;
    flip(vaddr,VGA);
  until keypressed;
  readkey;
end;

procedure efekt2;
var
  i,j:integer;
  temp:tpal;
  hlp:word;

begin
  read(soub, temp);
  close(soub);
  fillchar(mem[vaddr:0],sizeof(pvirt^),0);  {vycisteni pomocneho pole}
  setVGApal(temp);
  repeat
    for j:=0 to 201 do
     for i:=0 to 319 do
      begin
       mezi:=(mem[vaddr:i+(j+2)*320-1]+
              mem[vaddr:i+(j+1)*320-1]+
              mem[vaddr:i+(j+2)*320+1]+
              mem[vaddr:i+(j+1)*320+1]+
              mem[vaddr:i+(j+2)*320] )div 5;
       mem[vaddr:(j)*320+i]:=mezi;
      end;
    xytextB(font,random(250)+10,random(180),255,'BUM!'+#0,vaddr);
    waitretrace;
    flip(vaddr,VGA);
  until keypressed;
  readkey;
end;

begin
  clrscr;
  writeln('DEMONSTRACNI PROGRAM PRO EFEKT OHNE');
  writeln('Domovska stranka: www.webpark.cz/prog-pascal/');
  writeln;
  writeln('Tento program by mel slouzit jenom jako ukazka. Tvorivosti');
  writeln('se meze nekladou. Muzete menit paletu, pixely ze ketrych se');
  writeln('pocita prumerna hodnota, zhaseci konstantu atd.');
  writeln('Pokud nevite jak vytvorit svou paletu kouknete se na mou');
  writeln('homepage, jiste tam naleznete neco s cim ji vytvorite');
  writeln('Uvidite nekolik efektu, pracujicich na stejnem primcipu');
  writeln;writeln;writeln;
  writeln('Stiskni ENTR...');
  readkey;

  randomize;                    {zapneme si nahodny cisla}
  getmem(pvirt,sizeof(tvirt));  {zabereme kus pameti pro virtualni obrazovku}
  vaddr:=seg(pvirt^);           {zjistime si segment a ulozime ve vaddr}
  font:=BIOSfont;               {ukazatel na font BIOSU - z unity GRAPHIX}
  setVGA;                       {inicializace modu 13h}
  getVGApal(save);              {ulozeni puvodni palety}


  cls(0,VGA);
  setVGApal(save);
  xytextB(font,0,0,15,'Efekt OHNE cislo 1'+#0,VGA);
  delay(1000);
  assign(soub,'f1.pal');
  {$I-}
    reset(soub);
  {$I+}
  if IOresult = 0 then fire1
   else
     begin
       xytextB(font,0,100,15,'!!NENASEL JSEM SOUBOR F1.PAL!!'+#0,VGA);
       delay(3000);
     end;

  cls(0,VGA);
  setVGApal(save);
  xytextB(font,0,0,15,'Efekt OHNE cislo 2 -'+#0,VGA);
  xytextB(font,0,10,15,'pouze jina paleta'+#0,VGA);
  delay(2000);
  assign(soub,'f2.pal');
  {$I-}
    reset(soub);
  {$I+}
  if IOresult = 0 then fire2
   else
     begin
       xytextB(font,0,100,15,'!!NENASEL JSEM SOUBOR F2.PAL!!'+#0,VGA);
       delay(3000);
     end;

  cls(0,VGA);
  setVGApal(save);
  xytextB(font,0,0,15,'Efekt OHNE cislo 3'+#0,VGA);
  delay(1000);
  assign(soub,'f1.pal');
  {$I-}
    reset(soub);
  {$I+}
  if IOresult = 0 then fire3
   else
     begin
       xytextB(font,0,100,15,'!!NENASEL JSEM SOUBOR F1.PAL!!'+#0,VGA);
       delay(3000);
     end;


  cls(0,VGA);
  setVGApal(save);
  xytextB(font,0,0,15,'JINY EFEKT'+#0,VGA);
  delay(1000);
  assign(soub,'f1.pal');
  {$I-}
    reset(soub);
  {$I+}
  if IOresult = 0 then efekt1
   else
     begin
       xytextB(font,0,100,15,'!!NENASEL JSEM SOUBOR F1.PAL!!'+#0,VGA);
       delay(3000);
     end;

  cls(0,VGA);
  setVGApal(save);
  xytextB(font,0,0,15,'''VYBUCH'''+#0,VGA);
  delay(1000);
  assign(soub,'f1.pal');
  {$I-}
    reset(soub);
  {$I+}
  if IOresult = 0 then efekt2
   else
     begin
       xytextB(font,0,100,15,'!!NENASEL JSEM SOUBOR F1.PAL!!'+#0,VGA);
       delay(3000);
     end;

  setVGApal(save);              {obnoveni puvodni palety}
  setText;                      {nastaveni textoveho modu}
  freemem(pvirt,sizeof(tvirt)); {uvolneni palety}
end.