Pikku pelit

Jaa meneillään olevat projektisi tai valmiit pelit muun yhteisön kanssa täällä.
aJonhu

Re: Pikku pelit

Post by aJonhu »

Tälläsen minipelin tein vähän kuumeisena =/
Koodin ulkoasu on kauhea, mutta en nyt jaksanut alkaa hionostella.
Oma ennätys pelissä ~2,8 pikseliä.

Code: Select all

SCREEN 800,600
AddText "Yritä asettaa ruksi mahdollisimman keskelle ympyrää!"

ruksi=MakeImage(10,10)
DrawToImage ruksi
    Color cbred : Line 0,0,10,10 : Line 10,0,0,10
DrawToScreen

ShowMouse OFF
Const ympkoko=450
Const ympX = 100 
Const ympY = 100

Repeat
    Circle ympX,ympY,ympkoko,0
    If MouseDown(1) Then px#=MouseX():py#=MouseY()
    If px#=0 And py#=0 Then DrawImage ruksi,MouseX(),MouseY() Else DrawImage ruksi,px#,py#
    DrawScreen
    If px#>0 And py#>0 Then tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi), py#+ImageHeight(ruksi)) : MakeError tex$
Forever

Function etaisyys(x1#, y1#, x2#, y2#)
    aa#=Distance(x1#, y1#, x2#, y2#)
    testi$="Etäisyys keskipisteestä oli: "+aa#+" pikseliä"
    Return testi$
EndFunction
Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Pikku pelit

Post by Jonhu »

Edellisessä oli pieni virhe..
Tuossa korjattuna: tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2)

Erityyppinen toinen versio:

Code: Select all

SCREEN 800,600
AddText "Yritä asettaa ruksi mahdollisimman keskelle ympyrää!"

ruksi=MakeImage(10,10)
DrawToImage ruksi
    Color cbred : Line 0,0,10,10 : Line 10,0,0,10
DrawToScreen

alku:
ShowMouse OFF
Const ympkoko=450
Const ympX = 100
Const ympY = 100
tee=0 : py#=0 : px#=0

Repeat
    Color cbred
    Circle ympX,ympY,ympkoko,0
    
    If MouseDown(1) And tee=0 And Distance(ympX+ympkoko/2, ympY+ympkoko/2, MouseX(), MouseY())<= ympkoko/2 Then 
        px#=MouseX() : py#=MouseY(): tee=2
    EndIf
    
    If tee=2 Then 
        tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2)
        tee=1
        ShowMouse ON 
    EndIf
    
    If px#>0 And py#>0 Then 
        Text 3,20,tex$
        Color cbdark : Line ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2
    EndIf
    
    If nappi(580,500,170,40,0,0,1,1)=1 Then Goto alku
    If px#=0 And py#=0 Then DrawImage ruksi,MouseX(),MouseY() Else DrawImage ruksi,px#,py#
    
    Color cbwhite: Text 597,510,"Yritä uudestaan"
    
    DrawScreen
    
Forever

Function etaisyys(x1#, y1#, x2#, y2#)
    aa#=Distance(x1#, y1#, x2#, y2#)
    testi$="Etäisyys keskipisteestä oli: "+aa#+" pikseliä"
    Return testi$
EndFunction

Function nappi(alkux,alkuy,kokox,kokoy,valiy,valix,maara,tayte)   
    For a=0 To maara-1
        Color cbred
        Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte
        Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte
        If MouseX()>alkux+valix*a And MouseX()<alkux+valix*a+kokox And MouseY()<alkuy+valiy*a+kokoy And MouseY()>alkuy+valiy*a Then
            Color cbyellow
            Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte
             Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte
            If MouseDown(1) Then
                Return (a+1)
            EndIf
        EndIf
    Next a
EndFunction
User avatar
KillBurn
Advanced Member
Posts: 339
Joined: Wed Aug 29, 2007 5:02 pm

Re: Pikku pelit

Post by KillBurn »

Jonhu wrote:Edellisessä oli pieni virhe..
Tuossa korjattuna: tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2)

Erityyppinen toinen versio:

Code: Select all

SCREEN 800,600
AddText "Yritä asettaa ruksi mahdollisimman keskelle ympyrää!"

ruksi=MakeImage(10,10)
DrawToImage ruksi
    Color cbred : Line 0,0,10,10 : Line 10,0,0,10
DrawToScreen

alku:
ShowMouse OFF
Const ympkoko=450
Const ympX = 100
Const ympY = 100
tee=0 : py#=0 : px#=0

Repeat
    Color cbred
    Circle ympX,ympY,ympkoko,0
    
    If MouseDown(1) And tee=0 And Distance(ympX+ympkoko/2, ympY+ympkoko/2, MouseX(), MouseY())<= ympkoko/2 Then 
        px#=MouseX() : py#=MouseY(): tee=2
    EndIf
    
    If tee=2 Then 
        tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2)
        tee=1
        ShowMouse ON 
    EndIf
    
    If px#>0 And py#>0 Then 
        Text 3,20,tex$
        Color cbdark : Line ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2
    EndIf
    
    If nappi(580,500,170,40,0,0,1,1)=1 Then Goto alku
    If px#=0 And py#=0 Then DrawImage ruksi,MouseX(),MouseY() Else DrawImage ruksi,px#,py#
    
    Color cbwhite: Text 597,510,"Yritä uudestaan"
    
    DrawScreen
    
Forever

Function etaisyys(x1#, y1#, x2#, y2#)
    aa#=Distance(x1#, y1#, x2#, y2#)
    testi$="Etäisyys keskipisteestä oli: "+aa#+" pikseliä"
    Return testi$
EndFunction

Function nappi(alkux,alkuy,kokox,kokoy,valiy,valix,maara,tayte)   
    For a=0 To maara-1
        Color cbred
        Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte
        Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte
        If MouseX()>alkux+valix*a And MouseX()<alkux+valix*a+kokox And MouseY()<alkuy+valiy*a+kokoy And MouseY()>alkuy+valiy*a Then
            Color cbyellow
            Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte
             Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte
            If MouseDown(1) Then
                Return (a+1)
            EndIf
        EndIf
    Next a
EndFunction
Hahaa, ennätys 2.2 pikseliä.Ekalla yrityksellä.
Sumu Games: Sam, Ur eye!
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Pikku pelit

Post by phons »

1.0 kolmannella yrityksellä :D
Image
MikkoK
Devoted Member
Posts: 813
Joined: Thu Jun 05, 2008 2:13 pm
Location: City 17

Re: Pikku pelit

Post by MikkoK »

Tein joskus muutama viikko sitten pikaisesti tämmöisen minipelin: Pelissä ajat autolla ihmisten päälle joita spawnii vaa lisää...
Pistin RAR:in ja ZIP:in. PS: Pakkaus sisältää koodin.
Attachments
cargame.zip
ZIP
(712.44 KiB) Downloaded 341 times
cargame.rar
RAR
(711.53 KiB) Downloaded 316 times
Last edited by MikkoK on Sun Nov 16, 2008 3:23 pm, edited 1 time in total.

Code: Select all

#aha. @ IRCNet
<Grandi> Voit laittaa jo valmiiks hailaittiin "Amis-Mikko", koska alan kutsua sua sillä nimellä.
regalis
Advanced Member
Posts: 268
Joined: Mon Aug 27, 2007 9:44 pm

Re: Pikku pelit

Post by regalis »

Väsäsin eilen yksinkertaisen bantumi/mancala -kloonin. Varmaankin tuttu peli kaikille, jotka ovat joskus omistaneet Nokia 3310:n. Tekoäly on melko alkeellinen, mutta silloin tällöin jopa haastava. Säännöt menee kaikessa yksinkertaisuudessaan näin:
Wikipedia wrote:Ennen pelin alkua kolot varastoa lukuun ottamatta täytetään pelimerkeillä, esimerkiksi kolme tai neljä kiveä kuhunkin koloon. Pelin siirto muodostuu yleensä siitä, että pelaaja poimii jostain oman puolensa kolosta kaikki pelimerkit ja "kylvää" ne yksitellen seuraaviin koloihin, tavallisesti pelilautaa vastapäivään kiertäen. Jos viimeinen jyvä sattuu ennestään oman puolen tyhjään koloon, pelaaja saa "kaapattua" vastapäätä olevasta toisen pelaajan kolosta kaikki pelimerkit omaan mancalaansa. Yksinkertaisimmissa peleissä voittaja on se, joka saa suuremman varaston.
Attachments
CoolBantumi.zip
(622.61 KiB) Downloaded 320 times
MAVmaggot
Advanced Member
Posts: 468
Joined: Fri Aug 31, 2007 10:18 pm
Location: bitspace

Re: Pikku pelit

Post by MAVmaggot »

Tämä ei ole nyt peli vaan pikku ohjelma, mutta laitoinpahan tänne. Tuossa jokunen aika sitten irkissä kyselin mitän koodaisin, ja atomimallilta tuli idea että koodaa ohjelma joka muuttaa taajuutta/sijaintia hiirtä liikuttamalla. Tämmösiä on kai ollut aikasemminkin mutta tässä oma versioni, joka ei kummoinen ole ja sitä varmaan vielä päivittelen ainakin jos keksitään uusia ideoita siihen. Vasemmalla näkyy taajuus, alhaalla sijainti ja oikealla voimakkuus. Voimakkuutta säädetään hiiren rullalla.
Edit:
Päivittelin. Eli nyt voi soittaa omaa musiikkia(onnistuu commandlinellä()) sitten taajuuden vaihdon herkkyyttä voi säätää inputilla, ja uudempi laskukaava tuohon taajuuteen.
Attachments
Beta2.rar
uudempi.
(933.42 KiB) Downloaded 338 times
beta.rar
(933.23 KiB) Downloaded 302 times
Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Pikku pelit

Post by Jonhu »

Tuli väsättyä pieni piirros ohjelma / peli. Tavoitteena oli pitää FPS mahdollisimman korkealla. Vinkkejä saa antaa, jos keksii vielä paremman tavan siihen. ;)
Tuli tämäkin ketju pompautettua ylös :)

EDIT: Vähän sotkuinen tuo valikko koodi.. Oikeastaan senkin voisi piirtää kuvaan, niin selventäisi tuota ohjelmaa. Eniten minulle herättää kysymystä tuossa, että onko nopeampaa maalata mustalla ruutu ja sen jälkeen vasta maalata se oikealla värillä vai poistaa ruutu ja värjätä se.. Päivitän vain yhden ruudun kerralla (patsi erikoiskomennoissa ja alussa, jonka näkee fps:än putoamisesta).

Code: Select all

SCREEN 800,600

Type Taulukko
    Field PosX
    Field PosY
    Field ID
EndType

// määritetään pari vakiota..
Const BoxesX   = 21 ' laatikkojen lukumäärä x suunnassa
Const BoxesY   = 21 ' laatikkojen lukumäärä y suunnassa
Const BoxSizeX = 18 ' laatikon leveys
Const BoxSizeY = 18 ' laatikon korkeus
Const BoxEmpty = 2  ' kuinka monta pikseliä jätetään ympäsille tilaa
Const AlkuX    = 100 ' kuinka monta pikseliä vasemmastareunasta tilaa
Const AlkuY    = 60 ' kuinka monta pikseliä yläreunasta tilaa

WSX#   = (BoxSizeX+BoxEmpty) ' WholeSizeX
WSY#   = (BoxSizeY+BoxEmpty)
AreaX# = WSX#*boxesX+Alkux   ' Boxsi alueen loppumis piste x suunnassa
AreaY# = WSY#*boxesY+AlkuY

ruudukko=MakeImage((BoxSizeX+BoxEmpty)*boxesX,(BoxSizeY+BoxEmpty)*boxesY)

VALITTU = 2

// Alkuruudukon teko
For x=0 To BoxesX-1
    For y=0 To BoxesY-1
        nw.TAULUKKO=New(TAULUKKO)
        nw\PosX = x*WSX#
        nw\PosY = y*WSY#
        nw\ID = 1
    Next y
Next x   

ruudukonupdate(ruudukko)
    
// pääsilmukka       
Repeat

    ////////////////////
    ////// OHJELMA /////
    ////////////////////
    
    If MouseDown(1) Then 
        DrawToImage ruudukko ' piirretään kuvaan, niin ei tarvitse jokaista neliötä päivittää
        For an.TAULUKKO=Each TAULUKKO
            If MouseX()<= AreaX#  Then
                If MouseY()<= AreaY#  Then
                    fx# = (MouseX()-AlkuX) /(BoxSizeX+BoxEmpty)*(BoxSizeX+BoxEmpty)
                    fy# = (MouseY()-AlkuY) /(BoxSizeY+BoxEmpty)*(BoxSizeY+BoxEmpty)
                    
                    If an\PosX = fx# And an\PosY = fy# Then 
                        an\ID = VALITTU 
                        Color cbblack       : Box an\PosX,an\PosY,BoxSizeX,BoxSizeY,1
                        tayt = Varit(an\ID) : Box an\PosX,an\PosY,BoxSizeX,BoxSizeY,tayt
                    EndIf
                EndIf
            EndIf
        Next an      
        DrawToScreen
    EndIf

    ////////////////////
    ////// VALIKKO /////
    ////////////////////
    
    // ON, OFF napit
    For y=0 To 7
        vali1=Button(680,50+y*35,50,20,"OFF",2,y+1,cbblack,cbred,cbdarkred)
        vali2=Button(680+50,50+y*35,50,20,"ON",2,y+11,cbblack,cbred,cbdarkred)
        If vali1>0 Then VALITTU=vali1
        If vali2>0 Then VALITTU=vali2
    Next y
    
    // Randomfill napit
    For a=1 To 3
        tapaa=Button(570,450+(a-1)*50,220,25,"Random fill "+a,3,a+1,cbblack,cbred,cbdarkred)
        If tapaa>0 Then varjays(valittu,tapaa) : ruudukonupdate(ruudukko)
    Next a
    
    // Cls with selected color nappi
    tapaa=Button(570,400,220,25,"Cls with selected color",3,1,cbblack,cbred,cbdarkred) 
    If tapaa>0 Then varjays(valittu,tapaa) : ruudukonupdate(ruudukko)
   
    ///////////////////
    ///// TEKSTIT /////
    ///////////////////
    
    tekstit(600,52,35) ' värien nimet
    Varit(VALITTU)     ' valitun värin otto
    If VALITTU>=10 Then selcolor=VALITTU-10 : filled$="ON" Else selcolor=VALITTU : filled$="OFF"
    Text 150+TextWidth("Selected Color: "),10,selcolor
    Text 350+TextWidth("Fill: "),10,filled$
    
    DrawImage ruudukko,AlkuX,AlkuY
    
    Color cbwhite
    Text 150,10,"Selected color: " 
    Text 350,10,"Fill: "
    Text 10,10,"FPS: "+FPS()
 
    DrawScreen 
    
Until EscapeKey()

Function ruudukonupdate(img)
    DrawToImage img
    For an.TAULUKKO=Each TAULUKKO
        Color cbblack       : Box an\PosX,an\PosY,BoxSizeX,BoxSizeY,1
        tayt = Varit(an\ID) : Box an\PosX,an\PosY,BoxSizeX,BoxSizeY,tayt
    Next an
    DrawToScreen
EndFunction

Function varjays(valit,tapa)
        For tt.TAULUKKO=Each TAULUKKO
            Select tapa
                Case 1 : tt\ID=valit
                Case 2 : tt\ID=Rand(1,8)
                Case 3 : tt\ID=Rand(11,18)
                Case 4 : If Rand(1,2)=1 Then tt\ID=Rand(1,8) Else tt\ID=Rand(11,18)
            EndSelect
        Next tt
EndFunction

Function Button(px1#,py1#,sizeX#,sizeY#,txt$,paksuus,nro,r1,g1,b1,r2,g2,b2,r3,g3,b3)

    If MouseX()>=px1# And MouseX()<=px1#+sizeX#
        If MouseY()>=py1# And MouseY()<=py1#+sizeY#
            If MouseDown(1) Then nappula=ON
        EndIf
    EndIf
    
    Select nappula
        Case 0 
            Color r2,g2,b2 : Box px1#,py1#,sizeX#,sizeY#,1
            Color r1,g1,b1 : Box px1#+paksuus,py1#+paksuus,sizeX#-paksuus*2,sizeY#-paksuus*2,1
            Color cbwhite  : CenterText px1#+sizeX#/2,py1#+sizeY#/6,txt$
        Case 1  
            Color r3,g3,b3 : Box px1#,py1#,sizeX#,sizeY#,1
            Color r1,g1,b1 : Box px1#+paksuus,py1#+paksuus,sizeX#-paksuus*2,sizeY#-paksuus*2,1
            Color cbwhite  : CenterText px1#+sizeX#/2,py1#+sizeY#/6,txt$
            Return nro
    EndSelect
    
EndFunction

Function tekstit(x,y,Vy)
    Color cbwhite 
    Text x,y-vy*1,"COLORS"
    Text x+112,y-vy*1,"FILL"
    Text x,y+vy*0,"White"
    Color cbred      : Text x,y+vy*1,"RED"
    Color cbyellow   : Text x,y+vy*2,"Yellow"
    Color cbblue     : Text x,y+vy*3,"BLUE"
    Color cbgreen    : Text x,y+vy*4,"Green"
    Color cborange   : Text x,y+vy*5,"Orange"
    Color cbdark     : Text x,y+vy*6,"Dark"
    Color cbdarkblue : Text x,y+vy*7,"Darkblue"
    Color cbsilver
    For yt=0 To 7
        Box x-10,y+yt*Vy-4,200,vy-10,0
    Next yt
EndFunction

Function Varit(num)
    valitse=num
    If Valitse>10 Then valitse=valitse-10
    Select valitse
        Case 0 : Color cbblack
        Case 1 : Color cbwhite
        Case 2 : Color cbred
        Case 3 : Color cbyellow
        Case 4 : Color cbblue
        Case 5 : Color cbgreen
        Case 6 : Color cborange
        Case 7 : Color cbdark
        Case 8 : Color cbdarkblue
    EndSelect
    If num>=10 Then Return 1
EndFunction

Last edited by Jonhu on Sun Nov 30, 2008 6:18 pm, edited 1 time in total.
User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Pikku pelit

Post by axu »

Näyttäisi siltä, että muokkaat aina koko kuvan kerralla. Jos värität aina vain sen ruudun mitä sillä hetkellä muokataan, FPS ponnahtaa luultavasti kattoon. Ja sitten vaan lisäämään kaikkea raskasta :mrgreen:
EDIT:

Katoin vähän enemmän koodia ja hokasin että mokasin.
Teetkin just niin, aattelin kun oli se ruudukonupdate funktio :D

Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image
Character
Active Member
Posts: 113
Joined: Thu Nov 27, 2008 2:16 pm

Re: Pikku pelit

Post by Character »

Tein tällaisen sivulta vierivän pikkupelin. Oma ennätys 100 pistettä vaikealla:

Code: Select all

valikko:

Global taso

taso=1
i=0
l=70

Repeat

nappi(10,10,"Aloita",255,0,0)
nappi(10,40,"Lopeta",255,0,0)
Color cbred
Text l,10+i*30,"<--"
If KeyHit(cbkeyDown) Then i=i+1
If KeyHit(cbkeyUp) Then i=i-1
If i<0 Then i=1
If i>1 Then i=0
If i=0 Then l=70
If i=1 Then l=70
If KeyHit(28) Then
If i=0 Then Goto peliasetukset
If i=1 Then End
EndIf
DrawScreen

Forever

Function nappi(x,y,teksti$,r,g,b)
lev=TextWidth(teksti$)
Color r,g,b
Box x,y,lev+5,20
Color cbwhite
Text x,y+3,teksti$
Color cbblack
Box x,y,lev+5,20,0
End Function

peliasetukset:

ClearKeys

i=0
l=70

Repeat

nappi(10,10,"Taso1: Helppo",255,0,0)
nappi(10,40,"Taso2: Normaali",255,0,0)
nappi(10,70,"Taso3: Vaikea",255,0,0)
Color cbred
Text l,10+i*30,"<--"
If KeyHit(cbkeyDown) Then i=i+1
If KeyHit(cbkeyUp) Then i=i-1
If i<0 Then i=2
If i>2 Then i=0
If i=0 Or i=2 Then l=130
If i=1 Then l=150
If KeyHit(28) Then
If i=0 Then taso=1: Goto peli
If i=1 Then taso=2: Goto peli
If i=2 Then taso=3: Goto peli
EndIf
DrawScreen

Forever

peli:

Type VIHUT
    Field x
    Field y
    Field img
End Type

boom = LoadSound("Media/Boom 1.wav")

pelaaja = MakeImage(10,10)

DrawToImage pelaaja
Color 0,255,0
Box 0,0,ImageWidth(pelaaja),ImageHeight(pelaaja)
DrawToScreen

Global pisteet

omax=10
omay=110
If taso=1 Then vihunopeus=1: vihumaara=5: omanopeus=2
If taso=2 Then vihunopeus=2.5: vihumaara=10: omanopeus=3
If taso=3 Then vihunopeus=5: vihumaara=15: omanopeus=5
maarakasvu=Timer()
pistekasvu=Timer()
pisteet=0
elossa=True

Repeat

If elossa=True Then

If Timer()>pistekasvu+250 Then
pisteet=pisteet+1
pistekasvu=Timer()
EndIf

DrawImage pelaaja, omax, omay

omax=omax-LeftKey()*omanopeus+RightKey()*omanopeus
omay=omay-UpKey()*omanopeus+DownKey()*omanopeus

If omay<0 Then omay=omay+omanopeus
If omay>290 Then omay=omay-omanopeus
If omax<-10 Or omax>400 Then elossa=False

If luonti=0 Then
For i=0 To vihumaara
uusi.VIHUT = New(VIHUT)
uusi\x = 420
uusi\y = Rand(-10,290)
uusi\img = MakeImage(20,20)
DrawToImage uusi\img
Color cbred
Box 0,0,ImageWidth(uusi\img),ImageHeight(uusi\img)
DrawToScreen
Next i
luonti=50
EndIf
If luonti>0 Then luonti=luonti-1

For uusi.VIHUT = Each VIHUT
uusi\x = uusi\x - vihunopeus
DrawImage uusi\img, uusi\x, uusi\y
If ImagesOverlap(pelaaja,omax,omay,uusi\img,uusi\x,uusi\y) Then
omax=omax-omanopeus*2
EndIf
Next uusi

If Timer()>maarakasvu+10000 Then
vihumaara=vihumaara+1
maarakasvu=Timer()
EndIf

Color cbmagenta
Text 0,0,"Pisteesi: "+pisteet

EndIf

If elossa=False Then

DrawGame

Color cbred
Text 150,110,"Hävisit!"
Text 150,125,"Pisteesi: "+pisteet

EndIf

DrawScreen

Forever
Jonhu
Active Member
Posts: 186
Joined: Mon Aug 04, 2008 5:45 pm

Re: Pikku pelit

Post by Jonhu »

En ole nähnyt paljoakaan täällä palapelejä, joten päätin tehdä yhden sellaisen :)

Tässä eilinen tuotokseni.. (Todennäköisesti tämä projekti jää kuitenkin yhdenpäivän projektiksi)

Code: Select all

SCREEN 800,600

Type KARTTA
    Field img%
    Field x1 As Float
    Field y1 As Float
    Field szX As Float
    Field szY As Float
    Field x2 As Float
    Field y2 As Float 
    Field oikein
    Field selected
EndType


Const MapX=400 ' palasten paikka
Const MapY=200 
Const palojaX=1 ' palojen lukumäärä
Const palojaY=2

Global AlkuX,AlkuY

AlkuX=0
AlkuY=50

// imagejen lataus/teko
Map   = LoadImage( "media\map.bmp" )
Ruudukko=MakeImage(RoundUp(ImageWidth(Map)),RoundUp(ImageHeight(Map)))
Voittoimg=MakeImage(200,100)

alku:
// imageiden asettelut
MakeParts(Map)
RandStartPosition()

MakeBoxes(ImageWidth(Map)/palojaX,ImageHeight(Map)/palojaY,Ruudukko)
DrawtoVoitto(Voittoimg)

Color cbwhite
Starttime=Timer()

Repeat
    // ruudukon piirto
    DrawImage Ruudukko,AlkuX,AlkuY
    Box -1,49,ImageWidth(Map)+2,ImageHeight(Map)+2,0
    
    // hiiren tunnistukset
    For aa.KARTTA=Each KARTTA
        If MouseDown(1) And aa\selected=OFF And valittuja=0 Then
            If MouseX()>=aa\X1 And MouseX()<=aa\X1+aa\szX
                If MouseY()>=aa\Y1 And MouseY()<=aa\Y1+aa\szY
                    aa\selected=ON
                    valittuja+1
                EndIf
            EndIf
        ElseIf MouseUp(1) And aa\selected=ON
            aa\selected=OFF
            valittuja=0
            
            If aa\X1+aa\szX/2>=AlkuX And aa\X1+aa\szX/2<=AlkuX+ImageWidth(Map) Then
                If aa\Y1+aa\szY/2>=AlkuY And aa\Y1+aa\szY/2<=AlkuY + ImageHeight(Map)Then
                    For bb.KARTTA=Each KARTTA
                        If Distance(aa\X1,aa\Y1,bb\X2,bb\Y2)<=(aa\szX+aa\szY)/4 Then
                            aa\X1=bb\X2
                            aa\Y1=bb\Y2
                            If aa=bb Then aa\oikein=1 Else aa\oikein=0
                        EndIf
                    Next bb
                EndIf
            EndIf
        EndIf
        
        If aa\selected=ON
            aa\X1=MouseX()-aa\szX/2
            aa\Y1=MouseY()-aa\szY/2
        EndIf

       DrawImage aa\img,aa\X1,aa\y1
    Next aa
    
    // Oikeiden paikkojen laskeminen
    oik=0
    For nn.KARTTA=Each KARTTA
        oik=nn\oikein+oik
    Next nn
    
    DrawGame

    Text 100,10,"PALAPELI"
    Text 300,10,"FPS: "+FPS()
    Text 400,10,"Aikaa mennyt: "+((Timer()-StartTime)/1000)+"s"
    
    If oik=palojaX*palojaY Then aaa$=((Timer()-StartTime)/1000)+"s" : Goto voitto
    
    DrawScreen
    

    
Forever

voitto:

    Repeat
        Text 10,10,"FPS: "+FPS()
        Text 100,10,"Aikaa meni: "+aaa$
        DrawImage VoittoImg,300,250
        CenterText 400,270,"Onnittelut"
        CenterText 400,300,"Paina entter jatkaaksesi"
        DrawScreen
    Until KeyHit(28) Or MouseHit(1)

    ClearKeys
    ClearType()

Goto alku

///////////////////////////
///////// FUNCTIOT ////////
///////////////////////////

Function ClearType()
    For aa.KARTTA=Each KARTTA
        DeleteImage aa\img
        Delete aa
    Next aa
EndFunction

Function DrawtoVoitto(img)
    DrawToImage img
        Color cbred:  Box 0,0,ImageWidth(img),ImageHeight(img)
        Color cbgreen:  Box 10,10,ImageWidth(img)-20,ImageHeight(img)-20
    DrawToScreen
EndFunction

Function MakeBoxes(kokoX,kokoY,img)
    Color cbdark
    DrawToImage img
    For x=0 To PalojaX-1
        For y=0 To PalojaY-1
            Box x*kokoX,y*kokoY,kokoX,kokoY,0
        Next y
    Next x
    DrawToScreen
EndFunction

Function MakeParts(img)
    Wd#=ImageWidth(img)
    Wh#=ImageHeight(img)
    For XX=0 To PalojaX-1
        For YY=0 To PalojaY-1
            img2=CloneImage(img)
            aa.KARTTA=New(KARTTA)
            aa\szX=Wd#/PalojaX ' koko
            aa\szY=Wh#/PalojaY
            
          '  aa\x1=(XX) * (aa\szX+1)+MapX  alkupaikka järjestyksessä
          '  aa\y1=(YY) * (aa\szY+1)+MapY
            
            aa\x2=xx*aa\szX+AlkuX ' koottavan paikka
            aa\y2=yy*aa\szY+AlkuY
            aa\img=MakeImage(RoundUp(aa\szX),RoundUp(aa\szY))
            CopyBox RoundUp(xx*aa\szX),RoundUp(yy*aa\szY),RoundUp(aa\szX),RoundUp(aa\szY),0,0,Image(img2),Image(aa\img)
        Next yy
    Next XX
EndFunction

Function RandStartPosition()
    For aa.KARTTA=Each KARTTA
       If aa\x1=0 And aa\y1=0 Then
            Repeat
            
                aa\x1=Rand(0,PalojaX-1) * (aa\szX+1)+MapX' alkupaikka randomisti
                aa\y1=Rand(0,PalojaY-1) * (aa\szY+1)+MapY
                
                exi=0
                For nn.KARTTA=Each KARTTA
                    Exi=BoxOverlap(aa\x1,aa\y1,aa\szX,aa\szY,nn\x1,nn\y1,nn\szX,nn\szY)+Exi
                Next nn
                
            Until Exi<=1
       EndIf
    Next aa
EndFunction
Tuomasd
Newcomer
Posts: 14
Joined: Fri Dec 12, 2008 4:46 pm

Re: Pikku pelit

Post by Tuomasd »

otto90x wrote:Tässäpä oma pieni pelini

Code: Select all

SCREEN 640,480

Global sh,sw

sw=ScreenWidth()
sh=ScreenHeight()

Type flow
    Field x#
    Field y#
    Field ang#
    Field voima
    Field sx#
    Field sY#
    Field väri#
    Field angplus#
End Type

Const PAKSUUS = 10

Dim pala(2,4) As Float

pala(2,1)=10
pala(1,1)=SH-10-PAKSUUS

Dim pallo(3) As Float '0x 1y 2sx 3sy 

Global pisteetcom, pisteethuman 

Global comspeed As Float

Global gamepause, setupvalinta, setuptila

comspeed=1.00

Const laattoja = 5

Const PALANOPEUS = 7

Const VOIMAKERROIN =0.7

Const pallobufferkoko = 20

Dim pallobuffer(pallobufferkoko,2) As Float

Global flowmäärä, maksimiflowmäärä

maksimiflowmäärä=200



StartNewGame()

Repeat

    SetWindow "Cool Pong - Tietokone: "+pisteetcom+" Pelaaja: "+pisteethuman 

    UpdatePalat()
    
    UpdateFlow()
    
    UpdatePallo()
    
    Setup()

    DrawScreen

Forever

Function StartNewGame()
    pallo(0)=SW/2
    pallo(1)=SH/2
    pallo(2)=0
    pallo(3)=0
    DeleteFlow()
    pala(1,2)=11
    pala(2,2)=11
    pala(2,3)=100
    pala(1,3)=100
    pala(1,4)=0.0
    pala(2,4)=0.0
    pallobuffer(0,0)=pallo(0)
    pallobuffer(0,1)=pallo(1) 
    For i=1 To pallobufferkoko
        pallobuffer(i,0)=pallo(0)
        pallobuffer(i,1)=pallo(1)
    Next i
    
End Function 

Function Scoring(_voitto)

    
    Repeat
    
        Color 64,64,64
        
        Box 100,100,SW-200,100,0
        
        Color 96,96,96
        
        Box 102,102,SW-204,96,0
        
        Color cbwhite
        
        If _voitto>0 Then 
            Text 130,125,"Onneksi olkoon. Sinä voitit tämän erän."
        Else
            Text 130,125,"Valitettavasti tietokone voitti tämän erän."
        EndIf
        
        If pisteetcom>pisteethuman Then
            Text 130,165,"Tilanne on nyt "+pisteetcom+":"+pisteethuman+ " tietokoneen hyväksi." 
        ElseIf pisteetcom=pisteethuman Then
            Text 130,165,"Tilanne on nyt "+pisteethuman+":"+pisteetcom+ " tasapeli." 
        Else
            Text 130,165,"Tilanne on nyt "+pisteethuman+":"+pisteetcom+ " sinun hyväksesi." 
        EndIf
            
        DrawScreen
        
    Until KeyHit(cbkeyReturn)
    
    StartNewGame()
End Function 

Function UpdatePallo()

    If Not gamepause Then
    
        If pallo(1)>SH-5 Then
            pisteetcom=pisteetcom+1
            Scoring(-1)
        ElseIf pallo(1)<5 Then
            pisteethuman=pisteethuman+1
            Scoring(1)
        EndIf
            
        If pallo(0)>SW-15 Then pallo(0)=SW-15 : pallo(2)=-pallo(2)
        If pallo(0)<5 Then pallo(0)=5 : pallo(2)=-pallo(2)    
            
        pallo(0)=pallo(0)+pallo(2)
        pallo(1)=pallo(1)+pallo(3)    
    
        If pallo(2) Or pallo(3) Then 
        
            For i=0 To pallobufferkoko
            
                vx#=tx#
                vy#=ty#
            
                If i=0 Then 
                    tx#=pallobuffer(i,0)
                    ty#=pallobuffer(i,1)
                    pallobuffer(i,0)=pallo(0)
                    pallobuffer(i,1)=pallo(1) 
                Else
                    i2=(i-1)
                    tx2#=pallobuffer(i,0)
                    ty2#=pallobuffer(i,1)
                    pallobuffer(i,0)=tx#
                    pallobuffer(i,1)=ty#
                    tx#=tx2#
                    ty#=ty2#
                EndIf
            Next i
            
        EndIf
        
    EndIf
    
    i=pallobufferkoko
    
    While i>-1 
    
        If i=0 Then 
            Color 255,Rnd(0.2,0.4)*255,0
        Else
            väri#=max(Min( ( 255-((255/pallobufferkoko)*i)+Rand(20,-20) ) ,255.0),0.0)
            Color väri#,Int(väri#*Rnd(0.4,0.6)),0

        EndIf
        
        Circle pallobuffer(i,0)+4,pallobuffer(i,1),8-(i/3),1
        i-1
    
    Wend
    
End Function 



Function UpdatePalat()

    spread=30

    For i=1 To 2
        
        
         
        seis=0
        
        If i=1 Then 
        
            If Not gamepause Then
                If KeyDown(cbkeyup) And pala(i,4)=<1.0 And pala(i,4)=>0.0 Then 
                    AddFlow(pala(i,0)+pala(i,3)/2,pala(i,1)-PAKSUUS,Rand(90-spread,90+spread)) 
                    pala(i,4)=pala(i,4)+0.01
                    seis=1
                EndIf
                
                pala(i,2)=( KeyDown(cbkeyright)-KeyDown(cbkeyleft) )
                
            EndIf
            
            If pala(i,4)=>0.0 Then
                Color Min(pala(i,4)*255,255),Max(Min(255-pala(i,4)*255,255),0),0
            Else 
                Color 0,max(Min(255+pala(i,4)*255,255),0),Max(Min(-pala(i,4)*255,255),0)
            EndIf
        Else
        
            If Not gamepause Then
            
                    If pala(i,0)+(pala(i,3)/2)<pallo(0) Then 
                        pala(i,2)=comspeed
                    ElseIf pala(i,0)+(pala(i,3)/2)>pallo(0) Then 
                        pala(i,2)=-comspeed
                    EndIf
                  
                If pala(i,4)=<1.0 And pala(i,4)=>0.0 Then 
                    AddFlow(pala(i,0)+pala(i,3)/2,pala(i,1)+PAKSUUS,Rand(270-spread,270+spread)) 
                    pala(i,4)=pala(i,4)+0.01
                    seis=1
                EndIf
            EndIf

            Color 255,0,0
        EndIf
        
        If Not gamepause Then
            If pala(i,4)>1.0 Then Pala(i,4)=-pala(i,4)*2 : seis=1
            
            If pala(i,4)<0.0 Then 
                Pala(i,4)=Min(pala(i,4)+0.007,0.0) 
            ElseIf seis=0 And pala(i,4)>0.0 Then
                pala(i,4)=Max(pala(i,4)-0.0050,0.0)
            EndIf
            
            
            If pala(i,0)<0 Then 
                pala(i,0)=0
            ElseIf pala(i,0)>(SW-pala(i,3)) Then
                pala(i,0)=SW-pala(i,3)
            EndIf
            
            If abs((pala(2,0)+pala(2,3)/2)-pallo(0))<COMSPEED*2 Then pala(2,2)=0.0
            
            pala(i,0)=pala(i,0)+(PALANOPEUS*pala(i,2))
            
            
            x=pallo(0)
            y=pallo(1)
            
            If x>pala(i,0) And x<(pala(i,0)+pala(i,3)) And Abs(y-pala(i,1))=<PAKSUUS Then
                
                If pallo(3)>0 Then
                    pallo(1)=pala(i,1)-15
                Else
                    pallo(1)=pala(i,1)+PAKSUUS+5
                EndIf
    
                pallo(3)=-pallo(3)
                pallo(2)=pallo(2)+pala(i,2)*2
            EndIf
        
        EndIf
        
        Box pala(i,0),pala(i,1),pala(i,3),PAKSUUS,1
        
    Next i
End Function 


Function AddFlow(_x#,_y#,_angle#,_speed#=5.0)

    'If flowmäärä<maksimiflowmäärä Then 
        f.flow=New(flow)
        f\x=_x#
        f\y=_y#
        f\ang=WrapAngle(_angle#)
        f\sx=Cos(f\ang)*_speed#
        f\sy=-Sin(f\ang)*_speed#
        f\voima=1
        flowmäärä+1
    'EndIf

End Function  


Function DeleteFlow()
    For f.flow = Each flow
        Delete f
    Next f
    flowmäärä=0
End Function 


Function Setup()

    If KeyHit(cbkeyspace) Then gamepause=Not gamepause

    If gamepause Then 

        setupvalinta=setupvalinta-KeyHit(cbkeyleft)+KeyHit(cbkeyright)
        
        If setupvalinta=1 Then 
        
            leveys=SW-200
            korkeus=60
             
            comspeed=Min(Max(comspeed+(UpKey()-DownKey())*0.01,0.25),5.0)
            
            Color cbwhite
            
            Box 110,110,10,10,1
            
            Text 110,130,"Tietokoneen mailan nopeus: "+Float(comspeed*100)+" %."
            
            Color 128,128,128
            
            Box 130,110,10,10,1
            Box 150,110,10,10,1
            
        ElseIf setupvalinta=2 Then 
        
            leveys=SW-200
            korkeus=60
        
            Color cbwhite
            
            Box 130,110,10,10,1
            
            Text 110,130,"Ohjeet"
            
            Color 128,128,128
            
            Box 110,110,10,10,1
            Box 150,110,10,10,1
            
            If KeyHit(cbkeyreturn) Then setuptila=1 : ClearKeys
            
            If setuptila=1 Then 
                If KeyHit(cbkeyreturn) Then setuptila=0 : ClearKeys
                leveys=SW-200
                korkeus=SH-300
                Color cbwhite
                
                Text 110,170,"Ohjaa palava meteoroidi punaisen mailan taakse."
                Text 110,190,"Voit käyttää hiukkassuihkua ylöspäin näppäimestä."
                Text 110,210,"Varo hiukkassuihkun ylikuumentumista."
                Text 110,230,"Mailasi liikkuu sivusuunnassa nuolinäppäimistä."
                Text 110,250,"Voit säätää vaikeusastetta valikosta."
            EndIf
        
        ElseIf setupvalinta=3 Then
        
            Leveys=SW-200
            korkeus=60
            
            Color cbwhite
            
            Box 150,110,10,10,1
            
            Text 110,130,"Lopeta"
            
            Color 128,128,128
            
            Box 110,110,10,10,1
            Box 130,110,10,10,1
            
            If KeyHit(cbkeyreturn) Then End
        
        ElseIf setupvalinta<1 Then 
            setupvalinta=1
        ElseIf setupvalinta>3 Then 
            setupvalinta=3
        EndIf
        
        Color 64,64,64
        
        Box 100,100,leveys,korkeus,0
        
        Color 96,96,96
        
        Box 102,102,leveys-4,korkeus-4,0
    
    EndIf

 
End Function 


Function UpdateFlow()

    For f.flow = Each flow
    
        If Not gamepause Then
        
            f2.flow=First(flow)
            f2 = After(f) 
    
            'vang#=f\ang
            While f2<>NULL 
                etä#=Distance(f\x,f\y,f2\x,f2\y)
                
                maxetä#=40.0
                
                If etä<maxetä Then
    
                    f\ang=Curveangle2(f2\ang,f\ang,70.0)
                
                    f\sx=(f\sx+Cos(f\ang))*0.8
                    f\sy=(f\sy-Sin(f\ang))*0.8
                    
                    If abs(f\ang-f2\ang)<5.0 And etä<20.0 Then
                        f\voima=f\voima+1
                        Delete f2
                        flowmäärä=flowmäärä-1
                    EndIf
                    
                    
                EndIf
            
                f2 = After(f2) 
            Wend
            
       
        
            'f\angplus=f\ang-vang
            
            f\x=f\x+(f\sx#/1.5)
            f\y=f\y+(f\sy#/1.5)
    
            'f\ang=f\ang+f\angplus
            
        EndIf
        
        poisto=0

        If f\x<sw And f\x>0 And f\y<sh And f\y>0 Then

            f\väri=-Sin(f\ang)
            
            If f\väri<-0.75 Then Color 0,255,0 
            If f\väri<-0.4 Then Color 128,255,0 
            If f\väri>-0.4 Then Color 255,255,0 
            If f\väri>0.4 Then Color 255,128,0 
            If f\väri>0.75 Then Color 255,0,0 
            
            kerroin3#=2.0
             
            kerroin4#=(1+(f\voima*VOIMAKERROIN))*kerroin3#
            
            Line f\x,f\y,f\x+f\sx*kerroin4#,f\y+f\sy*kerroin4#
        
        Else
            'If f\x>sw Or f\x<0 Then 
            '    f\sx#=-f\sx# 
            '    f\x=Max(0,Min(sw,f\x))
            'EndIf
                
            'If f\y>sh Or f\y<0 Then 
            '    f\sy#=-f\sy#
            '    f\y=Max(0,Min(sh,f\y))
            'EndIf
            poisto=1
        EndIf
        
        If Not gamepause Then
        
            If poisto Then 
                Delete f
                flowmäärä=flowmäärä-1
            ElseIf Distance(pallo(0),pallo(1),f\x,f\y)<10 Then 
                pallo(2)=Max(Min( pallo(2)+(f\sx*(VOIMAKERROIN*f\voima)/7),12),-12) 
                pallo(3)=Max(Min( pallo(3)+(f\sy*(VOIMAKERROIN*f\voima)/7),12),-12)
            EndIf
        
        EndIf
    
    Next f
    

End Function 

Function CurveAngle2(targetangle#,oldangle#,incre#) 'Curves "oldangle" to "targetangle" by "incre" (e.g.homing missile)
   targetangle = WrapAngle(targetangle) : oldangle = WrapAngle(oldangle)
   If (oldangle + 360) - targetangle < targetangle - oldangle Then oldangle = 360 + oldangle
   If (targetangle + 360) - oldangle < oldangle - targetangle Then targetangle = 360 + targetangle
   oldangle = oldangle - (oldangle-targetangle) / incre
   Return oldangle
End Function

Ja tämän innoituksenahan on toiminut tämä.
Jäim koukkuun! :)
moxd
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Pikku pelit

Post by DatsuniG »

Pientä ascii räiskintää näin sunnuntain kunniaksi : D
W/A/S/D - Liikkuminen
Hiiri - Tähtäys
Hiiren rulla - Aseen vaihto

Code: Select all

    Type Bullet
        Field BX#
        Field BY#
        Field BType
        Field BAngle
    EndType

    Type AscThr
        Field ThrID
        Field ThrCurrentParticles
    EndType

    Type AscParticles
        Field ParticleLetter$
        Field ParticleX
        Field ParticleY
        Field ParticleAngle
        Field ParticleDistance
    EndType

    Type BOT
        Field BotX#
        Field BotY#
        Field BotHp
    EndType

    Type HEALTHPACK
        Field HX
        Field HY
    EndType

    x#=200
    y#=150

    HP# = 100

    CreateAsciiThruster(1)
    Maxval=1
    Repeat

    If hp<0 Then MakeError "Tapoit: "+killcount

    For i=0 To HP/2
        Text i*2+1,2,"|"
    Next i


    SetWindow "Tapot: "+killcount

    Select val
        Case 1
            Text 150,2,"Current weapon: Pistol"
        Case 2
            Text 150,2,"Current weapon: Shotgun"
        Case 3
            Text 150,2,"Current weapon: Deagle"
        Case 4
            Text 150,2,"Current weapon: Machinegun"
        Case 5
            Text 150,2,"Current weapon: Minigun"
        Case 6
            Text 150,2,"Current weapon: Flamethrower"
    EndSelect

    If Rand(10000)>9995 Then
        lol.Healthpack = New(Healthpack)
        lol\HX = Rand(400)
        lol\HY = Rand(300)
    EndIf

    Color cbred
    For lol.HealthPack = Each HealthPack
        Box lol\HX,lol\HY+5,15,5
        Box lol\Hx+5,lol\HY,5,15
        If x>lol\HX And x<lol\HX+15 And y>lol\HY And y<lol\HY+15 Then hp=Hp+(100-hp)/2 : Delete lol
    Next lol

    Color cbwhite
    If maxbotamount>80 Then maxbotamount= 80
    If botadd+8000-KillCount*50<Timer() Then MaxBotAmount+1 : botadd=Timer()

    If Killcount>9 Then MaxVal=2
    If killCount>19 Then MaxVal=3
    If KillCount>29 Then MaxVal=4
    If killcount>49 Then maxVal=5
    If killcount>69 Then maxVal=6

    If BotAmount<MaxBotAmount Then
        spawn.Bot = New(Bot)
        spawn\botx = Rand(1)*400
        spawn\boty = Rand(-20,320)
        spawn\bothp=30+killcount/100*5
        Botamount+1
    EndIf

    For spawn.Bot = Each bot
        If spawn\bothp<0 Then Delete spawn : killcount+1 : botamount-1
        tmp=GetAngle(spawn\botx,spawn\boty,x,y)
        spawn\botx=spawn\botx+Cos(tmp)
        spawn\boty=spawn\boty-Sin(tmp)
        Text spawn\botx,spawn\boty,"$"
        If x+1>spawn\botx And x<spawn\botx+TextWidth("#")-1 And y+1>spawn\boty And y<spawn\boty+TextHeight("#")-1 Then Hp-1
    Next spawn

    Text x,y,"#"

    If (KeyDown(cbkeyd)-KeyDown(cbkeya))*2<>0 And (KeyDown(cbkeys)-KeyDown(cbkeyw))*2<>0 Then
        x=x+(KeyDown(cbkeyd)-KeyDown(cbkeya))*2
        y=y+(KeyDown(cbkeys)-KeyDown(cbkeyw))*2
    Else
        x=x+(KeyDown(cbkeyd)-KeyDown(cbkeya))*3
        y=y+(KeyDown(cbkeys)-KeyDown(cbkeyw))*3
    EndIf

    angle=GetAngle(x,y,MouseX(),MouseY())

    If val=6 Then
        UpdateAsciiThrusters(MouseDown(1),1,x+3,y+3,angle-8,angle+8,40,2,120,80)
    EndIf


    If MouseDown(1) Then
        Select val
            Case 1
                If aika+350<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
            Case 2
                If aika+650<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
            Case 3
                If aika+400<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
            Case 4
                If aika+120<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
            Case 5
                If aika+90<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
        EndSelect
    EndIf
    UpdateBullets()
    val=val+MouseMoveZ()
    If val<1 Then val=MaxVal
    If val>MaxVal Then val=1
    DrawScreen
    Forever

    Function NewBullet(x,y,angle,BulletType)
        Select BulletType
            Case 1,3
                uusi.Bullet = New(Bullet)
                uusi\BType = BulletType
                uusi\BX = X
                uusi\BY = Y
                uusi\BAngle = angle
               
            Case 2
                For i=-6 To 6 Step 2
                    uusi.Bullet = New(Bullet)
                    uusi\BType = BulletType
                    uusi\BX = X
                    uusi\BY = Y
                    uusi\BAngle = wrapangle(Angle+i)
                Next i
           
            Case 4
                uusi.Bullet = New(Bullet)
                uusi\BType = BulletType
                uusi\BX = X
                uusi\BY = Y
                uusi\BAngle = angle + Rand(-3,3)
            Case 5
                uusi.Bullet = New(Bullet)
                uusi\BType = BulletType
                uusi\BX = X
                uusi\BY = Y
                uusi\BAngle = angle + Rand(-9,9)
         EndSelect
    EndFunction

    Function UpdateBullets()
        For uusi.Bullet = Each Bullet   
            Select uusi\BType
                Case 1,2,3
                    uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*3
                    uusi\By = uusi\By-Sin(uusi\Bangle)*3
                    Dot uusi\bx,uusi\by
                Case 4
                    uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*5
                    uusi\By = uusi\By-Sin(uusi\Bangle)*5
                    Dot uusi\bx,uusi\by
                Case 5
                    uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*7
                    uusi\By = uusi\By-Sin(uusi\Bangle)*7
                    Dot uusi\bx,uusi\by
             EndSelect
            If uusi\bx>400 Or uusi\bx<0 Or uusi\by>300 Or uusi\by<0 Then Delete uusi
            For spawn.bot = Each bot
                If uusi\bx>spawn\botX And uusi\bx<spawn\botx+TextWidth("$") And uusi\by>spawn\boty And uusi\by<spawn\boty+TextHeight("$") Then
                    Select uusi\btype
                        Case 1
                            spawn\bothp-10
                        Case 2
                            spawn\bothp-4
                        Case 3
                            spawn\bothp-25
                        Case 4
                            spawn\bothp-5
                        Case 5
                            spawn\bothp-4
                    EndSelect
                    Delete uusi
                    Exit
                EndIf
            Next spawn
        Next uusi
    EndFunction

    Function CreateAsciiThruster(id)
        uusi.AscThr = New(AscThr)
        uusi\ThrID=ID
        uusi\ThrCurrentParticles=0
    EndFunction

        Function UpdateAsciiThrusters(mode,id,x,y,angle1,angle2,maxpar,speed,maxdis,spread)
            For uusi.AscThr = Each AscThr
                If uusi\ThrID = id Then
                    If uusi\ThrCurrentParticles<Maxpar Then
                      If mode=True Then   
                        For i=1 To Maxpar-uusi\ThrCurrentparticles
                            Create.AscParticles = New(AscParticles)
                            Create\Particleletter = Chr(178)
                            Create\ParticleX=x
                            Create\ParticleY=y
                            Create\Particleangle=Rand(angle1,angle2)
                            Create\ParticleDistance = 0
                            uusi\ThrCurrentParticles=uusi\ThrCurrentParticles+1

                                   
                        Next i
                      EndIf
                    EndIf
                For Create.AscParticles = Each AscParticles
                        For spawn.Bot = Each bot
                            If Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance>Spawn\botx And Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance<Spawn\botx+TextWidth("$") And Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance>spawn\boty And Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance<spawn\boty+TextHeight("$") Then
                                spawn\bothp-2
                                Delete Create
                                uusi\ThrCurrentParticles=uusi\ThrCurrentParticles-1
                                Goto skip
                            EndIf
                        Next spawn
                     If Create\ParticleDistance>Maxdis-Rand(spread) Then
                        uusi\ThrCurrentParticles=uusi\ThrCurrentParticles-1
                        Delete create
                     EndIf
                     Create\ParticleDistance=Create\ParticleDistance+speed
                     Text Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance,Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance,create\Particleletter
skip:
                Next create
            EndIf
            Next uusi
        EndFunction
        
EDIT:

Deagle ja minigun lisätty. Flamethrowerista poistettu mavit.

Last edited by DatsuniG on Sun Dec 14, 2008 8:34 pm, edited 1 time in total.
Hengität nyt manuaalisesti.
User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Pikku pelit

Post by axu »

DatsuniG wrote:Pientä ascii räiskintää näin sunnuntain kunniaksi : D
Tekoäly = surkea
Liikkuminen = kehno
Asevalikoima = suppea
Viimeinen ase = :x (olin jo saanut 140 ennen kuin huomasin MAV wepoonin, arvaa mitä tapahtui seuraavaksi!)
Eli toisin sanoen yksi parhaita pelejä täällä! pidin kovasti, oli addiktoiva jotenkin. Totesin hyväksi taktiikaksi kerätä vihut yhteen läjään ja ampua shotgunilla, ja varoa osumasta siihen läjään...
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Pikku pelit

Post by DatsuniG »

No tesmatkaas tuota uutta versiota noilla ase fixeillä, sekä paremalla health pack tsydeemillä + Vihujen hp:n kasvamisella.
Hengität nyt manuaalisesti.
DatsuniG
Advanced Member
Posts: 367
Joined: Fri Aug 15, 2008 9:57 pm

Re: Pikku pelit

Post by DatsuniG »

Nyt on lisätty uusi ase sekä muutettu vihollisten lisäämistä.

Code: Select all

            Type ASCII
                Field parletter$
                Field parx
                Field pary
                Field parangle
                Field ParDis#
                Field MaxDis#
                Field ParSpeed#
            EndType

                Type Bullet
                    Field BX#
                    Field BY#
                    Field BType
                    Field BAngle
                EndType

                Type AscThr
                    Field ThrID
                    Field ThrCurrentParticles
                EndType

                Type AscParticles
                    Field ParticleLetter$
                    Field ParticleX
                    Field ParticleY
                    Field ParticleAngle
                    Field ParticleDistance
                EndType

                Type BOT
                    Field BotX#
                    Field BotY#
                    Field BotHp
                EndType

                Type HEALTHPACK
                    Field HX
                    Field HY
                EndType

                x#=200
                y#=150


                HP# = 100

                CreateAsciiThruster(1)
                Maxval=1
                Repeat

                If hp<0 Then MakeError "Tapoit: "+killcount

                For i=0 To HP/2
                    Text i*2+1,2,"|"
                Next i


                SetWindow "Tapot: "+killcount

                Select val
                    Case 1
                        Text 150,2,"Current weapon: Pistol"
                    Case 2
                        Text 150,2,"Current weapon: Shotgun"
                    Case 3
                        Text 150,2,"Current weapon: Deagle"
                    Case 4
                        Text 150,2,"Current weapon: Machinegun"
                    Case 5
                        Text 150,2,"Current weapon: Minigun"
                    Case 6
                        Text 150,2,"Current weapon: Flamethrower"
                    Case 7
                        Text 150,2,"Current weapon: Bazooka"
                EndSelect

                If Rand(10000)>9995 Then
                    lol.Healthpack = New(Healthpack)
                    lol\HX = Rand(400)
                    lol\HY = Rand(300)
                EndIf

                Color cbred
                For lol.HealthPack = Each HealthPack
                    Box lol\HX,lol\HY+5,15,5
                    Box lol\Hx+5,lol\HY,5,15
                    If x>lol\HX And x<lol\HX+15 And y>lol\HY And y<lol\HY+15 Then hp=Hp+(100-hp)/2 : Delete lol
                Next lol

                Color cbwhite
                If maxbotamount>150 Then maxbotamount=150
                If botadd+Max(8000-KillCount*50,3500)<Timer() Then
                    MaxBotAmount+1
                    If BotAmount<MaxBotAmount Then
                        For i=1 To MaxBotAmount-BotAmount
                            spawn.Bot = New(Bot)
                            spawn\botx = Rand(1)*400
                            spawn\boty = Rand(-20,320)
                            spawn\bothp=30+killcount/100*5
                            Botamount+1
                        Next i
                    botadd=Timer()
                    EndIf
                EndIf

                If Killcount>9 Then MaxVal=2
                If killCount>19 Then MaxVal=3
                If KillCount>29 Then MaxVal=4
                If killcount>49 Then maxVal=5
                If killcount>69 Then maxVal=6
                If killcount>100 Then maxVal=7



                For spawn.Bot = Each bot
                    If spawn\bothp<0 Then Delete spawn : killcount+1 : botamount-1
                    tmp=GetAngle(spawn\botx,spawn\boty,x,y)
                    spawn\botx=spawn\botx+Cos(tmp)*1
                    spawn\boty=spawn\boty-Sin(tmp)*1
                    Text spawn\botx,spawn\boty,"$"
                    If x+1>spawn\botx And x<spawn\botx+TextWidth("#")-1 And y+1>spawn\boty And y<spawn\boty+TextHeight("#")-1 Then Hp-1
                Next spawn

                Text x,y,"#"

                If (KeyDown(cbkeyd)-KeyDown(cbkeya))*2<>0 And (KeyDown(cbkeys)-KeyDown(cbkeyw))*2<>0 Then
                    x=x+(KeyDown(cbkeyd)-KeyDown(cbkeya))*2
                    y=y+(KeyDown(cbkeys)-KeyDown(cbkeyw))*2
                Else
                    x=x+(KeyDown(cbkeyd)-KeyDown(cbkeya))*3
                    y=y+(KeyDown(cbkeys)-KeyDown(cbkeyw))*3
                EndIf

                angle=GetAngle(x,y,MouseX(),MouseY())

                If val=6 Then
                    UpdateAsciiThrusters(MouseDown(1),1,x+3,y+3,angle-8,angle+8,40,2,120,80)
                EndIf

                UpdateAsciiExplosions()

                If MouseDown(1) Then
                    Select val
                        Case 1
                            If aika+350<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                        Case 2
                            If aika+650<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                        Case 3
                            If aika+400<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                        Case 4
                            If aika+120<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                        Case 5
                            If aika+90<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                        Case 7
                            If aika+2000<Timer() Then NewBullet(x+3,y+3,angle,val) : aika=Timer()
                    EndSelect
                EndIf
                UpdateBullets()
                val=val+MouseMoveZ()
                If val<1 Then val=MaxVal
                If val>MaxVal Then val=1
                DrawScreen
                Forever

                Function NewBullet(x,y,angle,BulletType)
                    Select BulletType
                        Case 1,3,7
                            uusi.Bullet = New(Bullet)
                            uusi\BType = BulletType
                            uusi\BX = X
                            uusi\BY = Y
                            uusi\BAngle = angle
                           
                        Case 2
                            For i=-6 To 6 Step 2
                                uusi.Bullet = New(Bullet)
                                uusi\BType = BulletType
                                uusi\BX = X
                                uusi\BY = Y
                                uusi\BAngle = wrapangle(Angle+i)
                            Next i
                       
                        Case 4
                            uusi.Bullet = New(Bullet)
                            uusi\BType = BulletType
                            uusi\BX = X
                            uusi\BY = Y
                            uusi\BAngle = angle + Rand(-3,3)
                        Case 5
                            uusi.Bullet = New(Bullet)
                            uusi\BType = BulletType
                            uusi\BX = X
                            uusi\BY = Y
                            uusi\BAngle = angle + Rand(-9,9)
                     EndSelect
                EndFunction

                Function UpdateBullets()
                    For uusi.Bullet = Each Bullet   
                        Select uusi\BType
                            Case 1,2,3,7
                                uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*3
                                uusi\By = uusi\By-Sin(uusi\Bangle)*3
                                If val=7 Then Text uusi\bx,uusi\by,Chr(184) else Dot uusi\bx,uusi\by
                            Case 4
                                uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*5
                                uusi\By = uusi\By-Sin(uusi\Bangle)*5
                                Dot uusi\bx,uusi\by
                            Case 5
                                uusi\Bx = uusi\Bx+Cos(uusi\BAngle)*7
                                uusi\By = uusi\By-Sin(uusi\Bangle)*7
                                Dot uusi\bx,uusi\by
                         EndSelect
                        If uusi\bx>400 Or uusi\bx<0 Or uusi\by>300 Or uusi\by<0 Then Delete uusi
                       
                        For spawn.bot = Each bot
                            If uusi\bx>spawn\botX And uusi\bx<spawn\botx+TextWidth("$") And uusi\by>spawn\boty And uusi\by<spawn\boty+TextHeight("$") Then
                                Select uusi\btype
                                    Case 1
                                        spawn\bothp-10
                                    Case 2
                                        spawn\bothp-4
                                    Case 3
                                        spawn\bothp-25
                                    Case 4
                                        spawn\bothp-5
                                    Case 5
                                        spawn\bothp-6
                                    Case 7

                                        spawn\bothp-1000
                                        For spawn.bot = Each bot
                                            If Distance(spawn\Botx,spawn\Boty,uusi\bx,uusi\by)<100 Then
                                                spawn\bothp=spawn\bothp-(100-Distance(spawn\Botx,spawn\Boty,uusi\bx,uusi\by))*0.4
                                            EndIf
                                        Next spawn
                                        CreateAsciiExplosion(uusi\bx,uusi\by,100,140,8.0)
                                       
                                EndSelect
                                Delete uusi
                                Exit
                            EndIf
                        Next spawn
                    Next uusi
                EndFunction

                Function CreateAsciiThruster(id)
                    uusi.AscThr = New(AscThr)
                    uusi\ThrID=ID
                    uusi\ThrCurrentParticles=0
                EndFunction

                    Function UpdateAsciiThrusters(mode,id,x,y,angle1,angle2,maxpar,speed,maxdis,spread)
                        For uusi.AscThr = Each AscThr
                            If uusi\ThrID = id Then
                                If uusi\ThrCurrentParticles<Maxpar Then
                                  If mode=True Then   
                                    For i=1 To Maxpar-uusi\ThrCurrentparticles
                                        Create.AscParticles = New(AscParticles)
                                        Create\Particleletter = Chr(178)
                                        Create\ParticleX=x
                                        Create\ParticleY=y
                                        Create\Particleangle=Rand(angle1,angle2)
                                        Create\ParticleDistance = 0
                                        uusi\ThrCurrentParticles=uusi\ThrCurrentParticles+1

                                               
                                    Next i
                                  EndIf
                                EndIf
                            For Create.AscParticles = Each AscParticles
                                    For spawn.Bot = Each bot
                                        If Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance>Spawn\botx And Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance<Spawn\botx+TextWidth("$") And Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance>spawn\boty And Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance<spawn\boty+TextHeight("$") Then
                                            spawn\bothp-2
                                            Delete Create
                                            uusi\ThrCurrentParticles=uusi\ThrCurrentParticles-1
                                            Goto skip
                                        EndIf
                                    Next spawn
                                 If Create\ParticleDistance>Maxdis-Rand(spread) Then
                                    uusi\ThrCurrentParticles=uusi\ThrCurrentParticles-1
                                    Delete create
                                 EndIf
                                 Create\ParticleDistance=Create\ParticleDistance+speed
                                 Text Create\ParticleX+Cos(Create\Particleangle)*Create\ParticleDistance,Create\ParticleY-Sin(Create\Particleangle)*Create\ParticleDistance,create\Particleletter
            skip:
                            Next create
                        EndIf
                        Next uusi
                    EndFunction
                   
                    Function CreateAsciiExplosion(x,y,maxdistance,par,speed#,spread=0)
                        For i=1 To par
                            NewAsciiXplosion.ASCII = New(ASCII)
                            NewAsciiXplosion\parletter = Chr(Rand(35,38))
                            NewAsciiXplosion\parangle = Rand(359)
                            NewAsciiXplosion\Pardis=Rand(spread)
                            NewAsciiXplosion\parx = X
                            NewAsciiXplosion\pary = Y
                            NewAsciiXplosion\Maxdis = Maxdistance
                            NewAsciiXplosion\ParSpeed = Speed
                        Next i
                    EndFunction
                   
                Function UpdateAsciiExplosions()
                    For NewAsciiXplosion.ASCII = Each ASCII
                        NewAsciiXplosion\Pardis=CurveValue(NewAsciiXplosion\Maxdis,NewAsciiXplosion\Pardis,NewAsciiXplosion\parspeed)
                        If NewAsciiXplosion\pardis>NewAsciiXplosion\maxdis-1 Then Delete NewAsciiXplosion
                        Text NewAsciiXplosion\parx+Cos(NewAsciiXplosion\parangle)*NewAsciiXplosion\Pardis,NewAsciiXplosion\pary-Sin(NewAsciiXplosion\parangle)*NewAsciiXplosion\pardis,NewAsciiXplosion\ParLetter
                    Next NewAsciiXplosion
                EndFunction
                    
EDIT:

Onhan se vähän ylivoimainen : D Ja nyt niitä kommentteja prkl!

Last edited by DatsuniG on Tue Dec 16, 2008 3:51 pm, edited 3 times in total.
Hengität nyt manuaalisesti.
Taatero
Advanced Member
Posts: 384
Joined: Tue May 27, 2008 6:06 pm

Re: Pikku pelit

Post by Taatero »

DatsuniG wrote:Nyt on lisätty uusi ase sekä muutettu vihollisten lisäämistä.

Code: Select all

            
           Koodia
                    
SAin päälle 5500 bazookalla, sitten kyllästyin. On muuten aika über ase. :D
[color=#40BF00][u]koodaaja[/u][/color] wrote:Täyden turvan takaamiseksi avain olisi myös kuljetettava offlinenä suoraan tulevien viestien lähettäjältä niiden vastaanottajalle laitakaupungin hämärissä yöneljältä ja varmistettava, ettei kumpaakaan osapuolta seurata. Popliinitakkia suositellaan.
i-point
Newcomer
Posts: 40
Joined: Mon Aug 27, 2007 8:43 pm

Re: Pikku pelit

Post by i-point »

No tässäpä muutama pikku rävellys mitä on tullu tehtyä joskus vuonna nakki ja asderoidihohtimet.
pieni kokeilu partikkeleistä ja tasohyppelystä (sisältää myös koodin)
http://servut.us/i-point/cowdm.zip

enemmän tai vähemmän epäonnistuneita autopelejä
http://servut.us/i-point/drift.zip
http://servut.us/i-point/drift2.zip

laskettelupeli (harvinaisen huono)
http://servut.us/i-point/ponaski.zip

Pong. Tarvitseeko edes muuta mainita?
http://servut.us/i-point/popcorn2.zip
http://servut.us/i-point/ppp3.zip

Hetken mielijohteesta tehty siivouspeli
http://servut.us/i-point/siivous.zip
phons
Guru
Posts: 1056
Joined: Wed May 14, 2008 10:11 am

Re: Pikku pelit

Post by phons »

Tännekkin jotain eloa. Tein tällaisen väitely pelin.

Code: Select all


valikko:
    
    'tyhjentää ruudun
        Color cbBlack
        Cls
    'palauttaa oletus värin
        Color cbWhite
        vx=30
        vx2=30
        vx3=30
    
    'pää looppi
    Repeat
    
        'viivat
        Line 30,0,30,300
        Line 30,90,vx,90
        Line 30,130,vx2,130
        Line 30,170,vx3,170
        
        'valikko namikoiden korostukset
        If MouseX()>30 And MouseX()<90 And MouseY()>85 And MouseY()<105 Then
            vx=50
        Else
            vx=30
        EndIf
        
        If MouseX()>30 And MouseX()<90 And MouseY()>125 And MouseY()<145 Then
            vx2=50
        Else
            vx2=30
        EndIf
        
        If MouseX()>30 And MouseX()<90 And MouseY()>165 And MouseY()<185 Then
            vx3=50
        Else
            vx3=30
        EndIf
        
        'valikko namikoiden tehtävät
        If vx=50 And MouseHit(1) Then Gosub game
        If vx2=50 And MouseHit(1) Then End
        If vx3=50 And Mousedown(1) Then Text 100,100,"Älä osu valkoisiin laatikoihin"
        
        'tekstit
        Text vx,85,"Aloita"
        Text vx2,125,"Lopeta"
        Text vx3,165,"Vinkki"
    
        'piirtää näytön
        DrawScreen
        
    Until EscapeKey()
    
Return

game:

    ClearText
    
    'muuttujat
        x=10
        y=110
        i=100
        d=0
        
    'pää looppi
    Repeat
    
    'esteet
        Box 100,100,30,i
        Box 160,100,30,i
        Box 300,80,i,20
        Box 320,0,60,i
    
    'seinät
        Box 0,80,300,20
        Box 0,195,400,20
        Box 280,0,20,80
        Box 380,80,20,120
    
    'ukkosi
        Box x,y,20,20
    
    'esteiden päivitys
        i=i-1
        If i<1 Then i=100
    
    'kontrollit
        If UpKey() Then y-2
        If LeftKey() Then x-2
        If DownKey() Then y+2
        If RightKey() Then x+2
    
    'törmäys
        If BoxOverlap(x,y,20,20,100,100,30,i) Then x=10: y=110
        If BoxOverlap(x,y,20,20,160,100,30,i) Then x=10: y=110
        If BoxOverlap(x,y,20,20,0,80,300,20) Then x=10: y=110
        If BoxOverlap(x,y,20,20,0,195,400,20) Then x=10: y=110
        If BoxOverlap(x,y,20,20,280,0,20,80) Then x=10: y=110
        If BoxOverlap(x,y,20,20,380,80,20,120) Then x=10: y=110
        If BoxOverlap(x,y,20,20,300,80,i,20) Then x=10: y=110
        If BoxOverlap(x,y,20,20,320,0,60,i) Then x=10: y=110
        If x<0 Then x=10
    
    'voitto paikan määritys ja voiton korostus
            If x>390 Then d=1
            If d=1 Then
                Color cbRed
                Text 200,150,"You win!"
                Color cbWhite
                Text 201,151,"You win!"
                Wait 2000
                Gosub valikko
            EndIf
    
    'piirtää näytön
        DrawScreen
    
    Until EscapeKey()


Return

:lol: Älkää välittäkö kauheasti kommenteista.
Image
Tuxu
Member
Posts: 81
Joined: Tue Oct 14, 2008 5:54 pm
Location: Jyväskylä
Contact:

Re: Pikku pelit

Post by Tuxu »

Tässäpä simppeli Breakout-klooni, jonka väsäsin illassa:

Code: Select all

//Breakout-klooni
//By Tuxu 2009

Dim TIILET(100)'Luodaan tiilille taulukko
Dim tiilix(100) As Short'ja niiden x-sijainnille...
Dim tiiliy(100) As Short'...ja y-sijainnille

FrameLimit 50'nopeusrajoitus ;)
SCREEN 400,300
SetWindow "Breakout"
ClsColor cbwhite'taustaväri

//Fontit://
verdana= LoadFont("courier new",16)'<---Väsynyttä huumoria

//kuvat://
tiili=MakeImage(40,20)'Tehdään tiilet...
maila=MakeImage(50,10)'...maila...
pallo= MakeImage(10,10)'... ja pallo.
hamyx=MakeImage(10,1)'törmäystunnistukseen...
hamyy1=MakeImage(6,1)'...ja tämä myös...
hamyy2=MakeImage(6,1)'...ja tämä

DrawToImage tiili
Color cbdark 
Box 0,0,40,20,0
Color cbred 
Box 1,1,38,18,1
DrawToImage maila
Color cbdark
Box 0,0,60,10,1
DrawToImage pallo
Color cbblue
Circle 0,0,10,1
DrawToScreen
'-------------

alku:
//muuttujat://
xalku=0'ekan tiilen
yalku=0'koordinaatit
xmaila=175'mailan koordinaatit
xpallo=200'pallon
ypallo=130'koordinaatit
vauhtix#=1'pallon vauhti x-suunnassa
vauhtiy#=4'pallon vauhti y-suunnassa
vauhtimaila=0'mailan vauhti
murskatut=0'murskatut tiilet

//Tiilet riviin, järjesty!
For i=1 To 50'50 tiiltä. 
    TIILET(i)=CloneImage(tiili)
    tiilix(i)=xalku'tiilen koordinaatit
    tiiliy(i)=yalku'tallennetaan
    xalku+40'seuraava tiili tulee 30 pikseliä oikeammalle
    If xalku>390 Then xalku=0:yalku+20'jos tiili on liian oikealla niin 
                                       'hypätään toiselle riville
Next i

SetFont verdana//Fontti vaihtuu

//PÄÄLOOPPI//
Repeat
    
    ShowMouse off'hiirtä ei näytetä
    
    //Pallon liikkuminen:
    ypallo=ypallo+vauhtiy
    xpallo=xpallo+vauhtix
    //mailan liikuttaminen
    xmaila=MouseX()-25
    vauhtimaila=MouseMoveX()/2'mailan vauhti
    
    //Törmäystunnistus, melkoinen patenttiratkaisu:
    If ImagesOverlap(maila,xmaila,285,hamyy2,xpallo-2,ypallo+3) Then
        vauhtiy=-vauhtiy
        ypallo-5
        vauhtix+vauhtimaila
    ElseIf ImagesOverlap(maila,xmaila,285,hamyx,xpallo,ypallo-3) Then
        vauhtix=-vauhtix
        vauhtix+vauhtimaila
    EndIf
    If xpallo>390 Or xpallo<0 Then vauhtix#=-vauhtix#
    If ypallo<0 Then vauhtiy = -vauhtiy :ypallo+5
    
    //Kuolema:
    If ypallo>310 Then Text 160,130,"GAME OVER":DrawScreen:Wait 3000: Goto alku
    
    //Pelin läpi pääsy:
    If murskatut>49 Then Text 165,130,"VOITIT":DrawScreen:Wait 3000: Goto alku
    //Piirretään kuvat:
    murskatut=0
    For a=1 To 50'tarkistetaan samalla osuuko pallo tiileihin ja läpäistäänkö peli
        DrawImage TIILET(a),tiilix(a),tiiliy(a)
        If ImagesOverlap(hamyy1,xpallo-2,ypallo,TIILET(a),tiilix(a),tiiliy(a)) Then
            tiilix(a)=2000'jos osuu tiili poies
            vauhtiy = -vauhtiy
            ypallo+5 
        ElseIf ImagesOverlap(hamyy2,xpallo-2,ypallo-9,TIILET(a),tiilix(a),tiiliy(a)) Then
            tiilix(a)=2000'nää on vähän patentti/säätö ratkaisuja
            vauhtiy = -vauhtiy
            ypallo-5 
        ElseIf ImagesOverlap(hamyx,xpallo,ypallo-5,TIILET(a),tiilix(a),tiiliy(a)) Then
            tiilix(a)=2000
            vauhtix = -vauhtix
        EndIf
        If tiilix(a)=2000 Then murskatut+1'lasketaan murskatut tiilet
    Next a
    DrawImage pallo,xpallo,ypallo
    DrawImage maila,xmaila,285
    
    //Tekstit loppuun, jotta piirtyvät päällimmäisenä:
    Text 0,0,"Murskatut tiilet:"+murskatut
    
    DrawScreen
Forever
Mietin pitkään, että laitanko tämän esimerkkeihin vai tänne ja tulin siihen tulokseen, että sopii paremmin tänne :P Tein nimittäin törmäystunnistuksen kuvilla ja jouduin tekemään sellaisia patenttiratkaisuja, joita ei soisi kenenkään käyttävän. Tuo törmäys, kun sattui bugittamaan aika pahasti, eikä se vieläkään ihan täydellinen ole. Jos keksii paremman ratkaisun, niin siitä vaan muokkaamaan. Objecteilla toteutettunahan tuon saisi varmasti helpommin, mutta jatko kehittelyn kannalta ajattelin toteuttaa koko homman kuvilla.

Joo ja koodi on siis vapaata riistaa, eli sen pohjalle saa rakentaa parempaa peliä. Kunhan nyt ei suoraan kopioi(esim. lisää valikoja ja esittelee sitten omanaan) vaan rakentaa tuon päälle oikeasti jotain uutta pelattavaa.

Edit: Pientä korjailua vielä tuohon törmäystunnistukseen. Nyt toimii aikalailla hyvin.
aivot pohtii ja raksuttaa
TuxuGames | Projektiblogi
Post Reply