Pikapelikisa 9 - Kisa on alkanut

Eur0-5isu
Active Member
Posts: 106
Joined: Mon Sep 01, 2008 5:12 pm

Re: Pikapelikisa 9 - Kisa on alkanut

Post by Eur0-5isu »

Elämäni suurinta purkkaa: (Ei vains)

Code: Select all

FrameLimit 40
back=MakeImage(ScreenWidth(),ScreenHeight())
back2=MakeImage(ScreenWidth(),ScreenHeight())

fontti=LoadFont("ahsdouhg3u5asidug",30)
fontti2=LoadFont("ahsdouhg3u5asidug",15)

Repeat
SetWindow "FPS:"+FPS()

For i=1 To ScreenHeight()
    DrawToImage back
        Color r,g,b
        Line x,0,x,ScreenHeight()
        If x<ScreenWidth() then x=x+1
        If x<ScreenWidth() Then x=x+1    
        i=i+1
        If r<255 Then r+1
        If g<255 Then g+1
        If b<255 Then b+1
    DrawToScreen
Next i


DrawImage back,0,0



SetFont fontti
Color 0,255,90
CenterText ScreenWidth()/2,10,"Über Siisti Peli!"



SetFont fontti2
If SiistiButtoni (30,90,"SINGLEPLAYER") Then liikkuu=1
if SiistiButtoni (30,120,"MULTIPLAYER") Then liikkuu=1
if SiistiButtoni (30,150,"HIGHSCORES") Then liikkuu=1
if SiistiButtoni (30,180,"EXIT GAME") Then End
Color 0,255,90
CenterText ScreenWidth()/2,ScreenHeight()-20,"Pikapelivalikko by Eur0-5isu"

If liikkuu Then 
    Color cbblack
    Box x2,0,leveys,ScreenHeight()
    DrawImage back,leveys,0
        If leveys<ScreenWidth() Then
            leveys+10
            Wait 100
        Else
            MakeError "Tässä kohtaa pitäisi tapahtua jotain."
        EndIf
EndIf

DrawScreen
Forever




Function SiistiButtoni(Xs,Xy,teksti$)
    
    Color 255,255,255
    Line Xs,Xy,Xs,Xy+TextHeight(teksti$)+4
    Line Xs,Xy,Xs+TextWidth(teksti$)+12,Xy
    Line Xs,Xy+TextHeight(teksti$)+4,Xs+TextWidth(teksti$)+ScreenWidth()-(0+Xs),Xy+TextHeight(teksti$)+4       
    Text Xs+2,Xy+2,Teksti$ 
        
    If MouseX()>Xs And MouseX()<Xs+TextWidth(teksti$) And MouseY()>Xy And MouseY()<Xy+TextHeight(teksti$)+4
         Color 12,160,30
        Line Xs,Xy,Xs,Xy+TextHeight(teksti$)+4
        Line Xs,Xy,Xs+TextWidth(teksti$)+12,Xy
        Line Xs,Xy+TextHeight(teksti$)+4,Xs+TextWidth(teksti$)+ScreenWidth()-(0+Xs),Xy+TextHeight(teksti$)+4             
    If MouseDown(1) 
        Color 0,255,0
        Line Xs,Xy,Xs,Xy+TextHeight(teksti$)+4
        Line Xs,Xy,Xs+TextWidth(teksti$)+12,Xy
        Line Xs,Xy+TextHeight(teksti$)+4,Xs+TextWidth(teksti$)+ScreenWidth()-(0+Xs),Xy+TextHeight(teksti$)+4              
        lol=0
        ElseIf MouseUp(1) Then 
        lol=1             
    EndIf
    EndIf
    
  Return lol  
  
EndFunction


EDIT: Hitautta miettiville: FPS:n saa korkeammaksi ja liikkeen sulavammaksi ottamalla tuon Wait-komennon riviltä 49 pois. Tämä tosin saattaa olla hidastaa vanhoilla koneilla, joten nyt se näkyy tasapuolisesti kaikille kokeilijoille.
Last edited by Eur0-5isu on Fri Nov 07, 2008 8:07 pm, edited 3 times in total.
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Pikapelikisa 9 - Kisa on alkanut

Post by esa94 »

Galgoneer:
Wow. Siis oikeesti. Wow. Pitää arvostella.

+Toimiva, helppokäyttöinen, hauska idea. Laajennettava.
-Taulukko vie muistia ehkä hiukan liikaa, sillä kaikkia soluja ei tarvita joka kohdassa. Tyyppitoteutus olisi mukava nähdä.

Sisu:
Mahtava! Hieno efekti ja tyylikäs valikko.

+Toimii ja tyylikkäästi.
-Turhan matala FPS, valikkoefektin ei saisi syödä sitä hirveästi. Sain samat FPS:ät, kuin siinä yhdessä 3d-tsydeemissä detaililla 1.
Last edited by esa94 on Fri Nov 07, 2008 7:51 pm, edited 1 time in total.
nevssons
Devoted Member
Posts: 503
Joined: Sun Jan 13, 2008 5:02 pm

Re: Pikapelikisa 9 - Kisa on alkanut

Post by nevssons »

Vaikken olekkaan ilmoittautunut osallistun silti:

Code: Select all

SCREEN 400,300 
FrameLimit 30

Const SÄDE = 15
Const MÄÄRÄ= 20
Const VÄLI = 10
Const NOPEUS= 3
Const TÄYTTÖ= 0
Const KÄÄNTYVYYS= 10
Dim XYA(3,MÄÄRÄ)

ClsColor 100,100,100:Cls
Color 0,0,0
Repeat
    palkki("Über valikko 3000",50,70,300,20)
    If button("Aloita!",120,100,160,20) Then MakeError "Aloitit!"
    If button("Ohjeet",120,130,160,20) Then MakeError "Äänestä tätä valikkoa!"
    If button("Asetukset",120,160,160,20) Then MakeError "Asetuksia ei ole"
    If button("Lopeta",150,190,100,20) Then MakeError "Lopetit! Etkö muka pidä valikostani? >:("
    Gosub Luonti
    Gosub Muut
    DrawScreen
Forever

Luonti:
    If LVM=VÄLI Then
        If Tehdyt=MÄÄRÄ Then
            For f=2 To MÄÄRÄ
                XYA(1,f-1)=XYA(1,f)
                XYA(2,f-1)=XYA(2,f)
                XYA(3,f-1)=XYA(3,f)
            Next f
            tehdyt-1
        EndIf

        If Rand(1,2)=1 Then
            XYA(1,tehdyt+1)=1
            XYA(2,tehdyt+1)=ScreenHeight()-1
            XYA(3,tehdyt+1)=Rand(105,165)
        Else
            XYA(1,tehdyt+1)=ScreenWidth()-1
            XYA(2,tehdyt+1)=ScreenHeight()-1
            XYA(3,tehdyt+1)=Rand(15,75)
        EndIf

        tehdyt+1
        LVM=0
    EndIf
    LVM+1
Return

Muut:
    For f=1 To tehdyt
        XYA(3,f)=XYA(3,f)+Rand(0-kääntyvyys,0+kääntyvyys)
        XYA(1,f)=XYA(1,f)-Cos(XYA(3,f))*NOPEUS
        XYA(2,f)=XYA(2,f)-Sin(XYA(3,f))*NOPEUS

        If XYA(1,f)>ScreenWidth() Then XYA(1,f)=ScreenWidth()-1
        If XYA(1,f)<0 Then XYA(1,f)=1
        If XYA(2,f)>ScreenHeight() Then XYA(2,f)=ScreenHeight()-1
        If XYA(2,f)<0 Then XYA(2,f)=1

        RoundDot(XYA(1,f),XYA(2,f),SÄDE,Täyttö)
    Next f
Return

Function RoundDot(x,y,säe,tila=1)
    Circle x-säe,y-säe,säe*2,tila
    Circle (x-säe)+säe/2,(y-säe)+säe/2,säe/2-2,tila
EndFunction 








Function Button(Tex$,x,y,w,h)
If MouseX()>x And MouseX()<x+w And MouseY()>y And MouseY()<y+h Then
If MouseDown(1) Then 
Color 120,120,120
Else
Color 150,150,150
EndIf 
päällä=1
Else  
Color 200,200,200
EndIf 
Box x+h/2,y,w-h,h
Circle x,y,h
Circle x+w-h,y,h
Color 0,0,0
CenterText x+w/2,y+h/2,Tex$,2
If päällä And MouseUp(1) Then Return 1
EndFunction 

Function palkki(Tex$,x,y,w,h)

Color 200,200,200

Box x+h/2,y,w-h,h
Circle x,y,h
Circle x+w-h,y,h
Color 0,0,0
CenterText x+w/2,y+h/2,Tex$,2

EndFunction 
Tehty 1h (jonkiverran alle)
Ja eurosisulla on UPEA!
EDIT:

Muokkasin vähän

Last edited by nevssons on Fri Nov 07, 2008 7:58 pm, edited 3 times in total.
Koodarina kohtalainen, henkilönä vittumainen
Image
E.T.
Newcomer
Posts: 42
Joined: Thu Jul 03, 2008 9:33 am

Re: Pikapelikisa 9 - Kisa on alkanut

Post by E.T. »

Tässä oma valikkoni ja peli, jossa tarkoitus on saada pallo laatikkoon. Palloa ohjataan valikosta

Code: Select all

SCREEN 640,400
Const määräx=4
Const määräy=5
Const kokox=160
Const kokoy=30
r#=0
g#=1
bl#=1

Dim valikko(määräx,määräy) As String
Dim väri(määräx)

valikko(0,0)="Peli"
valikko(0,1)="Uusi"
valikko(0,2)="Kumoa"
valikko(0,3)="Asetukset"
valikko(0,4)="Lopeta"

valikko(1,0)="Liiku"
valikko(1,1)="Ylös"
valikko(1,2)="Alas"
valikko(1,3)="Vasen"
valikko(1,4)="Oikea"

valikko(2,0)="valikko 3"
valikko(2,1)="valinta3,1"
valikko(2,2)="valinta3,2"
valikko(2,4)="valinta3,4"
valikko(2,5)="valinta3,5"

valikko(3,0)="valikko 4"
valikko(3,1)="tyhjennä"

alku:
pallox=100
palloy=200


Repeat
    x=RoundDown(MouseX()/kokox)
    y=RoundDown(MouseY()/kokoy)
    If MouseY()<kokoy Or väri(x)>25 And MouseY()<kokoy*(määräy+1) Then
        väri(x)=Min(väri(x)+7,255)
    EndIf
    If MouseHit(1) And x<=määräx Then
        If y=0 Then
            väri(x)=255
        ElseIf y<=määräy
            If valikko(x,y)<>"" Then
                valix=x
                valiy=y
            EndIf
        EndIf
    EndIf
    Select valix+","+valiy
    Case "0,1"
        Goto alku
    Case "0,2"
        Repeat
            CenterText ScreenWidth()/2,ScreenHeight()/2,"Ei voi kumota"
            DrawScreen
        Until KeyHit(cbkeyreturn)
    Case "0,3"
        Repeat
            rr=Input("RGB RED:")
            DrawScreen
        Until KeyHit(cbkeyreturn)
        CloseInput
        Repeat
            gg=Input("RGB GREEN:")
            DrawScreen
        Until KeyHit(cbkeyreturn)
        CloseInput
        Repeat
            bb=Input("RGB BLUE:")
            DrawScreen
        Until KeyHit(cbkeyreturn)
        CloseInput
        r#=Min(1,Max(0,Float(rr)/255.0))
        g#=Min(1,Max(0,Float(gg)/255.0))
        bl#=Min(1,Max(0,Float(bb)/255.0))
    Case "0,4"
        End
    Case "1,1"
        palloy=palloy-25
    Case "1,2"
        palloy=palloy+25
    Case "1,3"
        pallox=pallox-25
    Case "1,4"
        pallox=pallox+25
    Case "3,1"
        valikko(3,0)="tyhjä"
        valikko(3,1)=""
    EndSelect
    valix=-1
    valiy=-1
    
    If Abs(pallox-300)+Abs(palloy-100)<51 Then
        Repeat
            CenterText ScreenWidth()/2,ScreenHeight()/2,"Voitit!"
            DrawScreen
        Until KeyHit(cbkeyreturn)
        Goto alku
    EndIf
    
    For a=0 To määräx
        Color 255*r#,255*g#,255*bl#
        If valikko(a,0)<>"" Then
            Box kokox*a,0,kokox,kokoy,0
            CenterText kokox*a+kokox/2,kokoy/2,valikko(a,0),2
            Color väri(a)*r#,väri(a)*g#,väri(a)*bl#
            For b=1 To määräy
                If valikko(a,b)<>"" Then
                    Box kokox*a,kokoy*b,kokox,kokoy,0
                    CenterText kokox*a+kokox/2,kokoy*b+kokoy/2,valikko(a,b),2
                EndIf
            Next b
            väri(a)=Max(väri(a)-4,0)
        EndIf
    Next a
    Color 255*r#,255*g#,255*bl#
    Circle pallox,palloy,50,1
    If pallox=100 And palloy=200 Then Box 300,100,50,50,0
    If Max(Abs(pallox-300),Abs(palloy-100))<3 Then Box 300,100,50,50,0
    DrawScreen
Forever
Quidquid latine dictum sit, altum videtur.
Voitot: Viikkokisa XVII
TheFish
Developer
Developer
Posts: 477
Joined: Mon Aug 27, 2007 9:28 pm
Location: Joensuu

Re: Pikapelikisa 9 - Kisa on alkanut

Post by TheFish »

Yllätyin siitä, että kaikki tekivät valikkonsa täysin kovakoodattuna, joten päätin tehdä huvikseni tänne yhden joka lukee napit/kuvat tiedostosta (tai oikeastaan tein sen jo ennen kun näin miten muut tekivät, mutta päätin laittaa sen tänne vasta sen jälkeen). Vielähän tuossa riittää parantamisen varaa, ja graafiselta puolelta tämä ei kovin kummoisia efektejä tue (oikeastaan vain nappien highlightit, ja nekin vain kaksi frameisen kuvan takia), mutta aika ei oikein anna periksi...

Itse tiedostot ovat liitteenä. (ei exeä, vain sorsa)
Last edited by TheFish on Fri Nov 07, 2008 8:10 pm, edited 1 time in total.
CoolBasic henkilökuntaa
Kehittäjä
Tuxu
Member
Posts: 81
Joined: Tue Oct 14, 2008 5:54 pm
Location: Jyväskylä
Contact:

Re: Pikapelikisa 9 - Kisa on alkanut

Post by Tuxu »

Wauh... Euro-sisulta kyllä paras tähän asti. Hiljaseksi vetää.
Nevssonsilta kans aikas hieno veto.

E.T:ltä oli kyl omaperänen idea, että plussaa siitä =)
Last edited by Tuxu on Fri Nov 07, 2008 8:08 pm, edited 1 time in total.
aivot pohtii ja raksuttaa
TuxuGames | Projektiblogi
dem0
Newcomer
Posts: 43
Joined: Wed Mar 19, 2008 7:36 am

Re: Pikapelikisa 9 - Kisa on alkanut

Post by dem0 »

Code: Select all

AddText "Valicco 0.1"
AddText "1 - Mene pois"
AddText "2 - Lopeta"
AddText "3 - Sammuta"

Repeat
    inbut$ = Input(":o ")
    Select inbut
        Case 1: End
        Case 2: End
        Case 3: End
    End Select
    DrawScreen
Forever
Voitinko?

Sanoisin että harvinaisen tylsä aihe, ei jaksanut tehdä mitään.
User avatar
TheDuck
Devoted Member
Posts: 632
Joined: Sun Aug 26, 2007 3:51 pm
Location: C:\Program Files\Tuusula\

Re: Pikapelikisa 9 - Kisa on alkanut

Post by TheDuck »

Asd, aika loppu ja salkkarit tuli, ei tästä tullu mittää -.-

Code: Select all

SCREEN 640,480,0,cbfullscreen
arial = LoadFont("arial", 65, 1,1,1)
coolb = LoadFont("coolb", 20)

mouse = MakeImage(16,16)
DrawToImage mouse
    Color cbDarkRed
    Line 16,0,0,16
    Line 0,0,0,16
    Line 0,0,16,0
DrawToScreen 
ShowMouse mouse

Repeat
    SetFont arial
    Color cbred
    Text 250,10,"ihQpeli"
    r=Rand(0,255)
    Color r,r,r
    Circle 0,0,201,0
    Line 100,100,100+Sin(Timer()/10)*100,100+Cos(Timer()/10)*100
    SetFont coolb
    If painike(325,120,"UUSI PELI") Then End
    If painike(325,180,"LOPETA") Then End
    Color cbgreen
    Box 50, 400, 150, 50, 0
    Text 52, 402, "FPS: "+FPS()
    Text 52, 422, "Made by TheDuck"
    DrawScreen
Forever 

Function painike(x,y,txt$)
    If MouseX()>x-10 And MouseX()<x+TextWidth(txt$)+20 And MouseY()>y-10 And MouseY()<y+TextHeight(txt$)+20 Then
        Color cbred
        If MouseHit(1) Then Return 1
    Else
        Color cbdarkred
    EndIf 
    Box x-10,y-10,TextWidth(txt$)+20,TextHeight(txt$)+20,0
    If MouseX()>x-10 And MouseX()<x+TextWidth(txt$)+20 And MouseY()>y-10 And MouseY()<y+TextHeight(txt$)+20 Then
        Color 220,0,0
    Else
        Color cbred
    EndIf 
    Box x-9,y-9,TextWidth(txt$)+18,TextHeight(txt$)+18,1
    Color cbblack
    Text x,y,txt$
EndFunction 
Jos joku onneton menee äänestämään niin repeen >:D
^^
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Pikapelikisa 9 - Kisa on alkanut

Post by Awaclus »

Nyt vähän hidastelin; anteeksi. Nyt pistän äänestystopicin pystyyn.
Post Reply