Simulace hořícího ohně

Kategórie: KMP (Programy mladých programátorů)
Autor: Aleš Kucik
web: www.webpark.cz/prog-pascal

Program: Fire.pas, Graphx.pas
Potřebné: F1.pal, F2.pal
Demonštrační program pro efekt ohne
Tento program by měl sloužit jenom jako ukázka. Tvorivosti se meze nekladou. Mužete měnit paletu, pixely ze kterých se počíta pruměrná hodnota, zhášecí konstantu atd. Pokud nevíte jak vytvořit svou paletu kouknete sem makepal.pas. Uvidíte několik efektu, pracujícich na stejnem princípu.
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.
Simulace hořícího ohně

Navigační menu

Osobní nástroje

Hledat

Pascal programy

Pascal Wiki

Bonus

Kontakty

V jiných jazycích
