Kirjautuminen
Tehtävät
Kilpailu
4. kierros:
7.11. klo 18 – 9.11. klo 23
Ensimmäinen pelini jota hyvällä uskolla voi kutsua peliksi... Joten toivottavasti koodista saa selkoa.
Pelin idea: Olet pallero, jonka täytyy "syödä" kenttään ilmaantuvia herkkuja(palloja). Ohjailu tapahtuu nuolista.
Ruokien keräily tapahtuu aikarajan puitteissa, mutta syömällä saa aikaa, sekä pisteitä.
Onnistuin tekemään highest score -systeemin, joten paras tulos tallentuu "piste.txt" -tiedostoon. Tosin scorejen kanssa saattaa ilmetä onkelmia. Ja useiden muuttujien arvo riippuu koneen nopeudesta.
Pistäkeehän tuomioita tulemaan.
'*** Palleron herkkuhetket by Petteri Tuovinen, 2006 ***
DECLARE SUB ruoka (x2!, y2!, spawn)
DECLARE SUB ennatys (piste, piste$)
DECLARE SUB mainmenu ()
DECLARE SUB Loppu (pisteet, piste, nimi$)
DECLARE SUB Liikkuminen (liike$, x1, y1)
DECLARE SUB Leikkaus (pisteet, aika, spawn, x2, y2)
CLS 'puhdistaa näyttöalueen
SCREEN 12 'muuta näyttötila
alku:
CALL mainmenu 'kutsuu menun
CALL ennatys(piste, piste$) 'kutsuu ennätystuloksen sisältävää aliohjelmaa
main:
pisteet = 0 'varmistaa että pisteet ovat nollassa
DO
alku$ = INPUT$(1) 'syötä luku
IF alku$ = "1" THEN GOTO peli 'paina 1:tä; peli alkaa
IF alku$ = "2" THEN END ELSE 'paina 2:ta;peli suljetaan
LOOP 'jos painetaan muuta, toistetaan
peli:
CLS
x1 = 100 'liikuteltavan pallon x-aloituskoordinaatti
y1 = 100 'liikuteltavan pallon y-aloituskoordinaatti
RANDOMIZE TIMER 'mahdollistaa lukujen satunnaistamisen
x2 = INT(RND * 100) 'satunnaistaa "pisteen" x-koordinaatin
y2 = INT(RND * 200) 'satunnaistaa "pisteen" y-koordinaatin
r1 = x1 'varmistetaan, että muuttujat ovat samanarvoiset
r2 = y1 'varmistetaan, että muuttujat ovat samanarvoiset
aika = 4 'määritetään aloituksessa oleva aika
spawn = 1 'määritetään, onko näytöllä poimittavaa pistettä 1 = on; 0 = ei ole
DO 'aloitetaan silmukka
IF spawn = 0 THEN CALL ruoka(x2, y2, spawn) 'jos kentällä ei ole poimittavaa pistettä, kutsutaan subia ruoka
LOCATE 5, 5: PRINT pisteet 'tulostaa senhetkisen pistemäärän
LOCATE 5, 20: PRINT INT(aika) 'tulostaa jäljellä olevan ajan
aika = aika - .0003 'laitetaan aika vähenemään huom! muuttujan arvo konekohtainen
CALL Liikkuminen(liike$, x1, y1) 'kutsutaan aliohjelmaa Liikkuminen
CIRCLE (x1, y1), 5, 5 'piirretään liikuteltava pallo
CIRCLE (x2, y2), 9, 5 'piirretään poimittava piste
IF (x1 - x2) ^ 2 + (y1 - y2) ^ 2 < r1 + r2 THEN 'jos ympyröiden säteet leikkaavat...
CALL Leikkaus(pisteet, aika, spawn, x2, y2) '...niin siirrytään aliohjelmaan Leikkaus
END IF
IF aika < 0 THEN
CALL Loppu(pisteet, piste, nimi$) 'jos aikaa on vähemmän kuin nolla, kutsutaan aliohjelmaa Loppu
GOTO uudelleen
END IF
LOOP 'aloitetaan silmukka alusta
uudelleen:
DO 'aloitetaan lopetussilmukka
Lopetus$ = INPUT$(1) 'syötetään muuttuja Lopetus$
LOOP UNTIL Lopetus$ = CHR$(27) 'toistetaan silmukkaa, kunnes painetaan esc
CLS 'tyhjennetään kuvaruutu
IF pisteet = 0 THEN 'jos pisteitä ei ole...
CALL mainmenu '...kutsutaan mainmenu uudestaan
CALL ennatys(piste, piste$) 'kutsutaan pisteet uudestaan
GOTO main 'siirrytään kohtaan "main"
END IF
SUB ennatys (piste, piste$)
ON ERROR GOTO main 'jos ilmenee virheitä, siirrytään paikkaan "main"
LOCATE 5, 2: PRINT "All-time best:"
OPEN "piste.txt" FOR INPUT AS #1 'avataan tiedosto "piste.txt" luettavaksi
DO 'aloitetaan tiedostonlukemissilmukka
INPUT #1, piste, piste$ 'määritellään tiedostossa oleva teksti muuttujiin piste ja piste$
PRINT piste; piste$ 'tulostetaan muuttujien piste ja piste$ sisältämä tieto kuvaruudulle
LOOP UNTIL EOF(1) = -1 'toistetaan silmukkaa, kunnes tiedosto on luettu loppuun
END SUB
SUB Leikkaus (pisteet, aika, spawn, x2, y2)
pisteet = pisteet + 1 'lisätään yksi piste
aika = aika + 2 'lisätään aikaa
spawn = 0 'määritetään muuttuja spawn
CIRCLE (x2, y2), 9, 0 'puhdistetaan alue, jolla kerätty piste oli
END SUB
SUB Liikkuminen (liike$, x1, y1)
liike$ = INKEY$ 'määrätään, että muuttuja liike$ odottaa näppäimen painallusta
IF liike$ = CHR$(0) + "M" THEN 'liikkuminen oikealle
x1 = x1 + 7
CIRCLE (x1 - 7, y1), 5, 0
END IF
IF liike$ = CHR$(0) + "P" THEN 'liikkuminen alas
y1 = y1 + 7
CIRCLE (x1, y1 - 7), 5, 0
END IF
IF liike$ = CHR$(0) + "H" THEN 'liikkuminen ylös
y1 = y1 - 7
CIRCLE (x1, y1 + 7), 5, 0
END IF
IF liike$ = CHR$(0) + "K" THEN 'liikkuminen vasemmalle
x1 = x1 - 7
CIRCLE (x1 + 7, y1), 5, 0
END IF
END SUB
SUB Loppu (pisteet, piste, nimi$)
SOUND 80, 5 'äänimerkki pelin loppumisen merkiksi
PRINT "sait "; pisteet; " pistettä!" 'tulostetaan erän pistemäärä
IF pisteet > piste THEN 'jos erän pistemäärä on suurempi kuin tiedostossa oleva muuttuja;
LINE INPUT "Huipputulos! Pallero kuoli kylläisenä. Kirjoita nimimerkkisi:"; nimi$ 'pyydetään syöttämään muuttuja nimi$
IF nimi$ = "" THEN nimi$ = "nimetön"
CLOSE #1 'suljetaan aliohjelmassa "ennatys" aukaistu tiedosto
OPEN "piste.txt" FOR OUTPUT AS #2 'avataan tiedosto "piste.txt" uutta huipputulosta varten
PRINT #2, pisteet; nimi$ 'kirjoitetaan tietoa tiedostoon
CLOSE #2 'suljetaan äsken avattu tiedosto
ELSE PRINT "Pallero kuoli nälkään. Et saanut huipputulosta :( " '<-- jos erän pistemäärä oli pienempi kuin tiedostossa oleva muuttuja
END IF
CLOSE #1 'suljetaan ehkä auki oleva tiedosto
pisteet = 0 'nollataan pisteet mahdollista seuraavaa erää varten
END SUB
SUB mainmenu
LOCATE 5, 20: PRINT "1 alku" ' tulostetaan
LOCATE 6, 20: PRINT "2 lopetus" ' päävalikko
END SUB
SUB ruoka (x2, y2, spawn)
RANDOMIZE TIMER 'mahdollistetaan satunnaislukujen arvonta
x2 = INT(RND * 500) 'satunnaistetaan muuttuja x2
y2 = INT(RND * 400) 'satunnaistetaan muuttuja y2
spawn = 1 'varmistetaan että kentälle ei tule yhtä pistettä enempää kerrallaan
SOUND 800, 1 'tuotetaan äänimerkki pisteen keräämisen johdosta
END SUBHöh, teit pelistä liian vaikean. Kuolin heti :(.
Windowsin näppäimistöasetusten säätämisellä saattaa olla vaikutusta.
EDIT: Jos omistat nopean koneen, täytyy sinun muuttaa ajan muuttujaan lisättävää lukua: Mitä NOPEAMPI kone, sitä PIENEMPI luku (itselläni on 1300 MHz Pentium).
Koodaa ajoitusjärjestelmä, joka rajoittaa toimintojen määrää sekuntia kohden. Helpoin hidaste taitaisi olla jonkinnäköinen sleep, tosin se taisi olla QBasicilla aina vähintään sekunnin, paitsi jos se suostuu ottamaan desimaalilukuja.
Minulla on VB:llä olemassa ajoituskoodi ihan tänne putkaan lähetettynä, mutta se ei paljoa auta QB:n kanssa. Ei taida QB:sta irrota tarpeellisia ominaisuuksia.
Hmm, vielä yhtenä mahdollisuutena tuli mieleen, että laitat laskurin, joka katsoo montako kertaa looppi vedetään lävitse esim. sekunnin aikana ja hidastaa sitten siten, että se pyrkii tasaamaan loopin suoritusmäärät esimerkiksi kuuteenkymmeneen säätämällä sitä ajan muuttujaa. Aluksi asetus voisi olla "liian kova", eli peli lähtisi alusta hieman liian hitaasti liikkeelle, mutta nopeastihan tuo määrittelisi sen sopivan tahdin.
Kyllä TIMERistä irtoaa liki 20Hz taajuus, ja se voisi riittää tuohonkin. Sopivilla muilla viritelmillä voi saada koneen kellosta ainakin sadasosat irti.
SLEEP ei oikein toimi tässä, koska se odottaa aina tasasekunteja, ja pysäyttää odottamisen kaiken lisäksi jos nappeja painetaan. Tällaiseen peliin (jossa framen suoritus ei ole kovin hidasta) riittää hyvin kuitenkin lyhyt paussi framen loppuun. Esim näin:
Delay 1.5 'odottaa puolitoista sekuntia
SUB Delay (DelayTime AS DOUBLE)
DIM StartTIMER AS DOUBLE
StartTIMER = TIMER
DO: LOOP UNTIL TIMER - StartTIMER >= DelayTime OR TIMER < StartTIMER
'Tuo 'TIMER < StartTIMER' estää silmukan jumittumisen 24 tunniksi,
'jos vuorokausi sattuu vaihtumaan silmukan rullatessa
END SUBOfftopic: Kommenttien editoinnissa on jotain mätää. Kommentin poistaminen ja muokkaaminen ei tunnu menevän läpi, jos se sattuu olemaan ketjun viimeisenä.
lainaus:
SLEEP ei oikein toimi tässä, koska se odottaa aina tasasekunteja, ja pysäyttää odottamisen kaiken lisäksi jos nappeja painetaan. Tällaiseen peliin (jossa framen suoritus ei ole kovin hidasta) riittää hyvin kuitenkin lyhyt paussi framen loppuun. Esim näin:
Delay 1.5 'odottaa puolitoista sekuntia SUB Delay (DelayTime AS DOUBLE) DIM StartTIMER AS DOUBLE StartTIMER = TIMER DO: LOOP UNTIL TIMER - StartTIMER >= DelayTime OR TIMER < StartTIMER 'Tuo 'TIMER < StartTIMER' estää silmukan jumittumisen 24 tunniksi, 'jos vuorokausi sattuu vaihtumaan silmukan rullatessa END SUBOfftopic: Kommenttien editoinnissa on jotain mätää. Kommentin poistaminen ja muokkaaminen ei tunnu menevän läpi, jos se sattuu olemaan ketjun viimeisenä.
[vuodatus]
Busy-loopit on lailla kielletty, paitsi ehkä jossain amiga demoissa. Onko tuo baSICK todellakin niin surkea alusta, että muita vaihtoehtoi ei ole? Jos niin, niin taas yksi hyvä syys siirtyä järkevämpään kieleen/alustaan. Ja koska edellisessä lauseessa oli sana järkevä on VB pois suljettu :)
[/vuodatus]
Olis vaan YKS ongelma: Mitäs sitten, kun et jaksa enää pelata, sul on 2 minsaa aikaa jäljellä ja ESCillä ei poistu pelistä? Pistä poistumisnäppäin!
Huom: Oletan,että putkaan laittamallani koodilla kukaan ei saa niin ylivoimaista tulosta. Ja kyseinen koodi on optimoitu MINUN koneelleni. Ja hieman ylempänä mainitsin että muuta ajan muuttuja sopivaksi koneellesi.
Sitäpaitsi pelistä pääsee pois näppäinyhdistelmällä ALT+Tab.
>_Pete_
Kyllä sitä löytyy vaikka mitä vaihtoehtoja laittaa Qbasicissa hidastus. Simppelein on odottaa jotain tahdistushommelia näytöltä. Odotus, joka muuten saattaa esim. paletin säätöjä tehdessä olla hyödyllinen, jollei sitten tahdo katsella lumisadetta. Sitten on tick-ajastus, jota itse käytän..
-Grey-
ihan hyvä peli.
tosta seuraava askel onkin sitte pacman !]
oli muuten ensimmäinen kommenttini ohjelmointiputkassa!
itse aloitin qbasic koodaamisen joskus talvella, ja olen jo yhden projektin kimpussa....
EDIT: lisäsin sen koodivinkkeihin nimellä "rallipeli" https://www.ohjelmointiputka.net/koodivinkit/
Enpä ole itsekään pitkään koodaillut. Innostuin joskus pari vuotta sitten kuusnelosemulaattorista ja sit sain kuulla että wintoosa ysiviidessä on qbasicci... Siitä se sitten lähti ja tähän on tultu.
lainaus:
Innostuin joskus pari vuotta sitten kuusnelosemulaattorista ja sit sain kuulla että wintoosa ysiviidessä on qbasicci...
miten ihmeessä kuusnelosemulaattori liittyy qbasiciin???!!
lainaus:
miten ihmeessä kuusnelosemulaattori liittyy qbasiciin???!!
Jos et sattumoisin tiennyt, kuusnepassa oli sisäänrakennettu basic-tulkki, kuten myöskin emulaattorissa. Ja sillä sitten kaikki hello worldit tuli ensimmäisen kerran tehtyä...
Itse tekisin näin:
Peli oli liian helppo, tein vaikeamman.
Parantelin myös alkuvalikkoa.
'*** Palleron herkkuhetket by Petteri Tuovinen, 2006 ***
DECLARE SUB ruoka (x2!, y2!, spawn)
DECLARE SUB ennatys (piste, piste$)
DECLARE SUB mainmenu ()
DECLARE SUB Loppu (pisteet, piste, nimi$)
DECLARE SUB Liikkuminen (liike$, x1, y1)
DECLARE SUB Leikkaus (pisteet, aika, spawn, x2, y2)
CLS 'puhdistaa näyttöalueen
SCREEN 12 'muuta näyttötila
alku:
CALL ennatys(piste, piste$) 'kutsuu ennätystuloksen sisältävää aliohjelmaa
main:
pisteet = 0 'varmistaa että pisteet ovat nollassa
selectx = 1 'laittaa menun valmiiksi pelin aloittamiseen
DO 'aloittaa silmukan
IF selectx = 1 THEN 'Ihmettelee, että kumpi laitos on valinnassa
COLOR 9 'Vaihtaa sen värn siniseksi
LOCATE 5, 10 'Määrittää pisteen johonka kirjoitetaan
PRINT "Aloita peli" 'Kirjoittaa
COLOR 15 'Väri muutuu valkoiseksi
LOCATE 6, 10 'Määrittelee sitä kohtaa edelleenkin
PRINT "Lopeta peli" 'Kirjoittaa
END IF 'Lopettaa IF-käskyn
IF selectx = 2 THEN 'Ihmettelee, että kumpi laitos on valinnassa
COLOR 15 'Vaihtaa värin valkoiseksi(en jaksanu kattoo että tarvitaanko sitä mut laitoin joka tapauksessa)
LOCATE 5, 10 'määrittää
PRINT "Aloita peli" 'kirjottaa
LOCATE 6, 10 'määrittää
COLOR 9 'vaihtaaa väriä
PRINT "Lopeta peli" 'kirjottaa
END IF 'Lopettaa ifin
select$ = INKEY$ 'select$ on pelaajan painama nämiskä
IF select$ = CHR$(0) + "H" THEN 'jos painetaan ylänuolta ni sitte se vaihtaa sitä kohtaa mikä printataan sinisellä
IF selectx = 2 THEN selectx = 1 'mut vaan jos sininen on alhaalla
END IF 'lopettaa ifin
IF select$ = CHR$(0) + "P" THEN 'Jos painetaan alanuolta ni jos on ylhäällä se sininen teksti
IF selectx = 1 THEN selectx = 2 'ni sitte se tulee alas
END IF
IF select$ = CHR$(13) THEN 'ja sitte jos painetaan enteriä ni sillon
IF selectx = 1 THEN GOTO peli 'jos valinta on ylhäällä ni sillo mennään ruutuun peli
IF selectx = 2 THEN END 'jos valinta on alhaalla ni sillo lopetetaan
END IF
LOOP 'jos painetaan muuta, toistetaan
peli:
CLS
x1 = 100 'liikuteltavan pallon x-aloituskoordinaatti
y1 = 100 'liikuteltavan pallon y-aloituskoordinaatti
RANDOMIZE TIMER 'mahdollistaa lukujen satunnaistamisen
x2 = INT(RND * 100) 'satunnaistaa "pisteen" x-koordinaatin
y2 = INT(RND * 200) 'satunnaistaa "pisteen" y-koordinaatin
r1 = x1 'varmistetaan, että muuttujat ovat samanarvoiset
r2 = y1 'varmistetaan, että muuttujat ovat samanarvoiset
aika = 6 'määritetään aloituksessa oleva aika
spawn = 1 'määritetään, onko näytöllä poimittavaa pistettä 1 = on; 0 = ei ole
DO 'aloitetaan silmukka
IF spawn = 0 THEN CALL ruoka(x2, y2, spawn) 'jos kentällä ei ole poimittavaa pistettä, kutsutaan subia ruoka
LOCATE 5, 5: PRINT pisteet 'tulostaa senhetkisen pistemäärän
LOCATE 5, 20: PRINT INT(aika) 'tulostaa jäljellä olevan ajan
aika = aika - .0003 'laitetaan aika vähenemään huom! muuttujan arvo konekohtainen
CALL Liikkuminen(liike$, x1, y1) 'kutsutaan aliohjelmaa Liikkuminen
CIRCLE (x1, y1), 5, 5 'piirretään liikuteltava pallo
CIRCLE (x2, y2), 9, 5 'piirretään poimittava piste
IF (x1 - x2) ^ 2 + (y1 - y2) ^ 2 < r1 + r2 THEN 'jos ympyröiden säteet leikkaavat...
CALL Leikkaus(pisteet, aika, spawn, x2, y2) '...niin siirrytään aliohjelmaan Leikkaus
END IF
IF aika < 0 THEN
CALL Loppu(pisteet, piste, nimi$) 'jos aikaa on vähemmän kuin nolla, kutsutaan aliohjelmaa Loppu
GOTO uudelleen
END IF
LOOP 'aloitetaan silmukka alusta
uudelleen:
DO 'aloitetaan lopetussilmukka
CLS
PRINT "Paina Esc-nämiskää."
Lopetus$ = INPUT$(1) 'syötetään muuttuja Lopetus$
LOOP UNTIL Lopetus$ = CHR$(27) 'toistetaan silmukkaa, kunnes painetaan esc
CLS 'tyhjennetään kuvaruutu
IF pisteet = 0 THEN 'jos pisteitä ei ole...
'...kutsutaan mainmenu uudestaan
CALL ennatys(piste, piste$) 'kutsutaan pisteet uudestaan
GOTO main 'siirrytään kohtaan "main"
END IF
SUB ennatys (piste, piste$)
ON ERROR GOTO main 'jos ilmenee virheitä, siirrytään paikkaan "main"
LOCATE 5, 2: PRINT "All-time best:"
OPEN "piste.txt" FOR INPUT AS #1 'avataan tiedosto "piste.txt" luettavaksi
DO 'aloitetaan tiedostonlukemissilmukka
INPUT #1, piste, piste$ 'määritellään tiedostossa oleva teksti muuttujiin piste ja piste$
PRINT piste; piste$ 'tulostetaan muuttujien piste ja piste$ sisältämä tieto kuvaruudulle
LOOP UNTIL EOF(1) = -1 'toistetaan silmukkaa, kunnes tiedosto on luettu loppuun
END SUB
SUB Leikkaus (pisteet, aika, spawn, x2, y2)
pisteet = pisteet + 1 'lisätään yksi piste
aika = aika + 1 'lisätään aikaa
spawn = 0 'määritetään muuttuja spawn
CIRCLE (x2, y2), 9, 0 'puhdistetaan alue, jolla kerätty piste oli
END SUB
SUB Liikkuminen (liike$, x1, y1)
liike$ = INKEY$ 'määrätään, että muuttuja liike$ odottaa näppäimen painallusta
IF liike$ = CHR$(0) + "M" THEN 'liikkuminen oikealle
x1 = x1 + 7
CIRCLE (x1 - 7, y1), 5, 0
END IF
IF liike$ = CHR$(0) + "P" THEN 'liikkuminen alas
y1 = y1 + 7
CIRCLE (x1, y1 - 7), 5, 0
END IF
IF liike$ = CHR$(0) + "H" THEN 'liikkuminen ylös
y1 = y1 - 7
CIRCLE (x1, y1 + 7), 5, 0
END IF
IF liike$ = CHR$(0) + "K" THEN 'liikkuminen vasemmalle
x1 = x1 - 7
CIRCLE (x1 + 7, y1), 5, 0
END IF
END SUB
SUB Loppu (pisteet, piste, nimi$)
SOUND 80, 5 'äänimerkki pelin loppumisen merkiksi
PRINT "sait "; pisteet; " pistettä!" 'tulostetaan erän pistemäärä
IF pisteet > piste THEN 'jos erän pistemäärä on suurempi kuin tiedostossa oleva muuttuja;
LINE INPUT "Huipputulos! Pallero kuoli kylläisenä. Kirjoita nimimerkkisi:"; nimi$ 'pyydetään syöttämään muuttuja nimi$
IF nimi$ = "" THEN nimi$ = "nimetön"
CLOSE #1 'suljetaan aliohjelmassa "ennatys" aukaistu tiedosto
OPEN "piste.txt" FOR OUTPUT AS #2 'avataan tiedosto "piste.txt" uutta huipputulosta varten
PRINT #2, pisteet; nimi$ 'kirjoitetaan tietoa tiedostoon
CLOSE #2 'suljetaan äsken avattu tiedosto
ELSE PRINT "Pallero kuoli nälkään. Et saanut huipputulosta. " '<-- jos erän pistemäärä oli pienempi kuin tiedostossa oleva muuttuja
END IF
CLOSE #1 'suljetaan ehkä auki oleva tiedosto
pisteet = 0 'nollataan pisteet mahdollista seuraavaa erää varten
END SUB
SUB ruoka (x2, y2, spawn)
RANDOMIZE TIMER 'mahdollistetaan satunnaislukujen arvonta
x2 = INT(RND * 500) 'satunnaistetaan muuttuja x2
y2 = INT(RND * 400) 'satunnaistetaan muuttuja y2
spawn = 1 'varmistetaan että kentälle ei tule yhtä pistettä enempää kerrallaan
SOUND 800, 1 'tuotetaan äänimerkki pisteen keräämisen johdosta
END SUBAihe on jo aika vanha, joten et voi enää vastata siihen.