Keskustelu: Koodit: QB: Asteroids

'Elikkäs tässä on minun ASTEROIDS-klooni
'ei toimi ihan samoin kuin esikuvansa, sillä vauhtia voi tässä myös hidastaa jne mutta yhteistä on ainakin obstaakkeleiden seassa lentely

'napit on
'ylöös: lisää kaasua
'alaas: vähemmän kaasua
'vasen ja oikea: väistöliikkeet (kääntyminen)
'enter tai space: ampus
'esc: lopetus

DECLARE SUB killasteroid (i!) 'asteroidin räjäytyssubi
DECLARE SUB newasteroid (x!, y!, hor!, ver!, radius!, nodes!, angle!, spin!, lifetime!) 'tekee uuden asteroidin ensimmäiseen vapaaseen asteroidipaikkaan
TYPE asteroidtype
    nodes AS INTEGER 'montako kulmaa
    x AS SINGLE
    y AS SINGLE
    angle AS SINGLE 'mintenkä asteroidi on pyörähtänyt
    hor AS SINGLE 'horisontaalinen liikkumisnopeus
    ver AS SINGLE 'vertikaalinen liikkumisnopeus
    spin AS SINGLE 'pyörimisnopeus
    radius AS SINGLE 'halkaisija pikseleinä
    lifetime AS INTEGER 'jos -1, asteroidi elää kunnes ammutaan, jos > 0 asteroidi elää niin monta framea kuin lifetime määrää (eli kyseessä on asteroidinsirpale, splintteri)
END TYPE

TYPE shottype
    x AS SINGLE
    y AS SINGLE
    angle AS SINGLE 'liikkumissuunta
    speed AS SINGLE
    lifetime AS INTEGER 'kuinka monta framea rojektiili lentelee vielä
END TYPE

'en ole laskenut noita boundeja, mutta niissä on kai reilusti pelivaraa. voi koittaa laskea jos kokee tarpeelliseksi
DIM SHARED asteroid(1 TO 999) AS asteroidtype
DIM SHARED shot(30) AS shottype

CONST factor = 3.141592 / 180

'pls = pelaajan nopeus
'pla = pelaajan liikkumissuunta asteina
'shotdelay = montako frame odotetaan ennen kuin voi ampua uudestaan
'throttle = kaasu (+ / - / off)
'turning = kääntyminen (vasen / oikea / off)
'throttlen ja turningin itseisarvo määrää kuinka monta framea niiden vaikutus kestää

SCREEN 7, , 1, 0 'toinen sivu on aktiivinen, toinen se mikä näytetään (olikohan nimeltään tuplabufferointi?)

'tilastotietoja
DIM SHARED frags AS INTEGER 'tuhottujen asteroidien lkm
DIM SHARED shots AS INTEGER 'ammutut laukaukset

pls = -2 'pelaajan nopeus (negatiivinen vie eteenpäin)
asteroids = 120 'asteroidin lukumäärä alussa
cx = 320 / 2: cy = 200 / 2 'kentän keskikohta

'asteroidien sijoittuminen kartalle
fieldwidth = 1000 'kartan leveys
fieldheight = 1000 'kartan pituus

    'tehdään aloitusasteroidit
    FOR i = 1 TO asteroids
        x = RND * fieldwidth - fieldwidth / 2 + cx
        y = RND * fieldheight - fieldheight / 2 + cy
        r = RND * 10 + 7 'säde
        newasteroid x, y, (RND - .5) / 5, (RND - .5) / 5, r, r * .7, RND * 360, RND * 10 - 5, -1
    NEXT

DIM foo AS STRING 'Foo = viimeksi painettu INKEY$
DO: foo = INKEY$

CLS

    'piirretään pelaajan vesseli ja käännetään sitä pelaajan liikkumiskulman mukaan
    a = (pla - 90) * factor
    x1 = COS(a) * 15 + cx
    y1 = SIN(a) * 15 + cy

    a = (pla + 90) * factor
    x4 = COS(a) * 5 + cx
    y4 = SIN(a) * 5 + cy

    a = (pla + 90 + 45) * factor
    x2 = COS(a) * 15 + cx
    y2 = SIN(a) * 15 + cy

    a = (pla + 90 - 45) * factor
    x3 = COS(a) * 15 + cx
    y3 = SIN(a) * 15 + cy

    LINE (x1, y1)-(x2, y2), 1
    LINE (x2, y2)-(x4, y4), 1
    LINE (x1, y1)-(x3, y3), 1
    LINE (x4, y4)-(x2, y2), 1
    LINE (x4, y4)-(x3, y3), 1

    PAINT (cx, cy), 11, 1

    'lasketaan, kuinka paljon asteroideja täytyy liikuttaa
    '(on simppelinpää tehdä se näin että asteroidit liikkuvat eikä pelaaja)
    a = (pla - 90) * factor
    x = COS(a) * pls
    y = SIN(a) * pls

    'silmukka jokaiselle asteroidille
    FOR i = 1 TO UBOUND(asteroid)
        IF asteroid(i).radius > 0 THEN
            'liikutetaan asteroidia sekä pelaajan että asteroidin nopeuden perusteella
            asteroid(i).x = asteroid(i).x + x + asteroid(i).hor
            asteroid(i).y = asteroid(i).y + y + asteroid(i).ver

            'katotaan ettei asteroid(i).angle ylitä 360 ja käännetään asteroidia
            asteroid(i).angle = asteroid(i).angle MOD 360
            asteroid(i).angle = asteroid(i).angle + asteroid(i).spin

            IF asteroid(i).lifetime > 0 THEN
                asteroid(i).lifetime = asteroid(i).lifetime - 1
                IF asteroid(i).lifetime <= 0 THEN asteroid(i).radius = 0 'hävitetään asteroidinsirpale kun se on riehunut kentällä riittävän kauan
            END IF

            'määrätään asteroideille eri piirtoväri kuin sirpaleille selvyyden vuoksi
            IF asteroid(i).lifetime = -1 THEN fill = 7: border = 8 ELSE fill = 8: border = 1

            'piirretään monikulmio eli asteroidi
            FOR a = asteroid(i).angle TO 360 + asteroid(i).angle STEP 360 / asteroid(i).nodes
                x1 = COS(a * factor) * asteroid(i).radius + asteroid(i).x
                y1 = SIN(a * factor) * asteroid(i).radius + asteroid(i).y

                a2 = a - (360 / asteroid(i).nodes)
                x2 = COS(a2 * factor) * asteroid(i).radius + asteroid(i).x
                y2 = SIN(a2 * factor) * asteroid(i).radius + asteroid(i).y

                LINE (x1, y1)-(x2, y2), border
            NEXT
            'täytetään monikulmio eli asteroidi (omg :p)
            PAINT (asteroid(i).x, asteroid(i).y), fill, border

            'mitataan asteroidin etäisyys pelaajan pythagoraan käskyllä a^2 + b^2 = c^2
            ex = asteroid(i).x - cx: ey = asteroid(i).y - cy
            dist = SQR(ex * ex + (ey * ey))
            IF dist < asteroid(i).radius + 3 AND asteroid(i).lifetime <= 0 THEN killasteroid i: EXIT DO
        END IF
    NEXT

    'silmukka ampuksille
    FOR i = 0 TO UBOUND(shot)
        IF shot(i).lifetime > 0 THEN
            'jotta ammus ei lentelisi loputtomiin vähennetään lifetimeä:
            shot(i).lifetime = shot(i).lifetime - 1
            'liikutetaan ampusta
            a = (shot(i).angle - 90) * factor
            shot(i).x = COS(a) * shot(i).speed + shot(i).x
            shot(i).y = SIN(a) * shot(i).speed + shot(i).y

            'piirretään komea KELTAINEN lasersäde:
            a = (shot(i).angle + 90) * factor
            LINE (shot(i).x, shot(i).y)-(COS(a) * 5 + shot(i).x, SIN(a) * 5 + shot(i).y), 14

            'tarkistetaan mahd. osuma asteroidiin
            FOR d = 1 TO UBOUND(asteroid)
                IF asteroid(d).radius > 0 THEN
                    'jos asteroidi elää, mitataan sen etäisyys ammukseen:
                    ex = asteroid(d).x - shot(i).x: ey = asteroid(d).y - shot(i).y
                    dist = SQR(ex * ex + (ey * ey))
                    'jos osuma, tapetaan asteroidi ja ammus
                    IF dist < asteroid(d).radius AND asteroid(d).lifetime <= 0 THEN
                        killasteroid d 'tuhoa asteroidi
                        shot(i).lifetime = 0 'hävitä ammus
                        exit for 'älä tarkista uusia asteroiditörmäyksiä tälle samalle ammukselle, muuten tämä ammus tuhoaisi killasteroid-subissa syntyvät asteroidinsirpaleet
                    END IF
                END IF
            NEXT
        END IF
    NEXT

    'kiihdytetään (nopeudellisesti) ja käännetään pelaajaa (melkein purkkaa mutta ei ihan)
    'jos throttle != 0, throttlea lähennetään kohti nollaa ja kiihdytetään pelaajan vauhtia (pls on siis pelaajan nopeus)
    IF throttle <> 0 THEN
        throttle = throttle - SGN(throttle)
        pls = pls - SGN(throttle) / 25
    ELSE
        'tämä on kitkaefekti (en tiedä onko validi mutta toimii ja on järkeenkäypä)
        pls = pls - (.0005 * SGN(pls))
        IF ABS(pls) < .0005 THEN pls = 0
    END IF

    'pelaajan kääntäminen toimii samalla tavalla kuin yllä paitsi että kitkavaikutus on otettu pois
    '(tietenkin, muutenhan nokka hakeutuisi kokoajan pohjoiseen, eikä sitä haluta)
    IF turning <> 0 THEN
        turning = turning - SGN(turning)
        pla = pla + SGN(turning) * 5
    END IF

    'napit
    SELECT CASE INP(&H60)
        CASE 75: turning = -2 'vasen
        CASE 72: throttle = 10 'ylös
        CASE 77: turning = 2 'oikea
        CASE 80: throttle = -10 'alas
        CASE 28, 57: 'käysisään tai avaruus
            IF shotdelay <= 0 THEN
                'etsitään eka tyhjä ammus (joka ei ole liikenteessä) ja lähetetään se matkaan
                FOR i = 0 TO UBOUND(shot)
                    IF shot(i).lifetime <= 0 THEN
                        shot(i).lifetime = 32 'ammus lentää 32 frame eli lifetime * speed pikselin matkan
                        shot(i).x = cx
                        shot(i).y = cy
                        shot(i).angle = pla
                        shot(i).speed = 3
                        EXIT FOR
                    END IF
                NEXT
                shotdelay = 5 'milloin voidaan ampua uusiks?
                shots = shots + 1
            END IF
    END SELECT
    IF shotdelay > 0 THEN shotdelay = shotdelay - 1

    'tehdään kuvalle raamit koska muuten PAINT sekoilisi (voit testata miten jos otat 2 riviä alta poies)
    LINE (10, 10)-(309, 189), 1, B
    PAINT (1, 1), 1

    PCOPY 1, 0 'nyt kun piiräminen on valmis, siirretään piirretty kuva näkyviin

    'tässä on delay hidastamaan turhan nopeeta juoksua
    alkuaika = TIMER
    DO: LOOP UNTIL TIMER - alkuaika => .01

LOOP UNTIL foo$ = CHR$(27)
SCREEN 0, , 0, 0
WIDTH 80, 25
CLS
COLOR 15
PRINT "NYT TULI KOLLIISSIO :("
PRINT ""
PRINT "Ampuksia:"; shots
PRINT "Kaatoja:"; frags; "/"; asteroids
PRINT
PRINT
'lasketaan accuracy eli osumistarkkuusprossa:
IF shots = 0 THEN a = 0 ELSE a = INT(frags / shots * 1000) / 10
PRINT "  OSUMISTARKKAILU:"; a; "%"
COLOR 8: LOCATE 23, 53: PRINT "Puhveli teki 10.3.2005"
SLEEP
COLOR 7: CLOSE : END: STOP: SYSTEM

SUB killasteroid (i)
'tämä subi räjäyttää asteroidin kirjaimellisesti palasiksi
'i = asteroidin arrayindexi

    IF asteroid(i).lifetime = -1 THEN
        IF asteroid(i).radius > 11 THEN
            'jos asteroidi on iso, se halkeaa kahtia
            FOR CountDown = 1 TO 2
                a = RND * 360 * factor
                s = RND * 1.5
                newasteroid asteroid(i).x, asteroid(i).y, COS(a) * s, SIN(a) * s, asteroid(i).radius * .8, RND * 4 + 4, RND * 360, RND * 40 - 20, -1
            NEXT
        END IF
        'tehdään asteroidille sirpaleita (niiden lukumäärä riippuu asteroidin koosta)
        FOR CountDown = 1 TO asteroid(i).radius / 3 + 2
            a = RND * 360 * factor
            s = RND * 4 + 1
            newasteroid asteroid(i).x, asteroid(i).y, COS(a) * s, SIN(a) * s, RND * 4 + 2, RND * 3 + 3, RND * 360, RND * 40 - 20, RND * 30 + 5
        NEXT
    END IF
    asteroid(i).radius = 0
    frags = frags + 1

END SUB

SUB newasteroid (x, y, hor, ver, radius, nodes, angle, spin, lifetime)

    'etsitään ensimmäinen vapaa asteroidipaikka ja länttäistään asteroidin tiedot siihen
'(vihaan tätä vaihetta, siinä on liikaa monotonista kirjoittamista, mutta jonkun minun sen on tehtävä)
    FOR i = 1 TO UBOUND(asteroid)
        IF asteroid(i).radius = 0 THEN
            asteroid(i).x = x
            asteroid(i).y = y
            asteroid(i).hor = hor
            asteroid(i).ver = ver
            asteroid(i).radius = radius
            asteroid(i).nodes = nodes
            asteroid(i).angle = angle
            asteroid(i).spin = spin
            asteroid(i).lifetime = lifetime
            EXIT SUB
        END IF
    NEXT

END SUB

'Huhhuh se on siinä. Tulipas kommentoitua