Minigolf peli

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
mza
Newcomer
Posts: 20
Joined: Mon Aug 27, 2007 11:34 pm

Minigolf peli

Post by mza » Wed Apr 08, 2009 8:17 pm

Yksinkertainen minigolf peli, johon jokainen voi piirto-ohjelmalla väsätä omia ratoja. Radat toimivat kunhan maastossa ei ole liian jyrkkiä korkeuseroja. Vihreä värikomponentti kuvassa määrää maaston korkeuden, sininen väri tarkoittaa lähtöpaikkaa, punainen koloa ja kirkkain mahdollinen vihreä on seinää. 8-)

Code: Select all

SCREEN 1024,768
FrameLimit 60

Dim piste(1,1) //pistetaulukko, joka kertoo jokaisen kartan pisteen korkeuden, seinät, lähtöalueen ja reiän paikan
Dim vx As Float //pallon nopeus x-suunnassa
Dim vy As Float //pallon nopeus y-suunnassa
Dim xx As Float //pallon sijainti x-suunnassa
Dim yy As Float //pallon sijainti y-suunnassa
Dim d As Float
Dim position(2,41)

Const maxhitspeed=2.0 //suurin sallittu lyöntinopeus

//määritetään kartan koko 
mwid=384
mhei=384
ReDim piste(mwid,mhei)

mapfile$="media\testmap2.png" //kartan nimi
If FileExists(mapfile)=0 Then MakeError "Karttaa ei löydy."
malli=LoadImage(mapfile) //ladataan korkeuskartta
kartta=MakeImage(mwid*2,mhei*2) //tähän kuvaan piirretään korkeuskartan perusteella varsinainen kartta


//-------------
//Kartan lataus
//-------------

//tässä tallennetaan korkeuskartasta tiedot taulukkoon
//voit ehkä nopeuttaa toimintoa käyttämällä getpixel2 -komentoa tai laskemalla GetPixel-komennon avulla saadusta pikseliarvosta
//värikomponentit suoraan
For x=1 To mwid
    DrawImage malli,0,0
    For y=1 To mhei
        Color 0,0,GetPixel(x,y) 
        piste(x,y)=getRGB(GREEN) 'kartan korkeus on vihreän värikomponentin määrä
        If piste(x,y)>240 Then piste(x,y)=300:Goto seur 'yli 240:n oleva vihreä komponentti tarkoittaa seinää
        If getRGB(RED)>240 Then piste(x,y)=257 'punainen on kolo
        If getRGB(BLUE)>240 Then piste(x,y)=258 'sininen on lähtöpaikka
        seur:
    Next y
    If Timer()>aika+100 Then
        Cls
        Color 255,255,255
        Text 384,0,"Ladataan rataa..."+x*100/(mwid*2)+"%"
        DrawScreen
        aika=Timer()
    EndIf
Next x
//Tässä piirretään kartta taulukon tietojen perusteella. Ohjelman voisi myös toteuttaa siten, että ladataan varsinainen
//karttakuva toisesta kuvasta, eikä generoida korkeuskartan perusteella.
For x=1 To mwid
    DrawToImage kartta
    For y=1 To mhei
        If piste(x,y)<240 Then 
            Color 0,piste(x,y)+10,0 'maa vihreällä
            ElseIf piste(x,y)=257 Then
            Color 0,0,0 'kolo mustalla
            maaliLoytyi=1
            ElseIf piste(x,y)=258 Then
            Color 100,150,100 'aloituspaikka
            startx=x*2
            starty=y*2
            Else
            Color 155,100,55 'seinät ruskealla
        EndIf
        Box x*2,y*2,2,2
    Next y
    DrawToScreen
    If Timer()>aika+100 Then
        Cls
        Color 255,255,255
        Text 384,0,"Ladataan rataa..."+(mwid+x)*100/(mwid*2)+"%"
        DrawScreen
        aika=Timer()
    EndIf
Next x
//piirretään kartan reunat
DrawToImage kartta
    Color 155,100,55
    Box 0,0,mwid*2,3
    Box 0,mhei*2-3,mwid*2,3
    Box 0,0,3,mhei*2
    Box mwid*2-3,0,3,mhei*2
DrawToScreen

If startx=0 Or starty=0 Then MakeError "Kartassasi ei ole lähtöpaikkaa."
If maaliLoytyi=0 Then MakeError "Kartassasi ei ole koloa."

xx=startx
yy=starty


//----------------
//Varsinainen peli
//----------------

Repeat
    //fysiikka
    x=Int(xx)
    y=Int(yy)
    For k=1 To 5 'liikutetaan palloa 5 kertaa loopissa tarkemman törmäystunnistuksen saamiseksi
        //törmäykset kartan reunoihin
        If x<3 Then
            x=3
            If vx<0 Then vx=-vx*.7
        EndIf
        If x>mwid*2-3 Then
            x=mwid*2-3
            If vx>0 Then vx=-vx*.7
        EndIf
        If y<3 Then
            y=3
            If vy<0 Then vy=-vy*.7
        EndIf
        If y>mhei*2-3 Then
            y=mhei*2-3
            If vy>0 then vy=-vy*.7
        EndIf
        //selvitetään kartan korkeus pallon alla
        If piste(x/2,y/2)<240 Then
            korkeus=piste(x/2,y/2)
        EndIf
        //liikutetaan palloa kartanmuotojen mukaisesti
        If piste(x/2,y/2)=257 Then MakeError "Kolossa! "+l+" lyöntiä"
        If piste(x/2-1,y/2)<korkeus And Abs(korkeus-piste(x/2-1,y/2))<10 Then vx=vx-.001*(korkeus-piste(x/2-1,y/2)) 'korkeuserot
        If piste(x/2+1,y/2)<korkeus And Abs(korkeus-piste(x/2+1,y/2))<10 Then vx=vx+.001*(korkeus-piste(x/2+1,y/2))
        If piste(x/2,y/2-1)<korkeus And Abs(korkeus-piste(x/2,y/2-1))<10 Then vy=vy-.001*(korkeus-piste(x/2,y/2-1))
        If piste(x/2,y/2+1)<korkeus And Abs(korkeus-piste(x/2,y/2+1))<10 Then vy=vy+.001*(korkeus-piste(x/2,y/2+1))
        If piste(x/2-1,y/2)>299 And vx<0 Then vx=-vx*.7'seinään törmäämiset
        If piste(x/2+1,y/2)>299 And vx>0 Then vx=-vx*.7
        If piste(x/2,y/2-1)>299 And vy<0 Then vy=-vy*.7
        If piste(x/2,y/2+1)>299 And vy>0 Then vy=-vy*.7
        xx=xx+vx 'pallon liikuttaminen
        yy=yy+vy
        x=Int(xx)
        y=Int(yy)
    Next k
    vx=vx*.98
    vy=vy*.98
    //tutkitaan onko pallo liikkunut viimeisen 40 ruudun aikana
    palloLiikkuu=0
    aika=aika+1
    If aika>40 Then aika=1
    position(1,aika)=x
    position(2,aika)=y
    For z=1 To 39
        If Abs(position(1,z)-position(1,20))>1 Then palloLiikkuu=1   
        If Abs(position(2,z)-position(2,20))>1 Then palloLiikkuu=1 
    Next z
    //piirtokomennot
    DrawImage kartta,0,0
    Color 255,255,255
    Circle x-3,y-3,6
    If palloLiikkuu=0 Then Line x,y,MouseX(),MouseY()
    Text 0,0,"FPS: "+FPS()
    Text 100,0,"Lyöntejä: "+l
    DrawScreen
    //kontrollit
    If MouseHit(1) And palloLiikkuu=0 Then 'lyödään palloa painamalla hiiren nappia, jos pallo ei ole liikkunut vähään aikaan
        vx=.005*(MouseX()-x)
        vy=.005*(MouseY()-y)
        l=l+1 'l on lyöntien määrä
        d=Distance(0,0,vx,vy)
        If d>maxhitspeed Then
            vx=vx/(d/maxhitspeed)
            vy=vy/(d/maxhitspeed)
        EndIf
    EndIf
Forever
Lataa esimerkkirata (par 4 on ehkä vähän optimistinen tavoite :lol: )

User avatar
skinkken
Advanced Member
Posts: 453
Joined: Sat Sep 01, 2007 4:00 pm
Location: Helsinki

Re: Minigolf peli

Post by skinkken » Wed Apr 08, 2009 9:31 pm

Ihan kauanhan tuon kanssa jaksoi leikkiä. :)
Mäet olivat hyvä lisäys, jota ei useimmissa cb-golfeissa näe.
Valmiit pelit: House of Horrors , Battle Zone , Über Ball , Itdoti , Space Chaos , Bloxxplosives
Projekti jota teen ehkä joskus vielä: viewtopic.php?f=11&t=2636 <-- Tämä rivi päivitetty 14.1.2013

Post Reply