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()
|