Keskustelu: Koodit: QB: Noppalausekkeenlaskija

FUNCTION noppa% (lause$)

DEFINT A-Z      'koska käytetään kokonaislukuja
                'niin asetetaan nämä muuttujat
                'kokonaisluvuiksi.

lause$ = LTRIM$(RTRIM$(lause$))     'varmuuden vuoksi karsitaan
                                    'välilyönnit alusta ja lopusta

FOR i = 1 TO LEN(lause$)            'tähän voisi käyttää myös whilea
    kirjain$ = MID$(lause$, i, 1)   'leikataan yksi kirjain

    IF LCASE$(kirjain$) <> "d" THEN    'jos kirjain ei ole d
        kertoja$ = kertoja$ + kirjain$ 'merkitään muistiin numero
    ELSE EXIT FOR                      'mutta jos on, siirrytään
    END IF                             'seuraavaan
NEXT i

in = i

FOR i = i + 1 TO LEN(lause$)           'jatketaan d-kohdan jälkeen
    kirjain$ = MID$(lause$, i, 1)      'kopioidaan taas yksi kirjain

    'jos se ei ole + tai -
    IF LCASE$(kirjain$) <> "+" OR LCASE$(kirjain$) <> "-" THEN
        sivuja$ = sivuja$ + kirjain$    'merkitään numero muistiin
        in = in + 1
    ELSE EXIT FOR                       'muuten mennään seuraavaan
    END IF
NEXT i

muutos$ = MID$(lause$, in - 1)          'lauseen lopun täytyy olla
                                        'muutos

LET tulos = 0

k = VAL(kertoja$)   ' siistitään vähän ja siirretään tekstit
m = VAL(muutos$)    ' numeromuuttujiin
s = VAL(sivuja$)

FOR i = 1 TO k      ' sitten arvotaan k kertaa
    tulos = tulos + (INT(RND * s) + m + 1)
NEXT i

noppa = tulos       'palautetaan tulokset

DEFSNG A-Z

END FUNCTION

' Noppalausekkeenlaskija ja hieno demopeli
'
' Tehnyt DSword <dsword@mbnet.fi>
' Koodia saa käyttää täysin vapaasti

DECLARE FUNCTION noppa% (lause$)

RANDOMIZE TIMER     'alustetaan satunnaislukugeneraattori

TYPE ASETYPE        'type aseelle
    nimi  AS STRING * 12
    teho  AS STRING * 12
END TYPE

TYPE OLENTOTYPE     'type hirviölle
    kesto AS INTEGER
    ase   AS ASETYPE
    suoja AS INTEGER
END TYPE

DIM oma     AS OLENTOTYPE   'tämä on siis minä itse
DIM hirvio  AS OLENTOTYPE   'ja tämä vihulainen

oma.kesto = 20              'asetetaan sitten hirviöiden
oma.ase.nimi = "Kivikeihäs" 'ominaisuudet
oma.ase.teho = "1d6+1"      'Aseet on kopioitu Seppo Suorsan
oma.suoja = 5               'mainiosta pelistä Areena 5

hirvio.kesto = 20
hirvio.ase.nimi = "Moukari"
hirvio.ase.teho = "2d6"
hirvio.suoja = 1

DO

CLS
PRINT "  Oma kesto: "; oma.kesto        'tulostetaan
PRINT "Mörön kesto: "; hirvio.kesto     'tilanne
PRINT

PRINT "Valitse:"            'mitähän tässä
PRINT "1. Hyökkää"          'tapahtuu?
PRINT "2. Pakene"

valikko:

'odotetaan niin kauan että käyttäjä painaa
'jotain nappia
DO: nappi$ = INKEY$: LOOP UNTIL nappi$ <> ""

SELECT CASE nappi$
    CASE "1"
        'HYÖKKÄYKSEEN!

        hyokkays = noppa(oma.ase.teho)  'paljonko tulee vahinkoa
        'sitten paljonko haarniska suojaa
        suojus = noppa("1d" + LTRIM$(STR$(hirvio.suoja + 1)) + "-1")
        vahinko = hyokkays - suojus     'lopputulos

        IF vahinko < 0 THEN vahinko = 0 'jos vahinko on alle 0 niin se
                                        'on 0, muuteen hirviö
                                        'saa kestoa takaisin

        hirvio.kesto = hirvio.kesto - vahinko
                                        'vähännetään hirviön kestosta
                                        'vahinko

        'ja sitten tulostetaan tietoa
        PRINT
        PRINT "Hyökkäät aseellasi " + RTRIM$(oma.ase.nimi);
        PRINT " (" + RTRIM$(oma.ase.teho); ") ";
        PRINT "ja teet vahinkoa"; hyokkays; "pisteen verran.";
        PRINT "Hirviön haarniska suojaa"; suojus; "pisteen verran, ";
        PRINT "joten hirviö kärsii vahinkoa"; vahinko; "pisteen verran";

        IF hirvio.kesto <= 0 THEN
            'jos se mörhelö kuoli, tiedotetaan ja lopetetaan.
            PRINT " ja kuolee. Onneksi olkoon, voitit sen."
            EXIT DO
        ELSE PRINT "."

        END IF
        PRINT
        PRINT "Paina jotain."
        SLEEP

    CASE "2"
        'PAKOON!
        pako = noppa("1d5")    'paon todennäköisyys on 20 %

        PRINT

        IF pako = 1 THEN
            'jos tulee 1, niin kerrotaan asiasta
            'hirviön nimi on Aku Ankan Taskukirjasta 248
            'tarinasta Kultainen niili, jonka on käsikirjoittanut
            'Francois Corteggiani ja piirtänyt Giorgio Cavazzano
            'nimi on sivulla 55

            PRINT "Onnistut pakeneman Lualuban baobabpuissa";
            PRINT "asuvaa vaapsajalkaista etoölliäistä. ";
            PRINT "Valitettavasti, samalla kun vilkaiset taakses, ";
            PRINT "seuraako hirviö sinua, kompastut ja lennähdät ";
            PRINT "pohjattomaan rotkoon, jonka pohjalla on veitsenteräviä ";
            PRINT "(ja nyt ei puhuta sinun linkkuveitsestäsi) piikkejä. ";
            PRINT "Niinpä harmillisesti kuolet."
            EXIT DO 'ja lopetetaan
        ELSE
            'jos ei, niin kerrotaan asiasta
            PRINT "Et onnistu pakenemaan.";
            PRINT
            PRINT "Paina jotain."
            SLEEP
        END IF
    CASE ELSE: GOTO valikko     'jos käyttäjä ei paina 1
                                'tai 2, takaisin alkuun.
END SELECT

'sitten hirviö hyökkää.
'koodi on sama kuin pelaajan hyökkäys
'paitsi että on toiset arvot käytössä
'(ja infotekstiä muutettu)
hyokkays = noppa(hirvio.ase.teho)
suojus = noppa("1d" + LTRIM$(STR$(oma.suoja + 1)) + "-1")
vahinko = hyokkays - suojus
IF vahinko < 0 THEN vahinko = 0
oma.kesto = oma.kesto - vahinko

PRINT
PRINT "Hirviö hyökkää aseellaan " + RTRIM$(hirvio.ase.nimi);
PRINT " (" + RTRIM$(hirvio.ase.teho); ") ";
PRINT "ja tekee vahinkoa"; hyokkays; "pisteen verran.";
PRINT "Haarniskasi suojaa"; suojus; "pisteen verran, ";
PRINT "joten kärsit vahinkoa"; vahinko; "pisteen verran";

IF oma.kesto <= 0 THEN
    PRINT " ja kuolet. Epäonneksi olkoon, sillä hävisit juuri."
    EXIT DO
ELSE PRINT "."

END IF

PRINT
PRINT "Paina jotain."
SLEEP

LOOP

FUNCTION noppa% (lause$)

DEFINT A-Z      'koska käytetään kokonaislukuja
                'niin asetetaan nämä muuttujat
                'kokonaisluvuiksi.

lause$ = LTRIM$(RTRIM$(lause$))     'varmuuden vuoksi karsitaan
                                    'välilyönnit alusta ja lopusta

FOR i = 1 TO LEN(lause$)            'tähän voisi käyttää myös whilea
    kirjain$ = MID$(lause$, i, 1)   'leikataan yksi kirjain

    IF LCASE$(kirjain$) <> "d" THEN    'jos kirjain ei ole d
        kertoja$ = kertoja$ + kirjain$ 'merkitään muistiin numero
    ELSE EXIT FOR                      'mutta jos on, siirrytään
    END IF                             'seuraavaan
NEXT i

in = i

FOR i = i + 1 TO LEN(lause$)           'jatketaan d-kohdan jälkeen
    kirjain$ = MID$(lause$, i, 1)      'kopioidaan taas yksi kirjain

    'jos se ei ole + tai -
    IF LCASE$(kirjain$) <> "+" OR LCASE$(kirjain$) <> "-" THEN
        sivuja$ = sivuja$ + kirjain$    'merkitään numero muistiin
        in = in + 1
    ELSE EXIT FOR                       'muuten mennään seuraavaan
    END IF
NEXT i

muutos$ = MID$(lause$, in - 1)          'lauseen lopun täytyy olla
                                        'muutos

LET tulos = 0

k = VAL(kertoja$)   ' siistitään vähän ja siirretään tekstit
m = VAL(muutos$)    ' numeromuuttujiin
s = VAL(sivuja$)

FOR i = 1 TO k      ' sitten arvotaan k kertaa
    tulos = tulos + (INT(RND * s) + m + 1)
NEXT i

noppa = tulos       'palautetaan tulokset

DEFSNG A-Z

END FUNCTION