Koodit: CoolBasic: Matopeli

Const TILE_LEVEYS = 12 ' Yhden tilen leveys pikseleinä
Const TILE_KORKEUS = 12 ' Yhden tilen korkeus pikseleinä
Const KENTTA_LEVEYS = 24 ' Kentän leveys tileinä
Const KENTTA_KORKEUS = 24 ' Kentän korkeus tileinä
Const VALI = 1 ' Monta pikseliä tile:jen välissä on väliä

Const MATO_MAX_PITUUS = 60 ' Madon maksimipituus
Const MATO_ALOITUS_PITUUS = 3 ' Madon aloituspituus

Global havisit As Integer ' Kertoo onko hävitty, 0 = ei ole hävitty
                          '  1 = osuit seinään, 2 = osuttiin matoon
Global kasvataMatoa As Byte ' Lippu jos halutaan matoa kasvattaa
Dim matoSuunta (2) ' Suunta mihin mato liikkuu

Dim mato (MATO_MAX_PITUUS, 3) ' Taulukko johon mato tallenetaan
Dim kentta (KENTTA_LEVEYS, KENTTA_KORKEUS) ' Kenttä, jos 1 = seinä
Dim namu (2) ' Kertoo namun sijainin

' Piirtää Tilen ruudulle
Function PiirraTILE(x, y, r, g, b)
    Dim pixX As Integer
    Dim pixY As Integer

    ' Lasketaan laatikon paikka
    pixX = x*TILE_LEVEYS + x*VALI
    pixY = y*TILE_KORKEUS + y*VALI

    ' Asetetaan väri ja piirretään laatikko haluttuun paikkaan
    Color r, g, b
    Box pixX, pixY, TILE_LEVEYS, TILE_KORKEUS
EndFunction

' Alustaa kentän ja lisää siihen reunat
Function AlustaKentta ()
    Dim x As Integer
    Dim y As Integer

    For x = 0 To KENTTA_LEVEYS
        For y = 0 To KENTTA_KORKEUS
            kentta (x,y) = 0 ' Oletuksena ei ole seinää

            ' Luo väliseinän
            If x = 5 And y < KENTTA_KORKEUS - 5 And y > 5  Then
                kentta (x,y) = 1
            EndIf

            ' Luo ruudulle reunat
            If x = 0 Or x = KENTTA_LEVEYS Then
                kentta (x,y) = 1
            EndIf
            If y = 0 Or y = KENTTA_KORKEUS Then
                kentta (x,y) = 1
            EndIf
        Next y
    Next x
EndFunction

' Piirtää kentän
Function PiirraKentta ()
    Dim x As Integer
    Dim y As Integer

    For x = 0 To KENTTA_LEVEYS
        For y = 0 To KENTTA_KORKEUS
            ' Piirretään vain jos kyseessä on seinä
            If kentta (x, y) = 1 Then
                PiirraTILE(x,y,255,255,255)
            EndIf
        Next y
    Next x
EndFunction

Function AlustaMato ()
    Dim i As Integer
    Dim y As Integer

    Dim aloitusX As Integer
    Dim aloitusY As Integer

    ' Aloitus paikka
    aloitusX = 12
    aloitusY = 12

    ' Alustetaan matoon liittyvät muuttujat
    matoSuunta(0) = 0
    matoSuunta(1) = -1

    kasvataMatoa = 0

    ' Alustetaan mato
    For i = 0 To MATO_MAX_PITUUS
        If i < MATO_ALOITUS_PITUUS
            mato(i, 0) = aloitusX
            mato(i, 1) = aloitusY + i
            mato(i, 2) = 1
        Else
            mato(i, 2) = 0
        EndIf
    Next i
EndFunction

' Piirtää madon ruudulle
Function PiirraMato()
    Dim i As Integer
    Dim x As Integer
    Dim y As Integer

    ' Käy kaikki madon osat läpi ja piirtää ruudulle
    For i = 1 To MATO_MAX_PITUUS
        If mato(i, 2) = 1
            x = mato(i, 0)
            y = mato(i, 1)

            PiirraTILE(x,y,0,255,0)
        EndIf
    Next i

    PiirraTILE(mato(0,0),mato(0,1),0,150,0)
EndFunction

Function LiikutaMato()
    Dim i As Integer
    Dim loyty As Byte
    Dim vanha (2)

    ' Tarkistetaan törmääkö madon seuraava paikka kenttään
    If kentta(mato(0,0) + matoSuunta(0), mato(0,1) + matoSuunta(1)) = 1 Then
        havisit = 1
        Return 0
    EndIf

    ' Pään vanha sijainti talteen
    vanha(0) =  mato(0, 0)
    vanha(1) =  mato(0, 1)

    ' Siirretään päätä madon suuntaan päin
    mato(0, 0) = mato(0,0) + matoSuunta(0)
    mato(0, 1) = mato(0,1) + matoSuunta(1)

    ' Kun kasvatetaan matoa, varmistetaan ettei kasvateta kuin 1 kerrallaan
    loyty = 0

    ' Liikutetaan muitakin osia, ja lisätään perään yks lisää jos tarvii
    For i = 1 To MATO_MAX_PITUUS
        ' Vaihdetaan nykyisen madon pätkän paikkaa edellisen paikkaan ja
        ' laitetaan nykyinen paikka talteen
        If mato(i, 2) = 1 Then
            Dim uusVanha (2)

            uusVanha(0) = mato(i, 0)
            uusVanha(1) = mato(i, 1)

            mato(i, 0) = vanha(0)
            mato(i, 1) = vanha(1)

            vanha(0) =  uusVanha(0)
            vanha(1) =  uusVanha(1)

        ' Madon kasvatus
        ElseIf kasvataMatoa = 1 And loyty = 0 Then
            loyty = 1
            kasvataMatoa = 0

            mato(i, 2) = 1
            mato(i, 0) = vanha(0)
            mato(i, 1) = vanha(1)
        EndIf
    Next i

    ' Tarkitetaan törmääkö mato itseensä
    For i = 1 To MATO_MAX_PITUUS
        If mato(i, 2) = 1 And mato(i, 0) = mato(0,0) And mato(i, 1) = mato(0,1) Then
            havisit = 2
        EndIf
    Next i

    ' Tarkistetaan osuuko mato namuun
    If mato(0, 0) = namu(0) And mato(0, 1) = namu(1) Then
        KasvataMato()
        ArvoNamu()
    EndIf
EndFunction

' Asettaa lipun, että seuraavalla päivityksella kasvatetaan matoa
Function KasvataMato()
    kasvataMatoa = 1
EndFunction

' Arpoo namille paikan
Function ArvoNamu()
    Dim i As Integer
    Dim x As Integer
    Dim y As Integer
    Dim eiLoytyny As Byte

    ' Arvotaan paikkaa niin kauan kunnes löytyy paikkaa joka ei ole varattu
    eiLoytyny = 1
    While eiLoytyny = 1
        x = Rand(0, KENTTA_LEVEYS)
        y = Rand(0, KENTTA_KORKEUS)

        eiLoytyny = 0

        ' Tarkistetaan meneekö kartan kanssa päälle
        If kentta(x,y) = 1 Then
            eiLoytyny = 1
        EndIf

        ' Tarkistetaan ettei mennyt madon päälle
        For i = 0 To MATO_MAX_PITUUS
            If mato(i, 2) = 1 And mato(i, 0) = x And mato(i, 1) Then
                eiLoytyny = 1
            EndIf
        Next i
    Wend

    namu(0) = x
    namu(1) = y
EndFunction

' Piirtää namun ruudulle
Function PiirraNamu()
    PiirraTILE(namu(0),namu(1),255,0,0)
EndFunction

' Pääohjelma
Function Main()
    Dim peliPaalla As Byte
    Dim paivitysAika As Integer
    Dim seuraavaSuunta (2)

    ' Alustaa satunnaislukugeneraattorin
    Randomize(Timer())

    ' Asetaan otsikko
    SetWindow "CBMatopeli"

    ' Asettaa ikkunan koon vastaamaan kentän kokoa
    SCREEN TILE_LEVEYS*KENTTA_LEVEYS + VALI*KENTTA_LEVEYS + TILE_LEVEYS, TILE_KORKEUS*KENTTA_KORKEUS + VALI*KENTTA_KORKEUS + TILE_KORKEUS

    ' Alustetaan osat
    AlustaKentta()
    AlustaMato()
    ArvoNamu()

    ' Säätö, että liikkumisen tarkistus toimii
    seuraavaSuunta(0) = matoSuunta(0)
    seuraavaSuunta(1) = matoSuunta(1)

    havisit = 0 ' Ei vielä ole hävitty
    peliPaalla = True  ' Poistutaanko ohjelmasta
    paivitysAika = Timer() ' Päivitykseen

    While peliPaalla
        ' Suljetaan jos painetaan esc
        If KeyDown(1) = True
            peliPaalla = False
        EndIf

        ' Tarkistetaan että käännytään (ettei mennä taaksepäin)
        If matoSuunta(0) = 0 Then
            If LeftKey() Then
                seuraavaSuunta(0) = -1
                seuraavaSuunta(1) = 0
            EndIf

            If RightKey() Then
                seuraavaSuunta(0) = 1
                seuraavaSuunta(1) = 0
            EndIf
        Else
            If UpKey() Then
                seuraavaSuunta(0) = 0
                seuraavaSuunta(1) = -1
            EndIf

            If DownKey() Then
                seuraavaSuunta(0) = 0
                seuraavaSuunta(1) = 1
            EndIf
        EndIf

        ' Madon kasvatus DEBUG
        'If KeyDown(44) Then
        '    KasvataMato()
        'EndIf

        ' Päivitys 100ms välein
        If Timer() > paivitysAika+100 And havisit = 0 Then
            matoSuunta(0) = seuraavaSuunta(0)
            matoSuunta(1) = seuraavaSuunta(1)
            LiikutaMato()
            paivitysAika = Timer()
        EndIf

        ' Jos hävittiin asetetaan otsikko sen mukaseksi
        If havisit = 1 Then
            SetWindow "CBMatopeli - Osuit seinään!"
        ElseIf  havisit = 2 Then
            SetWindow "CBMatopeli - Söit itsesi!"
        EndIf

        ' Piirretään tausta
        Color 50,50,50
        Box 0,0, TILE_LEVEYS*KENTTA_LEVEYS + VALI*KENTTA_LEVEYS, TILE_KORKEUS*KENTTA_KORKEUS + VALI*KENTTA_KORKEUS

        ' Piirretään loput
        PiirraKentta()
        PiirraNamu()
        PiirraMato()
        DrawScreen
    Wend
EndFunction

' Kutsutaan pääfunktiota
Main()