Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: QB: Matopeli

Sivun loppuun

odys [26.06.2003 03:34:09]

#

Näitä matopelejä täällä riittää jo vaikka kuinka paljon, mutta tein nyt kuitenkin omani harjoitusmielessä. Ja kaippa tästä voi olla jollekkin jotain hyötyä.

Pitäisi kääntyä QBasic 4.5:lla ainakin.

DECLARE FUNCTION CheckFood (direction AS INTEGER, x AS INTEGER, y AS INTEGER)
DECLARE FUNCTION CheckWall (direction AS INTEGER, x AS INTEGER, y AS INTEGER)
DECLARE SUB EndGame (score AS INTEGER)
DECLARE SUB PauseGame ()

TYPE xy
  x AS INTEGER
  y AS INTEGER
END TYPE

DIM worm(1 TO 10000) AS xy
DIM food AS xy
DIM speed AS INTEGER
DIM direction AS INTEGER
DIM length AS INTEGER
DIM score AS INTEGER
DIM growing AS INTEGER
DIM ok AS INTEGER

speed = 50
direction = 1
length = 15
score = 0
growing = 30

FOR i = 1 TO length
  worm(i).x = 100
  worm(i).y = 100 + i
NEXT i

RANDOMIZE TIMER

CLS
SCREEN 13

PRINT "Peli alkaa kun painat nappia"

DO
LOOP UNTIL INKEY$ <> ""

LOCATE 2, 1
PRINT "Peli alkaa... 2"
SLEEP (1)
LOCATE 2, 1
PRINT "Peli alkaa... 1"
SLEEP (1)
LOCATE 2, 1
PRINT "Peli alkaa... 0"
FOR i = 0 TO 1000
  WAIT &H3DA, 8
NEXT i
CLS

LINE (1, 1)-(200, 140), 4, B
LINE (50, 35)-(50, 105), 4
LINE (150, 35)-(150, 105), 4

GOSUB DrawWorm
GOSUB MakeFood

DO

  LINE (1, 1)-(200, 140), 4, B
  LINE (50, 35)-(50, 105), 4
  LINE (150, 35)-(150, 105), 4


  SELECT CASE INKEY$
  CASE CHR$(0) + CHR$(75)
    IF direction <> 2 THEN direction = 0
  CASE CHR$(0) + CHR$(72)
    IF direction <> 3 THEN direction = 1
  CASE CHR$(0) + CHR$(77)
    IF direction <> 0 THEN direction = 2
  CASE CHR$(0) + CHR$(80)
    IF direction <> 1 THEN direction = 3
  CASE CHR$(27)
    EndGame (score)
  CASE CHR$(80)
    PauseGame
  CASE CHR$(112)
    PauseGame
  END SELECT

  IF CheckFood(direction, worm(1).x, worm(1).y) = 1 THEN
    GOSUB MakeFood
    SOUND 1000, 1
    LOCATE 2, 27
    score = score + 100
    PRINT "Pisteet:"; score
    length = length + growing
  END IF

  IF CheckWall(direction, worm(1).x, worm(1).y) = 1 THEN
    EndGame (score)
  END IF

  GOSUB MoveWorm

  GOSUB DrawWorm

  FOR i = 0 TO speed
    WAIT &H3DA, 8
  NEXT i

LOOP

DrawWorm:
  PSET (worm(length).x, worm(length).y), 0
  FOR i = 1 TO 4
    PSET (worm(i).x, worm(i).y), 5
  NEXT i
  FOR i = 5 TO length - 1
    PSET (worm(i).x, worm(i).y)
  NEXT i
RETURN

MakeFood:
  tfoodx = food.x
  tfoody = food.y
  DO
    ok = 1
    food.x = INT(RND * 160) + 20
    food.y = INT(RND * 100) + 20
    FOR i = (food.x - 5) TO (food.x + 5)
      IF POINT(i, food.y) <> 0 THEN ok = 0
    NEXT i
    FOR i = (food.y - 5) TO (food.y + 5)
      IF POINT(food.x, i) <> 0 THEN ok = 0
    NEXT i
  LOOP UNTIL ok = 1
  DRAW "BM=" + VARPTR$(tfoodx) + ",=" + VARPTR$(tfoody)
  DRAW "P0,0"
  CIRCLE (food.x, food.y), 4, 8
  DRAW "P8,8"
RETURN

MoveWorm:
  FOR i = length - 1 TO 1 STEP -1
    worm(i + 1).x = worm(i).x
    worm(i + 1).y = worm(i).y
  NEXT i
  SELECT CASE direction
  CASE 0
    worm(1).x = worm(2).x - 1
  CASE 1
    worm(1).y = worm(2).y - 1
  CASE 2
    worm(1).x = worm(2).x + 1
  CASE 3
    worm(1).y = worm(2).y + 1
  END SELECT
RETURN

FUNCTION CheckFood (direction AS INTEGER, x AS INTEGER, y AS INTEGER)
  SELECT CASE direction
  CASE 0
    IF POINT(x - 1, y) = 8 THEN CheckFood = 1
  CASE 1
    IF POINT(x, y - 1) = 8 THEN CheckFood = 1
  CASE 2
    IF POINT(x + 1, y) = 8 THEN CheckFood = 1
  CASE 3
    IF POINT(x, y + 1) = 8 THEN CheckFood = 1
  END SELECT
END FUNCTION

FUNCTION CheckWall (direction AS INTEGER, x AS INTEGER, y AS INTEGER)
  SELECT CASE direction
  CASE 0
    check = POINT(x - 1, y)
    IF check = 4 OR check = 15 OR check = 5 THEN CheckWall = 1
  CASE 1
    check = POINT(x, y - 1)
    IF check = 4 OR check = 15 OR check = 5 THEN CheckWall = 1
  CASE 2
    check = POINT(x + 1, y)
    IF check = 4 OR check = 15 OR check = 5 THEN CheckWall = 1
  CASE 3
    check = POINT(x, y + 1)
    IF check = 4 OR check = 15 OR check = 5 THEN CheckWall = 1
  END SELECT
END FUNCTION

SUB EndGame (score AS INTEGER)
  SOUND 150, 7
  SLEEP (1)
  CLS
  PRINT "Peli loppui!"
  PRINT "Sait"; score; "pistettä"
  END
END SUB

SUB PauseGame
  LOCATE 1, 34
  PRINT "PAUSED"
  SLEEP (1)
  DO
  LOOP UNTIL INKEY$ <> ""
  LOCATE 1, 34
  PRINT "      "
END SUB

odys [26.06.2003 16:46:21]

#

Olis ihan kiva kuulla teidän mielipide ja kommentti tästä pelistä :)

En ole ennen pelejä tehnyt ja tämä on ensimmäinen kunnon koodinpätkäni QBasicillä.

doubdeal [26.06.2003 19:20:07]

#

Tosi hyvä, erinomainen, suorastaan loistava! Täydellinen paitsi että madon pää sais olla saman värinen ku ruumis, pelikenttä sais olla pienempi tai mato isompi. Jos nämä muuttaa vielä niin jaksaisin pelata ehkäs 6000 pisteeseen! ;) no ei vaiskaan... on tämä ainakin parempi kuin muut Qbasicin matopelit!!!!

T.M. [26.06.2003 22:26:06]

#

kai se ihan hyvä sit oli, mut mun koneel en pystyny testaa ku se mato kuoli samantien ku se peli alko :S

odys [27.06.2003 00:37:15]

#

T.M. Vaihda speediä.
laita vaikka: speed = 200

Olli Vanhoja [27.06.2003 12:59:58]

#

Eiks ois parempi tehä semmonen koodi mil saa speedin tasattuu kaikil koneil jollain ajastimel?

odys [27.06.2003 13:17:38]

#

No kuten sanoin niin tämä on eka kunnon koodini ja ehkä jonain päivänä vielä osaisinkin semmosen väsätä. Sitten varmasti päivitän tätä vinkkiä.

Teme [27.06.2003 18:05:54]

#

Olihan se yksi parhaista matopeleistä (QBasicilla tehdyistä), joita olen koskaan pelannut.

Dude1 [27.06.2003 19:21:52]

#

Joo, olipahan nätti peli. Hidastuu vaan aika paljon kun mato kasvaa, mutta oli paras jota olen pelannut!

odys [27.06.2003 22:06:33]

#

Huomasin kaverin koneella saman hidastumis jutun.. omalla koneellani (P3 800MHz) ei hidastu vaikka mato kasvaa 3000 pikselin kokoiseksi.

Outoa kyllä. Taitaa olla AMD:n prossuilla tämä hidastumis bugi.

Niin ja tuossa pelissä on vielä pause ;)) Napii "p"

nippe [27.06.2003 22:10:35]

#

High Scores tohon viel ni sit se on hyvä

doubdeal [27.06.2003 23:34:23]

#

ja matoa paksummaks

T.M. [28.06.2003 00:35:04]

#

ihmekkään kun ei hidastunu kun vaihoin nopeutta pienempään, vaikka sitä olis pitäny suurentaa :D
aika outo systeemi... :P

maratti [28.06.2003 18:06:11]

#

Joo. On se loistava matopeli. Ja oli mullekin hyötyy! :)

snakari [29.06.2003 22:23:11]

#

joo. pistä sit seuraavaan versioon paxumpi mato ja sit 3d moottori ja highscore lista

odys [30.06.2003 00:04:56]

#

Jos toista versiota koskaan edes tulee ;)

blixt [30.06.2003 01:14:04]

#

Olihan toi ihan ok. Mato todellakin ois voinu olla paksumpi. ;)

kaviaari [10.07.2003 11:31:23]

#

todella hyvä peli

nomic [16.07.2003 00:37:15]

#

joo kiva oli ja hyvä ekaksi peliksi...siitä propsit
mutta ite lisäsin tohon alkuun pätkän että kun peli alkaa niin voi valita nopeuden numeroissa jne...
eli $ käyttöö :D

Touho [28.03.2004 18:30:50]

#

Hyvä! Mutta jäin kaipaamaan kommentteja.

herkko [28.05.2004 11:48:20]

#

Itse toteuttaisin hidastumisen seuraavalla koodilla:

hidastuksenalku = TIMER
hidastus = .01
DO
  hidastettu = TIMER
LOOP UNTIL hidastettu > hidastuksenalku + hidastus

Tollasen kun heität sopivaan paikkaan jotain lenkkiä niin se pysäyttää lenkin sadasosasekunniksi.. Ja näin se siis vaikuttaa aika suoraan pelin nopeuteen.. (ja pelin pitäisi pyöriä joka koneella suunnilleen samalla nopeudella..).

herkko [28.05.2004 11:52:25]

#

Mutta siis hyvä peli on!

miiro [30.05.2004 20:31:06]

#

aika hauska

eraggo [15.04.2005 22:46:20]

#

siis... ERITTÄIN hyvä esimerkki siitä, että QBasicillakin saa aikaan jotakin... "jatkojalostin" tota ihan huvikseen..
nyt siinä on 3 erinlaista sokkeloa... pitäisköhan laittaa nettiin exe-filua.... :P

Juhko [19.07.2006 22:10:47]

#

Miten ton saa niin, että sitä matoo voi ohjata?

Codeprofile [10.11.2006 21:39:15]

#

mulla toi mato menee sopivalla nopeudella kaks pykälää eteenpäin ja peli sulkeutuu. Käytän QB 4.5:tä.

Dude [25.02.2007 21:26:15]

#

ihan hyvä mutta liian nopiasti liikkuva mato.

Dain [14.06.2007 16:46:46]

#

Ihan hyvä mutta annatteko mun sähköpostiin jonkun osotteen mistä saa kääntöohjleman
sähköpostini:
matias.pigg@luukku.com

Clacier [12.02.2010 21:18:41]

#

Dude kirjoitti:

ihan hyvä mutta liian nopiasti liikkuva mato.

no hidasta sitä? :D


Sivun alkuun

Vastaus

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

Tietoa sivustosta