Kirjautuminen

Haku

Tehtävät

Kilpailu

Ohjelmoi tekoäly!
Aikaa 4.2. saakka.

Koodivinkit: QB: Life-peli

Kirjoittaja: Sami; viimeksi muokattu 19.04.2003.

Tagit: pelit

karvanaama oli tehnyt jo Javaskriptillä life-pelin, mutta tässä on life-peli QBasicille.

CLS  ' Tyhjätään edellisen pelin jäänteet
RANDOMIZE TIMER  ' Satunnaisuutta peliin
DIM poista(80, 20) AS INTEGER  ' Taulukot lisättäville ja poistettaville laatikoille
DIM lisaa(80, 20) AS INTEGER

FOR i = 1 TO 100  ' Arvotaan aluksi 100 laatikkoa ruudulle (päällekäin meno on mahdollista)
  LOCATE INT(RND * 20 + 1), INT(RND * 80 + 1)
  PRINT "Û"
NEXT i

DO  ' Ohjelman päälooppi
  FOR x = 1 TO 80  ' Tyhjätään vanhat merkinnät
    FOR y = 1 TO 20
      poista(x, y) = 0
      lisaa(x, y) = 0
    NEXT y
  NEXT x

  FOR x = 1 TO 80
    FOR y = 1 TO 20
      l = 0  ' Ympäröivien laatikoiden laskurin nollaus
        ' Perässä on melkoinen hirvitys, jolla lasketaan ruutua ympäröivien laatikoiden määrä
      IF x > 1 AND y > 1 THEN
        IF SCREEN(y - 1, x - 1) = 219 THEN l = l + 1
      END IF
      IF y > 1 THEN
        IF SCREEN(y - 1, x) = 219 THEN l = l + 1
      END IF
      IF x < 80 AND y > 1 THEN
        IF SCREEN(y - 1, x + 1) = 219 THEN l = l + 1
      END IF
      IF x > 1 THEN
        IF SCREEN(y, x - 1) = 219 THEN l = l + 1
      END IF
      IF x < 80 THEN
        IF SCREEN(y, x + 1) = 219 THEN l = l + 1
      END IF
      IF x > 1 AND y < 20 THEN
        IF SCREEN(y + 1, x - 1) = 219 THEN l = l + 1
      END IF
      IF y < 20 THEN
        IF SCREEN(y + 1, x) = 219 THEN l = l + 1
      END IF
      IF x < 80 AND y < 20 THEN
        IF SCREEN(y + 1, x + 1) = 219 THEN l = l + 1
      END IF

      ' Jos ympärillä on 0,1,4 tai enemmän laatikkoa, tällä kohdalla olevat laatikot poistetaan
      IF l = 0 OR l = 1 OR l > 3 THEN
        poista(x, y) = 1
      END IF

      ' Jos ruutu on tyhjä ja sen ympärillä on tasan 3 laatikkoa, siihen luodaan uusi laatikko
      IF SCREEN(y, x) = 32 AND l = 3 THEN
        lisaa(x, y) = 1
      END IF

    NEXT y
  NEXT x

  ' Poistot ja lisäykset
  FOR x = 1 TO 80
    FOR y = 1 TO 20
      IF poista(x, y) = 1 THEN
        LOCATE y, x
        PRINT " "
      END IF
      IF lisaa(x, y) = 1 THEN
        LOCATE y, x
        PRINT "Û"
      END IF
    NEXT y
  NEXT x


SLEEP  ' Jos et halua edetä vaihe vaiheelta, poista tämä
LOOP WHILE INKEY$ <> CHR$(27)

' Täällä on ohjelman loppu, jonne tullaan kun esciä on painettu :)

Kommentit

DKH [19.04.2003 20:24:50]

Lainaa #

Ööö... Life-peli?

mikko [19.04.2003 20:56:35]

Lainaa #

Jep, se hassu ekosysteemi-simulaatio. Googleta.

anomizer [20.04.2003 12:14:21]

Lainaa #

siis häh?
mulle tuli vaan 2 neliöö..
Ja kun painoi jotain niist tuli semmosii pötköi...

Gwaur [20.04.2003 16:54:11]

Lainaa #

Onkos tää joku game of life tai joku?

trinit [20.04.2003 18:47:23]

Lainaa #

Tämä jäljittelee The Game of Life:a. Lisätietoa löytyy esim. MikroBitin 11/2000 nettijatkoista http://www.mikrobitti.fi/nettijatkot/2000/11/life/ . Niin ja oma toteutukseni Windowsille löytyy kotisivultani ;)

Sami [20.04.2003 19:34:29]

Lainaa #

Tästä osoitteesta löytyy tietoa life-pelistä: http://pp.kpnet.fi/jarmo.hietala/gol/lifepeli.html

j.k [02.05.2003 13:43:53]

Lainaa #

Mulla Tiltas kone....

Sami [02.05.2003 15:23:22]

Lainaa #

Tähänkö? Kummallista, tämä kun ei sisällä mitään, mikä olisi sekoittanut oman koneeni..?

Tohveli [18.05.2003 16:39:19]

Lainaa #

piaaska :P

eraggo [08.03.2005 01:55:06]

Lainaa #

no life peli ideana on löytää tapa jolla saada kaikki ruudut täyteen... (toistaiseksi tähän ongelmaan ei ole löytynyt ratkaisua) (hyväksyttävä tapa EI ole niin että "otetaan suoraan kaikki ruudut niin on hyvä", vaan löytää mahdollisimman yksikertainen ratkaisu...
siinäpä on pähkinää... ite en saanut mitenkään sitä ratkottua... jospa joku teistä saisi... :)

temu92 [23.03.2005 14:05:22]

Lainaa #

MIKÄ TOI EES OLI???

crafn [15.06.2005 21:34:02]

Lainaa #

Omituinen hökötys...

Are0100 [27.06.2007 14:12:10]

Lainaa #

miten nää käynnistetään?

Dude [26.09.2007 18:36:23]

Lainaa #

Ihan hyvä. Tein 80*50 version.

Kirjoita kommentti

Muista lukea keskustelun ohjeet.
Tietoa sivustosta