Differences

This shows you the differences between two versions of the page.

Link to this comparison view

fi:tietotekniikka:biolife:lahdekoodi [2020-05-09 16:13] (current)
Line 1: Line 1:
 +====== Biolife-elämäsimulaattorin lähdekoodi ======
 +
 +[[.:​start|Lue lisää Biolife-elämäsimulaattorista]].
 +
 +<​code>​
 +{Biolife -ohjelman lähdekielinen koodi (Turbo Pascal 5.5).}
 +{Ohjelmoinut Heikki Siltala 1994 The Game of Life -pelin pohjalta.}
 +
 +program BIOLIFE;
 +
 +uses
 +  crt;
 +    {Ohjelma käyttää Crt -modulia kuvaruudun ohjaukseen.}
 +
 +type
 +  param=array [1..10] of byte;
 +  field=array [2..56,​4..21] of byte;
 +    {Määrittelee pelikenttätaulukon mallin.}
 +  suku=integer;​
 +
 +const
 +  ukko='​@';​
 +    {Pelinappulan merkki määritetään tässä.}
 +  xmax=56;
 +  xmin=2;
 +  ymax=21;
 +  ymin=4;
 +    {Pelikentän rajat asetetaan tässä.}
 +
 +var
 +  loppu:​boolean;​
 +    {Kun loppu=true ohjelman suoritus loppuu.}
 +  key:char;
 +    {Tätä käytetään jatkuvasti luettaessa näppäimistöä.}
 +  spolvi:​suku;​
 +    {Sukupolven järjestysluku.}
 +  pstore:file of suku;
 +  lahde:​field;​
 +  sailo:​field;​
 +  kohde:​field;​
 +  kstore:file of field;
 +    {Pelikentän sisältävät taulukot.}
 +  toiminto:​shortint;​
 +    {Tässä muuttujassa oleva arvo ilmoittaa aktiivisen}
 +    {valikkopalkin numeron. ​                          }
 +  asetukset:​param;​
 +  astore:file of param;
 +    {Näissä muuttujissa säilytetään kehityslaskennan raja-arvoja,​}
 +    {silmukan viiveen pituutta ja tietoja laitojen yhdistämisestä.}
 +  silmu:​boolean;​
 +    {Kun silmu=true ollaan silmukka -tilassa.}
 +  pelattu:​boolean;​
 +    {Tämän ollessa true on peliä pelattu ja poistuttaessa tilanne}
 +    {tallennetaan. Jos peli käynnistetään mutta mitään ei tehdä ​ }
 +    {vanha pelitilanne säilyy levyllä. ​                          }
 +
 +
 +  procedure ODOTA;
 +    {Tätä käytetään kun jäädään odottamaan näppäimen painamista.}
 +  begin
 +    repeat
 +    until keypressed;
 +    key:​=readkey;​
 +  end;
 +
 +
 +  procedure ASETA_MUUTTUJAT;​
 +    {Pelin alussa tämä asettaa muuttujat oletusarvoihinsa.}
 +  var
 +    x,y:byte;
 +  begin
 +    spolvi:=0;
 +      {Sukupolvilaskuri nollaan}
 +    loppu:​=false;​
 +    for x:=xmin to xmax do
 +    for y:=ymin to ymax do
 +    begin
 +      lahde[x,​y]:​=1;​
 +      kohde[x,​y]:​=1;​
 +      sailo[x,​y]:​=1;​
 +    end;
 +      {Pelikenttätaulukoiden nollaus.}
 +    toiminto:​=1;​
 +      {Pelin alussa oletusvalikkopalkki on "Uusi sukupolvi"​.}
 +    silmu:​=false;​
 +    pelattu:​=false;​
 +  end;
 +
 +
 +  procedure ASETA_ASETUKSET;​
 +    {Ohjelman alussa asetetaan asetukset oletusarvoihinsa.}
 +  begin
 +    asetukset[1]:​=9;​
 +    asetukset[2]:​=14;​
 +    asetukset[3]:​=18;​
 +    asetukset[4]:​=22;​
 +      {Asetetaan kehityksen indeksirajat.}
 +    asetukset[5]:​=0;​
 +      {Asetetaan viive silmukkaan.}
 +    asetukset[6]:​=0;​
 +    asetukset[7]:​=0;​
 +      {Kaksi muuttujaa varattu laajentamiseen.}
 +    asetukset[8]:​=0;​
 +      {Otetaanko solun oma elämä huomioon?}
 +    asetukset[9]:​=1;​
 +    asetukset[10]:​=1;​
 +      {Oletuksena on että vasen-oikea- ja ylä-ala-reunayhdistys}
 +      {ovat voimassa. ​                                         }
 +  end;
 +
 +
 +  function ASTE(n:​shortint):​byte;​
 +    {Piirrettäessä kuvaruutua kutsutaan tätä funktiota kun tarvitaan}
 +    {solun kehitysastetta vastaava piirtoväri 0 - 15.}
 +  begin
 +    case n of
 +      1:ASTE:=1;
 +      2:ASTE:=8;
 +      3:ASTE:=7;
 +      4:ASTE:=15;
 +      5:ASTE:=11;
 +    end;
 +  end;
 +
 +
 +  procedure STATUS(n:​shortint);​
 +    {Tätä aliohjelmaa kutsutaan kun halutaan tulostaa kuvaruudun}
 +    {alalaitaan ohjelman toimintatilasta kertova teksti. ​       }
 +
 +    function ST(n:​shortint):​string;​
 +    begin
 +      case n of
 +        1:​ST:​='​Valikko ​                          ';​
 +        2:​ST:​=' ​                                 ';
 +        4:​ST:​='​Silmukka,​ paina jotain... ​        ';​
 +        5:​ST:​='​Editori ​                          ';​
 +        6:​ST:​='​Generoin... ​                      ';​
 +        8:​ST:​='​Lataan... ​                        ';​
 +      end;
 +    end;
 +
 +  begin
 +    textbackground(0);​
 +    textcolor(14);​
 +    gotoxy(25,​24);​
 +    write(ST(n));​
 +  end;
 +
 +
 +  procedure SUKUPOLVI;
 +    {Tämä aliohjelma tulostaa kuvaruudun alalaitaan sukupolvilaskurin}
 +    {arvon. Tarvittaessa lisätään nollia luvun eteen.}
 +  begin
 +    textbackground(8);​
 +    textcolor(15);​
 +    gotoxy(12,​24);​
 +    if spolvi>​9999 then spolvi:=0;
 +    if spolvi<​1000 then write('​0'​);​
 +    if spolvi<​100 then write('​0'​);​
 +    if spolvi<​10 then write('​0'​);​
 +    write(spolvi);​
 +  end;
 +
 +
 +  procedure PALKKI(n,​s:​shortint);​
 +    {Tämä aliohjelma tulostaa parametrin n määräämän valikkopalkin}
 +    {parametrin s määrätessä sen värin.}
 +  const
 +    x=60;
 +  var
 +    y:integer;
 +
 +    function PT(n:​shortint):​string;​
 +    begin
 +      case n of
 +        1:​PT:​='​ Uusi sukupolvi ';
 +        2:​PT:​='​ Silmukka ​      ';​
 +        3:​PT:​='​ Rajat          ';
 +        4:​PT:​='​ Viive          ';
 +        5:​PT:​='​ Valinnat ​      ';​
 +        6:​PT:​='​ Editori ​       ';
 +        7:​PT:​='​ Generaattori ​  ';​
 +        8:​PT:​='​ Palauta ​       ';
 +        9:​PT:​='​ Lataa          ';
 +        10:​PT:​='​ Apua!!! ​       ';
 +        11:​PT:​='​ Lopetus ​       ';
 +      end;
 +    end;
 +
 +  begin
 +    if s=0 then textbackground(1);​
 +    if s=1 then textbackground(6);​
 +      {Tässä valitaan palkin taustan piirtoväri s -parametrin mukaan.}
 +    textcolor(15);​
 +    y:=1+(n*2);
 +    gotoxy(x,​y);​
 +    write(PT(n));​
 +  end;
 +
 +
 +  procedure PALKKIEN_ALUE;​
 +    {Tämä aliohjelma tyhjää valikkopalkkien tausta-alueen.}
 +  var
 +    loop:​shortint;​
 +  begin
 +    for loop:=1 to 25 do
 +    begin
 +      textbackground(0);​
 +      gotoxy(60,​loop);​
 +      write(' ​                  '​);​
 +    end;
 +  end;
 +
 +
 +  procedure KAIKKI_PALKIT;​
 +    {Tämä aliohjelma tulostaa kaikki valikkopalkit puhtaalle taustalle.}
 +  var
 +    loop:​shortint;​
 +  begin
 +    PALKKIEN_ALUE;​
 +    for loop:=1 to 11 do
 +      PALKKI(loop,​0);​
 +  end;
 +
 +
 +  procedure PIIRRA_KUVARUUTU;​
 +    {Tämä aliohjelma tulostaa koko kuvaruudun pelin alussa ja palattaessa}
 +    {Apua!!! -toiminnosta. ​                                              }
 +
 +    procedure PIIRRA_KEHYKSET;​
 +    var
 +      x,​y:​integer;​
 +
 +      procedure PIIRRA_MERKKI(x,​y:​integer);​
 +      begin
 +        gotoxy(x,​y);​
 +        write('​±'​);​
 +      end;
 +
 +    begin
 +      textbackground(0);​
 +      textcolor(7);​
 +      y:=ymin-1;
 +      for x:=xmin-1 to xmax+1 do
 +        PIIRRA_MERKKI(x,​y);​
 +      x:=xmax+1;
 +      for y:=ymin-1 to ymax+1 do
 +        PIIRRA_MERKKI(x,​y);​
 +      y:=ymax+1;
 +      for x:=xmax+1 downto xmin-1 do
 +        PIIRRA_MERKKI(x,​y);​
 +      x:=xmin-1;
 +      for y:=ymax+1 downto ymin-1 do
 +        PIIRRA_MERKKI(x,​y);​
 +    end;
 +
 +    procedure TAYTA_PELIALUE;​
 +      {Tämä aliohjelma täyttää pelialueen tyhjä -merkeillä.}
 +    var
 +      x,​y:​integer;​
 +    begin
 +      textbackground(aste(1));​
 +      textcolor(aste(1));​
 +      for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +      begin
 +        gotoxy(x,​y);​
 +        write('​ ');
 +      end;
 +    end;
 +
 +    procedure PIIRRA_ESIMERKIT;​
 +      {Tämä aliohjelma piirtää soluesimerkit alalaitaan.}
 +    var
 +      loop:​integer;​
 +    begin
 +      textbackground(aste(1));​
 +      gotoxy(1,​24);​
 +      for loop:=1 to 5 do
 +      begin
 +        textcolor(ASTE(loop));​
 +        write(ukko);​
 +      end;
 +      textbackground(0);​
 +      textcolor(15);​
 +      gotoxy(1,​25);​
 +      write('​12345'​);​
 +    end;
 +
 +  begin
 +    textbackground(0);​
 +    textcolor(14);​
 +    clrscr;
 +    write('​BIOLIFE ');
 +    textcolor(15);​
 +    write('​-elämäsimulaattori ');
 +    textcolor(3);​
 +    write(' ​     Heikki Siltala 1994'​);​
 +    PIIRRA_KEHYKSET;​
 +    TAYTA_PELIALUE;​
 +    PIIRRA_ESIMERKIT;​
 +  end;
 +
 +
 +  procedure WR(teksti:​string);​
 +    {Tätä aliohjelmaa käytetään tulostettaessa tekstiä pelikentän ​  }
 +    {vasemmalle puolelle kapeaan alueeseen. Tulostettava teksti tuo-}
 +    {daan sisään teksti -parametrissa. ​                             }
 +
 +    procedure CR;
 +      {Tämä suorittaa rivinvaihdon.}
 +    begin
 +      gotoxy(60,​wherey+1);​
 +    end;
 +
 +  begin
 +    write(teksti);​
 +    CR;
 +  end;
 +
 +
 +  procedure LOPETA;
 +    {Tämä aliohjelma varmistaa pelistä poistumisen,​ tallettaa peli-}
 +    {tilanteen ja tulostaa lopputekstit. ​                          }
 +  begin
 +    PALKKIEN_ALUE;​
 +    gotoxy(60,​3);​
 +    textbackground(4);​
 +    textcolor(142);​
 +    WR('​LOPETETAANKO ???');
 +    textcolor(14);​
 +    WR(' ​               ');
 +    WR('<​ESC>​ LOPETTAA ​ ');
 +    WR(' ​               ');
 +    WR('​MUUT NÄPPÄIMET ​ ');
 +    WR('​PERUVAT ​        '​);​
 +    ODOTA;
 +    if ord(key)=27 then
 +      {Jos on painettu ESC...}
 +    begin
 +      loppu:​=true;​
 +      textbackground(0);​
 +      textcolor(15);​
 +      clrscr;
 +      if pelattu then
 +        {Jos peliä on todella pelattu tilanne talletetaan.}
 +      begin
 +        assign(astore,'​biosave.cnf'​);​
 +          {Asetukset.}
 +        assign(kstore,'​biosave.fld'​);​
 +          {Pelikenttä.}
 +        assign(pstore,'​biosave.gnr'​);​
 +          {Sukupolvilaskurin arvo.}
 +        rewrite(astore);​
 +        rewrite(kstore);​
 +        rewrite(pstore);​
 +        write(astore,​asetukset);​
 +        write(kstore,​kohde);​
 +        write(pstore,​spolvi);​
 +        close(astore);​
 +        close(kstore);​
 +        close(pstore);​
 +        highvideo;
 +      end;
 +      writeln;
 +      writeln('​Tämä oli Biolife, elämää simuloiva peli.'​);​
 +      writeln;
 +      writeln('​Ohjelmoinut Heikki Siltala 1994.'​);​
 +      lowvideo;
 +      writeln;
 +      writeln('​Kiitokset Biolife -pelin kantaisän,'​);​
 +      writeln('​The Game Of Life -pelin kehittäjälle.'​);​
 +      writeln;
 +      writeln('​Lisäohjeita ja tietoja tästä pelistä'​);​
 +      writeln('​saat lukemalla BIOINFO.TXT -tiedoston.'​);​
 +    end;
 +    if ord(key)<>​27 then
 +      {Jos ei ole haluttu lopettaa...}
 +    begin
 +      KAIKKI_PALKIT;​
 +      PALKKI(toiminto,​1);​
 +    end;
 +  end;
 +
 +
 +  procedure TEE;
 +    {Tämä proseduuri on koko ohjelman sydän. Tämän alla tapahtuu}
 +    {melkein kaikki varsinainen pelitoiminta. ​                  }
 +
 +    procedure TULOSTA_KENTTA;​
 +      {Tämä proseduuri tulostaa pelinappulat.}
 +    var
 +      x,y:byte;
 +    begin
 +      textbackground(1);​
 +       for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +      begin
 +        gotoxy(x,​y);​
 +        textcolor(ASTE(kohde[x,​y]));​
 +          {ASTE -funktion avulla saadaan solun piirtoväri.}
 +        write(ukko);​
 +      end;
 +    end;
 +
 +    procedure UUSI_SUKUPOLVI;​
 +      {Tämä on koko ohjelman monimutkaisin proseduuri.}
 +      {Tässä lasketaan uusi solusukupolvi. ​           }
 +    var
 +      x,y:byte;
 +
 +      function INDEKSI(x,​y:​byte):​byte;​
 +        {Tämä funktio palauttaa solun ympäristön elämän summan.}
 +      var
 +        i:byte;
 +          {Apumuuttuja joka edustaa huonoa ohjelmointityyliä.}
 +        xt,​yt,​xl,​yl:​byte;​
 +        skip:​boolean;​
 +
 +        function XX(x:​byte):​byte;​
 +          {Tämä funktio palauttaa x:n arvon. Jos reunat on yhdistetty,​}
 +          {yli ja ali menevä arvo siirtyy toiselle puolelle. Jos reu- }
 +          {noja ei ole yhdistetty, skip saa arvon true ja ko. kentän ​ }
 +          {paikkaa ei oteta huomioon indeksissä. ​                     }
 +        begin
 +          XX:=x;
 +          if x<xmin then
 +          begin
 +            case asetukset[9] of
 +              1:XX:=xmax;
 +              0:​skip:​=true;​
 +            end;
 +          end;
 +          if x>xmax then
 +          begin
 +            case asetukset[9] of
 +              1:XX:=xmin;
 +              0:​skip:​=true;​
 +            end;
 +          end;
 +        end;
 +
 +        function YY(y:​byte):​byte;​
 +          {Katso XX!}
 +        begin
 +          YY:=y;
 +          if y<ymin then
 +          begin
 +            case asetukset[10] of
 +              1:YY:=ymax;
 +              0:​skip:​=true;​
 +            end;
 +          end;
 +          if y>ymax then
 +          begin
 +            case asetukset[10] of
 +              1:YY:=ymin;
 +              0:​skip:​=true;​
 +            end;
 +          end;
 +        end;
 +
 +        procedure ALAS;
 +          {Jos elämä vähenee, käytetään tätä aliohjelmaa,​ muulloin}
 +          {jotain alapuolella olevista proseduureista...}
 +        begin
 +          i:​=lahde[x,​y]-1;​
 +          skip:=true;
 +        end;
 +
 +         ​procedure NOPE;
 +         begin
 +           ​i:​=lahde[x,​y];​
 +           ​skip:​=true;​
 +         end;
 +
 +         ​procedure YLOS;
 +         begin
 +           ​i:​=lahde[x,​y]+1;​
 +           ​skip:​=true;​
 +         end;
 +
 +      begin
 +        i:=0;
 +        for xl:=x-1 to x+1 do
 +        for yl:=y-1 to y+1 do
 +          {Käydään läpi kaikki solua ympäröivät paikat. Mikäli valittu}
 +          {otetaan mukaan myös solu itse.                             }
 +        begin
 +          skip:​=false;​
 +          if asetukset[8]=0 then
 +          begin
 +            if xl=x then
 +            begin
 +              if yl=y then
 +              begin
 +                skip:=true;
 +              end;
 +            end;
 +          end;
 +            {Jos ei haluta omaa solua mukaan niin hypätään sen yli.}
 +          yt:=YY(yl);
 +          xt:=XX(xl);
 +          if not skip then inc(i,​lahde[xt,​yt]);​
 +            {Jos kaikki on okei lisätään yhden ympäristösolun arvo}
 +            {apumuuttujaan. ​                                      }
 +        end;
 +        skip:​=false;​
 +        if i<​asetukset[1] then ALAS;
 +          {Elämä vähenee...}
 +        if not skip then
 +        begin
 +          if i<​asetukset[2] then NOPE;
 +        end;
 +        if not skip then
 +        begin
 +          if i<​asetukset[3] then YLOS;
 +        end;
 +        if not skip then
 +        begin
 +          if i<​asetukset[4] then NOPE;
 +        end;
 +        if not skip then ALAS;
 +        INDEKSI:=i;
 +          {Apumuuttujan arvo siirretään funktion arvoksi.}
 +      end;
 +
 +    begin
 +      if silmu then STATUS(4) else STATUS(2);
 +        {Sen mukaan ollaanko silmukassa vai Uusi sukupolvi -valinnassa}
 +        {valitaan alareunan statusteksti. ​                            }
 +      for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +      begin
 +        lahde[x,​y]:​=kohde[x,​y];​
 +          {Kopioidaan vanha tulos uudeksi lähtötaulukoksi.}
 +        if spolvi=0 then sailo[x,​y]:​=kohde[x,​y];​
 +          {Jos sukupolvi on nolla laitetaan lähtötilanne talteen}
 +          {Palauta -toimintoa varten. ​                          }
 +        kohde[x,​y]:​=0;​
 +      end;
 +      for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +      begin
 +        kohde[x,​y]:​=INDEKSI(x,​y);​
 +        if kohde[x,​y]>​5 then kohde[x,​y]:​=5;​
 +        if kohde[x,​y]<​1 then kohde[x,​y]:​=1;​
 +          {Kohdesolun arvot rajataan välille 1 - 5.}
 +      end;
 +      inc(spolvi);​
 +      SUKUPOLVI;
 +        {Kasvatetaan sukupolvilaskuria ja tulostetaan sen arvo.}
 +      TULOSTA_KENTTA;​
 +      pelattu:​=true;​
 +        {Pelin loppuessa suoritetaan talletus koska pelattu on voimassa.}
 +    end;
 +
 +    procedure GENEROI;
 +    {Tämä proseduuri synnyttää satunnaisen solumaailman.}
 +    var
 +      x,​y,​apu,​apu2:​byte;​
 +    begin
 +      STATUS(6);
 +      apu2:​=random(20)+4;​
 +      for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +      begin
 +        apu:​=random(apu2)+1;​
 +        if apu=3 then kohde[x,​y]:​=random(5)+1 else kohde[x,​y]:​=random(4)+1;​
 +        if apu>4 then kohde[x,​y]:​=1;​
 +          {Kukin solu saa arvon 1 - 5};
 +      end;
 +      TULOSTA_KENTTA;​
 +      spolvi:=0;
 +      SUKUPOLVI;
 +        {Tulostetaan kenttä ja nollataan sukupolvilaskuri.}
 +      pelattu:​=true;​
 +        {Myös generoitu solumaailma tallentuu lopetettaessa.}
 +      end;
 +
 +    procedure SILMUKKA;
 +      {Tämä aliohjelma pyörittää Uusi sukupolvi -toimintoa}
 +      {kunnes halutaan toisin.}
 +    begin
 +      silmu:​=true;​
 +      while not keypressed do
 +      begin
 +        UUSI_SUKUPOLVI;​
 +        delay(asetukset[5]*20);​
 +          {Pidetään "​silmukkaviive"​.}
 +      end;
 +      ODOTA;
 +      silmu:​=false;​
 +    end;
 +
 +    procedure RAJAT;
 +      {Tässä aliohjelmassa käyttäjä saa valita elämän rajat.}
 +    const
 +      x=69;
 +      y1=7;
 +      y2=11;
 +      y3=15;
 +      y4=19;
 +      y5=25;
 +        {Arvojen tulostuspaikat ruudulla.}
 +
 +    var
 +      aktiivinen:​shortint;​
 +      das_ende:​boolean;​
 +
 +      procedure TULOSTA_ARVOT;​
 +        {Tämä tulostaa arvot "​häkkyrän"​ viereen, aktiivinen}
 +        {tulostuu eri taustavärillä. ​                      }
 +      begin
 +        gotoxy(x,​y1);​
 +        if aktiivinen=4 then textcolor(14) else textcolor(7);​
 +        write(asetukset[4],' ​  '​);​
 +        gotoxy(x,​y2);​
 +        if aktiivinen=3 then textcolor(14) else textcolor(7);​
 +        write(asetukset[3],' ​  '​);​
 +        gotoxy(x,​y3);​
 +        if aktiivinen=2 then textcolor(14) else textcolor(7);​
 +        write(asetukset[2],' ​  '​);​
 +        gotoxy(x,​y4);​
 +        if aktiivinen=1 then textcolor(14) else textcolor(7);​
 +        write(asetukset[1],' ​  '​);​
 +        if aktiivinen=5 then textcolor(14) else textcolor(7);​
 +        gotoxy(x,​y5);​
 +        write('​POIS'​);​
 +      end;
 +
 +      function SUHT_AKT:​byte;​
 +        {Tämä palauttaa kunkin raja-arvon maksimin.}
 +      begin
 +        case aktiivinen of
 +          4:​SUHT_AKT:​=45;​
 +          3:​SUHT_AKT:​=asetukset[4];​
 +          2:​SUHT_AKT:​=asetukset[3];​
 +          1:​SUHT_AKT:​=asetukset[2];​
 +        end;
 +      end;
 +
 +      function ALA_AKT:​byte;​
 +        {Tämä palauttaa kunkin raja-arvon minimin.}
 +      begin
 +        case aktiivinen of
 +          4:​ALA_AKT:​=asetukset[3]+1;​
 +          3:​ALA_AKT:​=asetukset[2]+1;​
 +          2:​ALA_AKT:​=asetukset[1]+1;​
 +          1:​ALA_AKT:​=1
 +        end;
 +      end;
 +
 +
 +    begin
 +      aktiivinen:​=5;​
 +        {Alussa aktiivinen arvo on ylin eli 5.}
 +      das_ende:​=false;​
 +      PALKKIEN_ALUE;​
 +      textbackground(0);​
 +      textcolor(15);​
 +      gotoxy(60,​1);​
 +      WR('​ELÄMÄN RAJAT'​);​
 +      WR(' ');
 +      WR(' ​    --- 40/​45'​);​
 +      WR(' ​   |');
 +      WR(' -  |');
 +      WR(' ​   |');
 +      WR(' ​    --- ');
 +      WR(' ​   |');
 +      WR(' 0  |');
 +      WR(' ​   |');
 +      WR(' ​    ​---'​);​
 +      WR(' ​   |');
 +      WR(' +  |');
 +      WR(' ​   |');
 +      WR(' ​    ​---'​);​
 +      WR(' ​   |');
 +      WR(' 0  |');
 +      WR(' ​   |');
 +      WR(' ​    ​---'​);​
 +      WR(' ​   |');
 +      WR(' -  |');
 +      WR(' ​   |');
 +      WR(' ​    --- 0');
 +      while not das_ende do
 +      begin
 +        TULOSTA_ARVOT;​
 +        ODOTA;
 +        case key of
 +          #80:
 +            {Alaspäin.}
 +          begin
 +            dec(aktiivinen);​
 +            if aktiivinen<​1 then aktiivinen:​=5;​
 +          end;
 +          #72:
 +            {Ylöspäin.}
 +          begin
 +            inc(aktiivinen);​
 +            if aktiivinen>​5 then aktiivinen:​=1;​
 +          end;
 +          #​27:​das_ende:​=true;​
 +            {Pois.}
 +          #13:
 +            {Enter.}
 +          begin
 +            if aktiivinen<>​5 then
 +            begin
 +              inc(asetukset[aktiivinen]);​
 +              if asetukset[aktiivinen]>​=SUHT_AKT then
 +                asetukset[aktiivinen]:​=ALA_AKT;​
 +            end;
 +            if aktiivinen=5 then das_ende:​=true;​
 +          end;
 +        end;
 +      end;
 +      KAIKKI_PALKIT;​
 +      pelattu:​=true;​
 +        {Jos arvoja on muutettu, talletetaan lopussa tilanne levylle.}
 +    end;
 +
 +    procedure PALAUTA;
 +      {Tämä aliohjelma palauttaa tilanteen sukupolven 0 tasolle.}
 +    var
 +      x,y:byte;
 +    begin
 +      STATUS(2);
 +      spolvi:=0;
 +      SUKUPOLVI;
 +      for x:=xmin to xmax do
 +      for y:=ymin to ymax do
 +        kohde[x,​y]:​=sailo[x,​y];​
 +      TULOSTA_KENTTA;​
 +    end;
 +
 +    procedure LATAA;
 +      {Tämä palautta viimeisen tallettuneen tilanteen levyltä.}
 +    begin
 +      STATUS(8);
 +      assign(astore,'​biosave.cnf'​);​
 +      assign(kstore,'​biosave.fld'​);​
 +      assign(pstore,'​biosave.gnr'​);​
 +      reset(astore);​
 +      reset(kstore);​
 +      reset(pstore);​
 +      read(astore,​asetukset);​
 +      read(kstore,​kohde);​
 +      read(pstore,​spolvi);​
 +      close(astore);​
 +      close(kstore);​
 +      close(pstore);​
 +      TULOSTA_KENTTA;​
 +      SUKUPOLVI;
 +    end;
 +
 +    procedure EDITORI;
 +      {Editori -aliohjelmassa voi käyttäjä suoraan muokata solumaailmaa.}
 +    var
 +      x,y:byte;
 +      quit:​boolean;​
 +
 +      procedure ASETA(n:​shortint);​
 +        {Tämä asettaa tietyn solun (x,y) tasolle n.}
 +      var
 +        xs,ys:byte;
 +      begin
 +        xs:=x;
 +        ys:=y;
 +        kohde[x,​y]:​=n;​
 +        textbackground(1);​
 +        textcolor(aste(kohde[x,​y]));​
 +        write(ukko);​
 +        gotoxy(xs,​ys);​
 +      end;
 +
 +      procedure KASVATA;
 +        {Valittaessa kasvatus asetetaan solu seuraavaan arvoonsa.}
 +      var
 +        ss:byte;
 +      begin
 +        ss:​=kohde[x,​y];​
 +        case ss of
 +          1:ASETA(2);
 +          2:ASETA(3);
 +          3:ASETA(4);
 +          4:ASETA(5);
 +          5:ASETA(1);
 +        end;
 +      end;
 +
 +      procedure YLOS;
 +        {Kursori siirtyy ylös.}
 +      begin
 +        dec(y);
 +        if y<ymin then y:=ymin;
 +        gotoxy(x,​y);​
 +      end;
 +
 +      procedure ALAS;
 +        {Katso edellä.}
 +      begin
 +        inc(y);
 +        if y>ymax then y:=ymax;
 +        gotoxy(x,​y);​
 +      end;
 +
 +      procedure VASEN;
 +      begin
 +        dec(x);
 +        if x<xmin then x:=xmin;
 +        gotoxy(x,​y);​
 +      end;
 +
 +      procedure OIKEA;
 +      begin
 +        inc(x);
 +        if x>xmax then x:=xmax;
 +        gotoxy(x,​y);​
 +      end;
 +
 +      procedure TYHJAA;
 +        {Tämä tyhjentää kentän.}
 +      var
 +        x,y:byte;
 +      begin
 +        for x:=xmin to xmax do
 +        for y:=ymin to ymax do
 +        begin
 +          kohde[x,​y]:​=1;​
 +        end;
 +        TULOSTA_KENTTA;​
 +      end;
 +
 +    begin
 +      quit:​=false;​
 +      STATUS(5);
 +      PALKKIEN_ALUE;​
 +      gotoxy(60,​3);​
 +      textbackground(7);​
 +      textcolor(0);​
 +      WR('​EDITORI ​      '​);​
 +      WR(' ​             ');
 +      WR('​LIIKUTA ​      '​);​
 +      WR('​KOHDISTINTA ​  '​);​
 +      WR('​NUOLINÄPPÄI- ​ ');
 +      WR('​MILLÄ ​        '​);​
 +      WR(' ​             ');
 +      WR('​PAINA 1-5 NIIN'​);​
 +      WR('​SOLU SYNTYY ​  '​);​
 +      WR(' ​             ');
 +      WR('​PAINA <​ENTER>​ ');
 +      WR('​NIIN SOLU     '​);​
 +      WR('​KEHITTYY ​     ');
 +      WR(' ​             ');
 +      WR('<​SPACE> ​      '​);​
 +      WR('​TYHJÄÄ KENTÄN ');
 +      WR(' ​             ');
 +      WR('<​ESC> ​        '​);​
 +      WR('​POISTUU ​      '​);​
 +      TULOSTA_KENTTA;​
 +      textbackground(1);​
 +      x:=xmin;
 +      y:=ymin;
 +      while not quit do
 +      begin
 +        while not keypressed do
 +        begin
 +          gotoxy(x,​y);​
 +          textcolor(15);​
 +          write('​_'​);​
 +          gotoxy(x,​y);​
 +          textcolor(ASTE(kohde[x,​y]));​
 +          write(ukko);​
 +          gotoxy(x,​y);​
 +            {Luodaan kohdistin.}
 +        end;
 +        key:​=readkey;​
 +        case key of
 +          #​13:​KASVATA;​
 +          '​1':​ASETA(1);​
 +          '​2':​ASETA(2);​
 +          '​3':​ASETA(3);​
 +          '​4':​ASETA(4);​
 +          '​5':​ASETA(5);​
 +          #​27:​quit:​=true;​
 +          #72:YLOS;
 +          #80:ALAS;
 +          #75:VASEN;
 +          #77:OIKEA;
 +          ' ':​TYHJAA;​
 +        end;
 +      end;
 +      TULOSTA_KENTTA;​
 +      KAIKKI_PALKIT;​
 +      pelattu:​=true;​
 +        {Editorin käyttö saa aikaan talletuksen kun peli lopetetaan.}
 +    end;
 +
 +    procedure VALINNAT;
 +      {Tässä valitaan reunojen yhdistys ja se otetaako solu itse}
 +      {huomioon laskettaessa uutta sukupolvea. ​                 }
 +    begin
 +      PALKKIEN_ALUE;​
 +      gotoxy(60,​3);​
 +      textbackground(0);​
 +      textcolor(14);​
 +      WR('​REUNOJEN ​  '​);​
 +      WR('​YHDISTYS ​  '​);​
 +      WR(' ​          '​);​
 +      WR('​VASEN/​OIK. ');
 +      WR('​REUNA?​ (K/​E)'​);​
 +      WR(' ');
 +      if asetukset[9]=1 then WR(' [KYLLÄ]'​) else
 +        WR(' [EI]'​);​
 +      ODOTA;
 +      case key of
 +        '​k','​K':​asetukset[9]:​=1;​
 +        '​e','​E':​asetukset[9]:​=0;​
 +      end;
 +      WR(' ');
 +      WR('​YLÄ/​ALA'​);​
 +      WR('​REUNA?​ (K/​E)'​);​
 +      WR(' ');
 +      if asetukset[10]=1 then WR(' [KYLLÄ]'​) else
 +        WR(' [EI]'​);​
 +      ODOTA;
 +      case key of
 +        '​k','​K':​asetukset[10]:​=1;​
 +        '​e','​E':​asetukset[10]:​=0;​
 +      end;
 +      WR(' ');
 +      WR('​SOLU ITSE HUOMI-'​);​
 +      WR('​OON?​ (K/E)      ');
 +      WR(' ');
 +      if asetukset[8]=1 then WR(' [KYLLÄ]'​) else
 +        WR(' [EI]'​);​
 +      ODOTA;
 +      case key of
 +        '​k','​K':​asetukset[8]:​=1;​
 +        '​e','​E':​asetukset[8]:​=0;​
 +      end;
 +      KAIKKI_PALKIT;​
 +    end;
 +
 +    procedure VIIVE;
 +      {Tässä aliohjelmassa käyttäjä säätää silmukan viiveen.}
 +    var
 +      out:​boolean;​
 +      ys:byte;
 +    begin
 +      PALKKIEN_ALUE;​
 +      gotoxy(60,​3);​
 +      textbackground(0);​
 +      textcolor(10);​
 +      WR('​VIIVE ​    '​);​
 +      WR(' ​         ');
 +      WR('​PERUSVIIVE'​);​
 +      WR('​SILMUKASSA'​);​
 +      WR(' ​         ');
 +      ys:=wherey;
 +      out:=false;
 +      while not out do
 +      begin
 +        gotoxy(60,​ys);​
 +        write(asetukset[5],' ​  '​);​
 +        gotoxy(60,​(ys+1));​
 +        WR(' ​           ');
 +        WR('​MUUTA NUOLI-'​);​
 +        WR('​NÄPPÄIMILLÄ ');
 +        WR(' ​           ');
 +        WR('<​ESC> ​      '​);​
 +        WR('​POISTUU... ​ ');
 +        ODOTA;
 +        case key of
 +          #​27:​out:​=true;​
 +          #​72:​inc(asetukset[5]);​
 +          #​80:​dec(asetukset[5]);​
 +        end;
 +      end;
 +      KAIKKI_PALKIT;​
 +    end;
 +
 +    procedure APUA;
 +      {Tämä tulostaa BIOLIFE.TXT -tiedostoa vähän kerrallaan.}
 +    var
 +      helppi:​text;​
 +      rhelppi:​string;​
 +      loop:byte;
 +    begin
 +      clrscr;
 +      textbackground(0);​
 +      textcolor(15);​
 +      writeln('​Biolife APUA!!!, <ESC> poistuu, muu näppäin vaihtaa sivua...'​);​
 +      textcolor(14);​
 +      assign(helppi,'​biolife.txt'​);​
 +      reset(helppi);​
 +      key:=' ';
 +      while ord(key)<>​27 do
 +      begin
 +        for loop:=1 to 22 do
 +        begin
 +          readln(helppi,​rhelppi);​
 +          writeln(rhelppi);​
 +        end;
 +        writeln;
 +        textcolor(15);​
 +        write('​Paina näppäintä...'​);​
 +        textcolor(14);​
 +        ODOTA;
 +        writeln;
 +      end;
 +      close(helppi);​
 +      PIIRRA_KUVARUUTU;​
 +      SUKUPOLVI;
 +      KAIKKI_PALKIT;​
 +      TULOSTA_KENTTA;​
 +    end;
 +
 +  begin
 +    case toiminto of
 +      1:​UUSI_SUKUPOLVI;​
 +      7:GENEROI;
 +      2:SILMUKKA;
 +      3:RAJAT;
 +      8:PALAUTA;
 +      9:LATAA;
 +      6:EDITORI;
 +      5:VALINNAT;
 +      4:VIIVE;
 +      11:LOPETA;
 +      10:APUA;
 +    end;
 +  end;
 +
 +  procedure NAPPIS(key:​char);​
 +    {Tämä aliohjelma vaihtaa valikkopalkkia tai toteuttaa toiminnon.}
 +  var
 +    n:longint;
 +  begin
 +    n:​=ord(key);​
 +    if n=13 then TEE;
 +    if n=27 then LOPETA;
 +    if n=72 then
 +    begin
 +      palkki(toiminto,​0);​
 +      if toiminto>​1 then dec(toiminto) else toiminto:​=11;​
 +    end;
 +    if n=80 then
 +    begin
 +      palkki(toiminto,​0);​
 +      if toiminto<​11 then inc(toiminto) else toiminto:​=1;​
 +    end;
 +  end;
 +
 +
 +begin
 +  ASETA_MUUTTUJAT;​
 +  ASETA_ASETUKSET;​
 +  PIIRRA_KUVARUUTU;​
 +  SUKUPOLVI;
 +  KAIKKI_PALKIT;​
 +    {Alkutoiminnot.}
 +  while not loppu do
 +  begin
 +    PALKKI(toiminto,​1);​
 +      {Värjätään aktiivinen palkki.}
 +    STATUS(1);
 +    gotoxy(1,​1);​
 +      {Pidetään kursori nurkassa.}
 +    ODOTA;
 +    NAPPIS(key);​
 +      {Näppäilyn mukaan toimitaan.}
 +  end;
 +end.
 +</​code>​
 +
 +{{tag>​harrastus Pascal ohjelmointi IT IBM 1994 1997}}