Kirjautuminen

Haku

Tehtävät

Kilpailu

Algoritmikisa
Putka Open 2020 -kisan
2. kierros päättyy klo 23:00!

Keskustelu: Koodit näytille: QB: Seiväshyppypelin alku

Sivu 1 / 1

HtH [27.02.2002 19:57:10]

#

Idea on aika omaperäinen, mut teimpähän sen, kun lupasinkin tehdä. Peli on aika keskeneräinen, siinä ei ole mitään hienouksia. Siihen voi itse tehdä lisää juttuja. Pelissä otetaan vauhtia rämpyttämällä vasemmalle, ja oikeallenuolinäppäimiä. Alaspäinnuolinäppäin alkaa laskemaan seivästä maahan, ja ylöspäin nuolinäppäin päästää seipäästä irti. Vaikeustaso on aika vaikea, ja sitä voi itse muuttaa. Fysiikan mallinus taisi olla kaikista ohjelmistani kinkkisintä, mutta onnistuin (siitä voi olla montakin mieltä) siinä jotenkuten. Noh, pitemmittä puheitta tässäpä se koodi sitten on! Mukana tulee hölmö aliohjelma, joke tekee vähän erilaista tekstiä...

Pääohjelma

DECLARE SUB starprint (y!, text$, v1!, v2!)
CONST hid = 20000 'Jos nopeus ei ole sopiva, muuta summaa
'isommaksi, tai pieneksi.
'Seiväshyppy 1.0
'By: HaRa
'----------------------
'Tarkoitus on hypätä seiväshyppyä.
'Vauhtia otat rämpyttämällä vasenta, ja oikeata näppäintä.
'Alaspäin näppäimellä ukko alkaa laskemaan seivästä maahan.
'Ylöspäin näppäimellä ukko päästää irti seipäästä.
'----------------------
'Koodia saat käyttää täysin omiin tarkoituksiisi.
'Ihan kiva olisi, jos kuitenkin antaisit minusta
'maininnan, ja ilmoittaisit minun kotisivuiksi
'http://www.furyproductions.tk näin saan lisää
'kävijöitä sivuilleni.
x = 10  'Aloitus koordinaatit
y = 310
RANDOMIZE TIMER
SCREEN 12
starprint 2, "Seiväshyppy 1.0", 14, 13
starprint 4, "By:HaRa", 14, 15
starprint 6, "Koodi on 100% vapaa", 1, 15
DO
FOR k = 8 TO 18
LOCATE k - 1
PRINT "                                                                                "
starprint k, "Paina mitä tahansa nappia jatkaaksesi...", INT(RND * 15) + 1, INT(RND * 15) + 1
FOR w = 1 TO hid: NEXT
IF INKEY$ <> "" THEN EXIT DO
NEXT k
FOR k = 18 TO 8 STEP -1
LOCATE k + 1
PRINT "                                                                                "
starprint k, "Paina mitä tahansa nappia jatkaaksesi...", INT(RND * 15) + 1, INT(RND * 15) + 1
FOR w = 1 TO hid: NEXT
IF INKEY$ <> "" THEN EXIT DO
NEXT k
LOOP
CLS
tete:
'GOSUB piirra.kentta
seivas.keskikohta = 10 'Mittayksiköt ovat aivan jotain
'muuta kuin pikseleitä, mutta kuitenkin ne toimii...
orkeskikohta = seivas.keskikohta 'Pitää saada tietoon
'originaali keskikohta
seivas.pituus = 60
seivas.kulma = 2
ory = y
COLOR 15
INPUT "Korkeus(m):", kork
DO 'Pääluuppi
GOSUB piirra.kentta
GOSUB piirra.ukko
GOSUB piirra.seivas
GOSUB tarkista.napit
GOSUB do.events
FOR k = 1 TO hid: NEXT
LOOP UNTIL x$ = CHR$(27)
END
do.events:
'Tässä hoidetaan fysiikka...
'kallistu = 0, tavallinen juoksu
'kallistu = 1, seiväs menee alaspäin
'kallisty = 2, "välivaihe"
'kallistu = 3, ukko menee seipään päässä
'ylöspäin
'kallistu = 4, ukko on irti seipäästä.
IF kallistu < 4 AND x >= 492 THEN GOTO failed
IF kallistu <> 4 THEN x = x + nop
IF kallistu = 1 THEN seivas.kulma = seivas.kulma - .08
IF seivas.kulma <= 1.14 AND kallistu = 1 THEN kallistu = 2
IF kallistu = 2 THEN : seivas.x = seivas.x + SIN(seivas.kulma) * (seivas.pituus - seivas.keskikohta): seivas.y = seivas.y + COS(seivas.kulma) * (seivas.pituus - seivas.keskikohta): seivas.keskikohta = seivas.pituus: kallistu = 3: seedy = nop / 100:  _
kallistu = 3
IF kallistu = 3 THEN
seivas.kulma = seivas.kulma - seedy
x = seivas.x - SIN(seivas.kulma) * (seivas.pituus - orkeskikohta)
y = seivas.y - COS(seivas.kulma) * (seivas.pituus - orkeskikohta)
END IF
IF kallistu = 3 AND seivas.kulma <= 1.41 AND seivas.kulma > 0 THEN seedy = seedy - .001
IF kallistu = 3 AND seivas.kulma <= 1.41 AND seivas.kulma < 0 THEN seedy = seedy + .0025
IF kallistu = 3 AND seivas.kulma >= 1.41 THEN GOTO failed
IF kallistu = 3 AND seivas.kulma <= -1.41 THEN GOTO failed
IF kallistu = 4 THEN
IF ssk < 0 THEN ssk = 0
IF ssk < 3 THEN ssk = ssk + .2
'nop = nop - .5
'x = x + nop / 4
x = x + SIN(ssk) * xxs
y = y - COS(ssk) * 6 * (xxs / 6)
IF y > ory AND yli = 1 AND failed = 0 THEN GOTO woohoo
IF y > ory AND yli = 0 OR failed = 1 THEN GOTO failed
IF y + 10 < 310 - kork * 2.5 AND x >= 480 + 11 + 2 THEN yli = 1
IF y + 10 >= 310 - kork * 2.5 AND x = 480 + 11 + 2 THEN failed = 1
END IF
RETURN
tarkista.napit:
'Kontrolllit.
x$ = INKEY$
IF x$ = CHR$(0) + "M" AND kk = 0 THEN nop = nop + .6: kk = 1
IF x$ = CHR$(0) + "K" AND kk = 1 THEN nop = nop + .6: kk = 0
IF x$ = CHR$(0) + "P" AND kallistu = 0 THEN kallistu = 1
IF x$ = CHR$(0) + "H" AND kallistu = 3 THEN kallistu = 4: ssk = (3.14 / 2) - (nop / 10): xxs = nop / 2
RETURN
piirra.seivas:
'Seipään piirto...
LINE (seivas.x + SIN(seivas.kulma) * (seivas.pituus - seivas.keskikohta), seivas.y + COS(seivas.kulma) * (seivas.pituus - seivas.keskikohta))-(seivas.x - SIN(seivas.kulma) * seivas.keskikohta, seivas.y - COS(seivas.kulma) * seivas.keskikohta), 15
RETURN
piirra.ukko:
'Ukon piirto...
CIRCLE (x, y - 5), 3, 15
LINE (x, y - 2)-(x, y + 8), 15
LINE (x, y + 8)-(x - jalka, y + 8 + 5), 15
LINE (x, y + 8)-(x + jalka, y + 8 + 5), 15
IF kallistu <> 3 AND kallistu <> 4 THEN seivas.x = x: seivas.y = y
IF a = 0 THEN jalka = jalka + 1: IF jalka > 5 THEN a = 1
IF a = 1 THEN jalka = jalka - 1: IF jalka < 1 THEN a = 0
RETURN
piirra.kentta:
'Kentän piirto
LINE (5, 5)-(634, 474), 4, B
LINE (6, 100)-(633, 100), 1
LINE (6, 101)-(633, 473), 2, BF
LINE (6, 6)-(633, 100), 1, BF
LINE (6, 300)-(633, 340), 6, BF
LINE (500, 290)-(570, 340), 9, BF
LINE (500, 290)-(570, 340), 0, B
LINE (500, 325)-(570, 325), 0
LINE (480 + 11, 300 - kork * 2.5)-(485 + 11, 340 - kork * 2.5), 8
LINE (480 + 11, 300)-(480 + 11, 300 - kork * 2.5 - 6), 15
LINE (485 + 11, 340)-(485 + 11, 340 - kork * 2.5 - 6), 15
RETURN
'Ja näitä ei tarvitse edes selittää...
failed:
CLS
COLOR 2
PRINT "Hävisit!"
END
woohoo:
CLS
starprint 10, "ONNISTUIT!", 14, 13
PLAY "L3C"

Aliohjelma

SUB starprint (y, text$, v1, v2)
COLOR v1
LOCATE y
FOR l = 1 TO 80
PRINT "*";
NEXT
COLOR v2
LOCATE y, 80 - 40 - LEN(text$) / 2
PRINT text$
END SUB

Antti Laaksonen [28.02.2002 20:19:11]

#

Fysiikka ja pelattavuus on hyvää, mutta grafiikka vilkkuu ikävästi. Vaan teitpä tämän nopeasti.

Lare [13.05.2002 18:15:07]

#

VÄHÄN HIDAS

Ville Kumpulainen [23.05.2002 14:59:59]

#

Loistava...

HtH [23.08.2002 23:16:00]

#

Mikäs ongelma Larella on jokaiseen vinkkiin valittaa isoilla kirjaimilla?

Lare [13.09.2002 17:54:13]

#

Se on tapa. Jos joku on tutustunut nettikettiin tietää mitä tarkoitan

Jakezu91 [16.06.2003 14:59:36]

#

Hyvä...

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta