Pikku pelit

Jaa meneillään olevat projektisi tai valmiit pelit muun yhteisön kanssa täällä.
Someday coder
Active Member
Posts: 106
Joined: Wed Jul 30, 2008 5:04 pm

Re: Pikku pelit

Post by Someday coder »

Toi epilepsia efekti on aika hyvä, mutta lisäsin nurmikon alle ja veren roiskumaan:

Code: Select all

    SCREEN 800, 600
    SAFEEXIT OFF
    Global tausta
    'Vaikeustaso (100 on jo vaikea, nostaminen helpottaa)
    'LEVINC on vaikeustason muutosnopeus
    Dim LEVEL As Float
    LEVEL = 50.0
    Const LEVINC = 0.5

    'Liikkeen moninkertaistus (Pikseliä/frame)
    Const MVMUL = 8
    Const ZMVMUL = 6
    Const DIACOM = 0.707106781 'Vinottaisliikkeen kompensointii ( 1 / sqrt( 2 ) )

    'Säädä tähän 1 ja kärsi
    Const EPILEPSY = 1

    'Cooldown ja patien dama ja nopeus
    Const CLDOWN = 10
    Const BLTDMG = 25
    Const BLTSPD = 15
    Const CLIPSZ = 16
    Const RLDTIEM = 60

    'Pisteitä per osuma
    Const PNTAMO = 5

    'Zombien spawnietäisyys
    Const MINRNG = 64
    Const MAXRNG = 256

    'Zombien vaurio ja kesto
    Const ZOMDMG = 2.0
    Const ZOMHEA = 10.0

    'Ruudun rajat
    Const _RBORD = 378
    Const _LBORD = -378
    Const _UBORD = -278
    Const _DBORD = 278

    FrameLimit 40
    ClsColor 255, 255, 255 'Iloinen valkoinen mualima
    Smooth2D ON

    Type Bullet 'Pum ja sillee

    Field obj As Integer
    Field dmg As Float
    Field spd As Float

    EndType

    Type Zombie 'Zombejaaaaaaaaa

    Field obj As Integer
    Field hp As Float
    Field dmg As Float

    EndType

    Dim HP, _upmv, _sdmv As Float
    Global MasterZombo As Integer
    Dim Soldier, i, _pts, _x, _y, _fix, _fix2, _fix3, _fix4, _zsp, _cld, _clip, _empty As Integer
    Dim iz.Zombie, z.Zombie, b.Bullet, pz.Bullet
    Soldier = LoadObject( "media/soldier.bmp", 72 )
    MasterZombo = LoadObject( "media/guy.bmp", 72 )
    MasterBullet = LoadObject( "media/bullet.bmp", 72 )
    ShowObject MasterZombo, OFF
    ShowObject MasterBullet, OFF

    _clip = CLIPSZ
    _zsp = 0
    _rld = 0
    _pts = 0
    HP = 100.0
    
    tausta = MakeImage(800,600)
    DrawToImage tausta
    Lock Image(tausta)
    For i=0 To 800
        For j=0 To 600
            vari = Rand(1,20) + (Rand(150,200) Shl 8) + (Rand(1,50) Shl 16) + (255 Shl 24)
            PutPixel2 i,j,vari
        Next j
    Next i
    Unlock Image(tausta)
    DrawToScreen
    
    Repeat
       DrawImage tausta,0,0
       _upmv = ( KeyDown( cbKeyD ) - KeyDown( cbKeyA ) )
       _sdmv = ( KeyDown( cbKeyW ) - KeyDown( cbKeyS ) )
       
       If _upmv > 0 And _sdmv > 0
       
          'Molemmat näppäimet on painettu pohjaan
          'Täten molempiin voidaan vain sijoittaa uusi arvo
          _upmv = DIACOM
          _sdmv = DIACOM
       
       EndIf
       
       'Hiiriohjaus + mitälie
       TranslateObject Soldier, _upmv * MVMUL, _sdmv * MVMUL
       RotateObject Soldier, -GetAngle( ObjectX( Soldier ), ObjectY( Soldier ), MouseWX(), MouseWY() )
       
       _x = ObjectX( Soldier )
       _y = ObjectY( Soldier )
       
       DrawGame
       'Jostain syystä vaatii tämän
       _fix = _LBORD
       If _x < _LBORD Then
          PositionObject Soldier, _fix, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y < _UBORD Then
          PositionObject Soldier, _x, _UBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _x > _RBORD Then
          PositionObject Soldier, _RBORD, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y > _DBORD Then
          PositionObject Soldier, _x, _DBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       _zsp = _zsp - 1
       If _zsp =< 0 Then         
          _zsp = Int( LEVEL )
          LEVEL = Max(LEVEL - LEVINC, 0)
          SpawnZombo()   
       EndIf
       
       _cld = _cld - 1

       If KeyHit( cbKeyR ) Then
       
          _clip = 0
          _cld = 0
          _empty = RLDTIEM
       
       EndIf
       
       If _clip > 0 And MouseDown( 1 ) And _cld =< 0 Then

          _cld = CLDOWN
          _clip = _clip - 1
          b.Bullet = New( Bullet )
          b\obj = CloneObject( MasterBullet )
          b\dmg = BLTDMG
          b\spd = BLTSPD
          CloneObjectPosition b\obj, Soldier
          CloneObjectOrientation b\obj, Soldier

       ElseIf _clip =< 0 Then
          
          If _empty =< 0 Then
       
             _clip = CLIPSZ
             _empty = RLDTIEM

          Else
             _empty = _empty - 1
          EndIf
       
       EndIf
       
       For iz.Zombie = Each Zombie
          
          PointObject iz\obj, Soldier
          MoveObject iz\obj, ZMVMUL
          Color cbBlack
          
          If ObjectsOverlap( iz\obj, Soldier, 2 ) Then
             'EPILEPSIA
             DrawScreen 
             If EPILEPSY Then ClsColor Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) )
             HP = HP - iz\dmg
          EndIf
          
          For pz.Bullet = Each Bullet
             
             If ObjectsOverlap( pz\obj, iz\obj, 2 ) Then
                x1# = ObjectX(iz\obj)+400
                y1# = Abs(ObjectY(iz\obj)-300)
                _pts = _pts + PNTAMO
                iz\hp = iz\hp - pz\dmg
                angle# = GetAngle(_x + 400,Abs(_y - 300),x1#,y1#)
                Blood(x1#,y1#,angle#)
                DeleteObject pz\obj
                Delete pz
             EndIf
          
          Next pz
          
          If iz\hp =< 0 Then
             DeleteObject iz\obj
             Delete iz
          EndIf
          
       Next iz
       
       For pz.Bullet = Each Bullet
          
          MoveObject pz\obj, pz\spd
          
          _x = ObjectX( pz\obj )
          _y = ObjectY( pz\obj )
          
          _fix = _LBORD
          _fix2 = _UBORD
          _fix3 = _RBORD
          _fix4 = _DBORD
          If ( _x < _fix ) Or ( _y < _fix2 ) Or ( _x > _fix3 ) Or ( _y > _fix4 ) Then
             DeleteObject pz\obj
             Delete pz
          EndIf
       
       Next pz

       SetWindow "HP: " + HP + " Panokset: " + _clip + " Pisteet: " + _pts + " Seuraava: " + _zsp

       DrawScreen
       ClsColor 255, 255, 255
       
       If HP < 0 Then MakeError "Hävisit, lopulliset pisteet " + _pts

    Forever

    Function SpawnZombo()
       
       z.Zombie = New( Zombie )
       z\obj = CloneObject( MasterZombo )
       z\dmg = ZOMDMG
       z\hp = ZOMHEA
       _fix = _UBORD
       _fix2 = _LBORD
       Select Rand( 0, 3 )
          
          Case 0
             PositionObject z\obj, _RBORD + Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 1
             PositionObject z\obj, _LBORD - Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 2
             PositionObject z\obj, Rand( _fix2, _RBORD ), _DBORD + Rand( MINRNG, MAXRNG )     
          Case 3
             PositionObject z\obj, Rand( _fix2, _RBORD ), _UBORD - Rand( MINRNG, MAXRNG )         
          
       EndSelect
       ShowObject z\obj, ON   

    EndFunction 
    
    Function blood(x,y,angle)
    DrawToImage tausta
    Lock Image(tausta)
        For i=0 To 200 
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(angle + Rand(-25,25))*Rand(1,55)
            py = py - Sin(angle + Rand(-25,25))*Rand(1,55)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
        Next i
        For i=0 To 400 
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,35)
            py = py - Sin(Rand(0,360))*Rand(1,35)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
            vari = 0 + (0 Shl 8) + (Rand(50,200) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,15)
            py = py - Sin(Rand(0,360))*Rand(1,15)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
        Next i
    Unlock Image(tausta)
    DrawToScreen
EndFunction
User avatar
MetalRain
Active Member
Posts: 188
Joined: Sun Mar 21, 2010 11:17 am
Location: Espoo

Re: Pikku pelit

Post by MetalRain »

Pistinpäs vielä ammuksista jäämään kentälle hylsyjä, tämähän alkaa muistuttamaan jo peliä jota joskus kehittelin.

Code: Select all

    SCREEN 800, 600
    
    Global sw,sh
    
    sw=ScreenWidth()
    sh=ScreenHeight()
    SAFEEXIT OFF
    Global tausta
    'Vaikeustaso (100 on jo vaikea, nostaminen helpottaa)
    'LEVINC on vaikeustason muutosnopeus
    Dim LEVEL As Float
    LEVEL = 50.0
    Const LEVINC = 0.5

    'Liikkeen moninkertaistus (Pikseliä/frame)
    Const MVMUL = 8
    Const ZMVMUL = 6
    Const DIACOM = 0.707106781 'Vinottaisliikkeen kompensointii ( 1 / sqrt( 2 ) )

    'Säädä tähän 1 ja kärsi
    Const EPILEPSY = 1

    'Cooldown ja patien dama ja nopeus
    Const CLDOWN = 10
    Const BLTDMG = 25
    Const BLTSPD = 15
    Const CLIPSZ = 16
    Const RLDTIEM = 60

    'Pisteitä per osuma
    Const PNTAMO = 5

    'Zombien spawnietäisyys
    Const MINRNG = 64
    Const MAXRNG = 256

    'Zombien vaurio ja kesto
    Const ZOMDMG = 2.0
    Const ZOMHEA = 10.0

    'Ruudun rajat
    Const _RBORD = 378
    Const _LBORD = -378
    Const _UBORD = -278
    Const _DBORD = 278

    FrameLimit 40
    ClsColor 255, 255, 255 'Iloinen valkoinen mualima
    Smooth2D ON

    Type Bullet 'Pum ja sillee

    Field obj As Integer
    Field dmg As Float
    Field spd As Float

    EndType

    Type Zombie 'Zombejaaaaaaaaa

    Field obj As Integer
    Field hp As Float
    Field dmg As Float

    EndType

    Dim HP, _upmv, _sdmv As Float
    Global MasterZombo As Integer
    Dim Soldier, i, _pts, _x, _y, _fix, _fix2, _fix3, _fix4, _zsp, _cld, _clip, _empty As Integer
    Dim iz.Zombie, z.Zombie, b.Bullet, pz.Bullet
    Soldier = LoadObject( "media/soldier.bmp", 72 )
    MasterZombo = LoadObject( "media/guy.bmp", 72 )
    MasterBullet = LoadObject( "media/bullet.bmp", 72 )
    ShowObject MasterZombo, OFF
    ShowObject MasterBullet, OFF

    _clip = CLIPSZ
    _zsp = 0
    _rld = 0
    _pts = 0
    HP = 100.0
    
    tausta = MakeImage(800,600)
    DrawToImage tausta
    Lock Image(tausta)
    For i=0 To 800
        For j=0 To 600
            vari = Rand(1,20) + (Rand(150,200) Shl 8) + (Rand(1,50) Shl 16) + (255 Shl 24)
            PutPixel2 i,j,vari
        Next j
    Next i
    Unlock Image(tausta)
    DrawToScreen
    
    Repeat
       DrawImage tausta,0,0
       _upmv = ( KeyDown( cbKeyD ) - KeyDown( cbKeyA ) )
       _sdmv = ( KeyDown( cbKeyW ) - KeyDown( cbKeyS ) )
       
       If _upmv > 0 And _sdmv > 0
       
          'Molemmat näppäimet on painettu pohjaan
          'Täten molempiin voidaan vain sijoittaa uusi arvo
          _upmv = DIACOM
          _sdmv = DIACOM
       
       EndIf
       
       'Hiiriohjaus + mitälie
       TranslateObject Soldier, _upmv * MVMUL, _sdmv * MVMUL
       RotateObject Soldier, -GetAngle( ObjectX( Soldier ), ObjectY( Soldier ), MouseWX(), MouseWY() )
       
       _x = ObjectX( Soldier )
       _y = ObjectY( Soldier )
       
       DrawGame
       'Jostain syystä vaatii tämän
       _fix = _LBORD
       If _x < _LBORD Then
          PositionObject Soldier, _fix, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y < _UBORD Then
          PositionObject Soldier, _x, _UBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _x > _RBORD Then
          PositionObject Soldier, _RBORD, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y > _DBORD Then
          PositionObject Soldier, _x, _DBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       _zsp = _zsp - 1
       If _zsp =< 0 Then         
          _zsp = Int( LEVEL )
          LEVEL = Max(LEVEL - LEVINC, 0)
          SpawnZombo()   
       EndIf
       
       _cld = _cld - 1

       If KeyHit( cbKeyR ) Then
       
          _clip = 0
          _cld = 0
          _empty = RLDTIEM
       
       EndIf
       
       If _clip > 0 And MouseDown( 1 ) And _cld =< 0 Then

          _cld = CLDOWN
          _clip = _clip - 1
          b.Bullet = New( Bullet )
          b\obj = CloneObject( MasterBullet )
          b\dmg = BLTDMG
          b\spd = BLTSPD
          
          DrawToImage tausta
                Color cbyellow
                ang#= Rand(360)
                tx#=Cos(ang#)*2.5
                ty#=Sin(ang#)*2.5
                
                Line sw/2+_x-tx#,sh/2-_y-ty#,sw/2+_x+tx#,sh/2-_y+ty#
                
          DrawToScreen 
          
          CloneObjectPosition b\obj, Soldier
          CloneObjectOrientation b\obj, Soldier

       ElseIf _clip =< 0 Then
          
          If _empty =< 0 Then
       
             _clip = CLIPSZ
             _empty = RLDTIEM

          Else
             _empty = _empty - 1
          EndIf
       
       EndIf
       
       For iz.Zombie = Each Zombie
          
          PointObject iz\obj, Soldier
          MoveObject iz\obj, ZMVMUL
          Color cbBlack
          
          If ObjectsOverlap( iz\obj, Soldier, 2 ) Then
             'EPILEPSIA
             DrawScreen 
             If EPILEPSY Then ClsColor Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) )
             HP = HP - iz\dmg
          EndIf
          
          For pz.Bullet = Each Bullet
             
             If ObjectsOverlap( pz\obj, iz\obj, 2 ) Then
                x1# = ObjectX(iz\obj)+400
                y1# = Abs(ObjectY(iz\obj)-300)
                _pts = _pts + PNTAMO
                iz\hp = iz\hp - pz\dmg
                angle# = GetAngle(_x + 400,Abs(_y - 300),x1#,y1#)
                Blood(x1#,y1#,angle#)
                DeleteObject pz\obj
                Delete pz
             EndIf
          
          Next pz
          
          If iz\hp =< 0 Then
             DeleteObject iz\obj
             Delete iz
          EndIf
          
       Next iz
       
       For pz.Bullet = Each Bullet
          
          MoveObject pz\obj, pz\spd
          
          _x = ObjectX( pz\obj )
          _y = ObjectY( pz\obj )
          
          _fix = _LBORD
          _fix2 = _UBORD
          _fix3 = _RBORD
          _fix4 = _DBORD
          If ( _x < _fix ) Or ( _y < _fix2 ) Or ( _x > _fix3 ) Or ( _y > _fix4 ) Then
             DeleteObject pz\obj
             Delete pz
          EndIf
       
       Next pz

       SetWindow "HP: " + HP + " Panokset: " + _clip + " Pisteet: " + _pts + " Seuraava: " + _zsp

       DrawScreen
       ClsColor 255, 255, 255
       
       If HP < 0 Then MakeError "Hävisit, lopulliset pisteet " + _pts

    Forever

    Function SpawnZombo()
       
       z.Zombie = New( Zombie )
       z\obj = CloneObject( MasterZombo )
       z\dmg = ZOMDMG
       z\hp = ZOMHEA
       _fix = _UBORD
       _fix2 = _LBORD
       Select Rand( 0, 3 )
          
          Case 0
             PositionObject z\obj, _RBORD + Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 1
             PositionObject z\obj, _LBORD - Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 2
             PositionObject z\obj, Rand( _fix2, _RBORD ), _DBORD + Rand( MINRNG, MAXRNG )     
          Case 3
             PositionObject z\obj, Rand( _fix2, _RBORD ), _UBORD - Rand( MINRNG, MAXRNG )         
          
       EndSelect
       ShowObject z\obj, ON   

    EndFunction 
    
    Function blood(x,y,angle)
    DrawToImage tausta
    Lock Image(tausta)
        For i=0 To 200 
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(angle + Rand(-25,25))*Rand(1,55)
            py = py - Sin(angle + Rand(-25,25))*Rand(1,55)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
        Next i
        For i=0 To 400 
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,35)
            py = py - Sin(Rand(0,360))*Rand(1,35)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
            vari = 0 + (0 Shl 8) + (Rand(50,200) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,15)
            py = py - Sin(Rand(0,360))*Rand(1,15)
            If px < 800 And px > 0 And py > 0 And py < 600 Then PutPixel2 px,py,vari
        Next i
    Unlock Image(tausta)
    DrawToScreen
EndFunction
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Pikku pelit

Post by esa94 »

Pitäskö laittaa Zombo tiätsä peli Githubiin nii sais kehitettyä pidemmälle :V

(Täähän on muuten vaan karsittu Crimsonland-klooni oikeastaan :o)
EDIT:

MetalRainin versio MAVaa..?

EDIT:

Korjattu versio! Edellinen yritti piirtää kuvan ulkopuolelle, josta ainakin Winellä koodi MAVaa

Code: Select all

    SCREEN 800, 600
   
    Global sw,sh
   
    sw=ScreenWidth()
    sh=ScreenHeight()
    SAFEEXIT OFF
    Global tausta
    'Vaikeustaso (100 on jo vaikea, nostaminen helpottaa)
    'LEVINC on vaikeustason muutosnopeus
    Dim LEVEL As Float
    LEVEL = 50.0
    Const LEVINC = 0.5

    'Liikkeen moninkertaistus (Pikseliä/frame)
    Const MVMUL = 8
    Const ZMVMUL = 6
    Const DIACOM = 0.707106781 'Vinottaisliikkeen kompensointii ( 1 / sqrt( 2 ) )

    'Säädä tähän 1 ja kärsi
    Const EPILEPSY = 1

    'Cooldown ja patien dama ja nopeus
    Const CLDOWN = 10
    Const BLTDMG = 25
    Const BLTSPD = 15
    Const CLIPSZ = 16
    Const RLDTIEM = 60

    'Pisteitä per osuma
    Const PNTAMO = 5

    'Zombien spawnietäisyys
    Const MINRNG = 64
    Const MAXRNG = 256

    'Zombien vaurio ja kesto
    Const ZOMDMG = 2.0
    Const ZOMHEA = 10.0

    'Ruudun rajat
    Const _RBORD = 378
    Const _LBORD = -378
    Const _UBORD = -278
    Const _DBORD = 278

    FrameLimit 40
    ClsColor 255, 255, 255 'Iloinen valkoinen mualima
    Smooth2D ON

    Type Bullet 'Pum ja sillee

    Field obj As Integer
    Field dmg As Float
    Field spd As Float

    EndType

    Type Zombie 'Zombejaaaaaaaaa

    Field obj As Integer
    Field hp As Float
    Field dmg As Float

    EndType

    Dim HP, _upmv, _sdmv As Float
    Global MasterZombo As Integer
    Dim Soldier, i, _pts, _x, _y, _fix, _fix2, _fix3, _fix4, _zsp, _cld, _clip, _empty As Integer
    Dim iz.Zombie, z.Zombie, b.Bullet, pz.Bullet
    Soldier = LoadObject( "media/soldier.bmp", 72 )
    MasterZombo = LoadObject( "media/guy.bmp", 72 )
    MasterBullet = LoadObject( "media/bullet.bmp", 72 )
    ShowObject MasterZombo, OFF
    ShowObject MasterBullet, OFF

    _clip = CLIPSZ
    _zsp = 0
    _rld = 0
    _pts = 0
    HP = 100.0
   
	tausta = MakeImage(800,600)
    DrawToImage tausta
    Lock Image(tausta)
    For i=0 To 799
        For j=0 To 599
            vari = Rand(1,20) + (Rand(150,200) Shl 8) + (Rand(1,50) Shl 16) + (255 Shl 24)
            PutPixel2 i,j,vari
        Next j
    Next i
    Unlock Image(tausta)
    DrawToScreen
   
    Repeat
       DrawImage tausta,0,0
       _upmv = ( KeyDown( cbKeyD ) - KeyDown( cbKeyA ) )
       _sdmv = ( KeyDown( cbKeyW ) - KeyDown( cbKeyS ) )
       
       If _upmv > 0 And _sdmv > 0
       
          'Molemmat näppäimet on painettu pohjaan
          'Täten molempiin voidaan vain sijoittaa uusi arvo
          _upmv = DIACOM
          _sdmv = DIACOM
       
       EndIf
       
       'Hiiriohjaus + mitälie
       TranslateObject Soldier, _upmv * MVMUL, _sdmv * MVMUL
       RotateObject Soldier, -GetAngle( ObjectX( Soldier ), ObjectY( Soldier ), MouseWX(), MouseWY() )
       
       _x = ObjectX( Soldier )
       _y = ObjectY( Soldier )
       
       DrawGame
       'Jostain syystä vaatii tämän
       _fix = _LBORD
       If _x < _LBORD Then
          PositionObject Soldier, _fix, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y < _UBORD Then
          PositionObject Soldier, _x, _UBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _x > _RBORD Then
          PositionObject Soldier, _RBORD, _y
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       If _y > _DBORD Then
          PositionObject Soldier, _x, _DBORD
          _x = ObjectX( Soldier )
          _y = ObjectY( Soldier )
       EndIf
       
       _zsp = _zsp - 1
       If _zsp =< 0 Then         
          _zsp = Int( LEVEL )
          LEVEL = Max(LEVEL - LEVINC, 0)
          SpawnZombo()   
       EndIf
       
       _cld = _cld - 1

       If KeyHit( cbKeyR ) Then
       
          _clip = 0
          _cld = 0
          _empty = RLDTIEM
       
       EndIf
       
       If _clip > 0 And MouseDown( 1 ) And _cld =< 0 Then

          _cld = CLDOWN
          _clip = _clip - 1
          b.Bullet = New( Bullet )
          b\obj = CloneObject( MasterBullet )
          b\dmg = BLTDMG
          b\spd = BLTSPD
         
          DrawToImage tausta
                Color cbyellow
                ang#= Rand(360)
                tx#=Cos(ang#)*2.5
                ty#=Sin(ang#)*2.5
               
                Line sw/2+_x-tx#,sh/2-_y-ty#,sw/2+_x+tx#,sh/2-_y+ty#
               
          DrawToScreen
         
          CloneObjectPosition b\obj, Soldier
          CloneObjectOrientation b\obj, Soldier

       ElseIf _clip =< 0 Then
         
          If _empty =< 0 Then
       
             _clip = CLIPSZ
             _empty = RLDTIEM

          Else
             _empty = _empty - 1
          EndIf
       
       EndIf
       
       For iz.Zombie = Each Zombie
         
          PointObject iz\obj, Soldier
          MoveObject iz\obj, ZMVMUL
          Color cbBlack
         
          If ObjectsOverlap( iz\obj, Soldier, 2 ) Then
             'EPILEPSIA
             DrawScreen
             If EPILEPSY Then ClsColor Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) ), Sin( Timer() + Rand( 360 ) )
             HP = HP - iz\dmg
          EndIf
         
          For pz.Bullet = Each Bullet
             
             If ObjectsOverlap( pz\obj, iz\obj, 2 ) Then
                x1# = ObjectX(iz\obj)+400
                y1# = Abs(ObjectY(iz\obj)-300)
                _pts = _pts + PNTAMO
                iz\hp = iz\hp - pz\dmg
                angle# = GetAngle(_x + 400,Abs(_y - 300),x1#,y1#)
                Blood(x1#,y1#,angle#)
                DeleteObject pz\obj
                Delete pz
             EndIf
         
          Next pz
         
          If iz\hp =< 0 Then
             DeleteObject iz\obj
             Delete iz
          EndIf
         
       Next iz
       
       For pz.Bullet = Each Bullet
         
          MoveObject pz\obj, pz\spd
         
          _x = ObjectX( pz\obj )
          _y = ObjectY( pz\obj )
         
          _fix = _LBORD
          _fix2 = _UBORD
          _fix3 = _RBORD
          _fix4 = _DBORD
          If ( _x < _fix ) Or ( _y < _fix2 ) Or ( _x > _fix3 ) Or ( _y > _fix4 ) Then
             DeleteObject pz\obj
             Delete pz
          EndIf
       
       Next pz

       SetWindow "HP: " + HP + " Panokset: " + _clip + " Pisteet: " + _pts + " Seuraava: " + _zsp

       DrawScreen
       ClsColor 255, 255, 255
       
       If HP < 0 Then MakeError "Hävisit, lopulliset pisteet " + _pts

    Forever

    Function SpawnZombo()
       
       z.Zombie = New( Zombie )
       z\obj = CloneObject( MasterZombo )
       z\dmg = ZOMDMG
       z\hp = ZOMHEA
       _fix = _UBORD
       _fix2 = _LBORD
       Select Rand( 0, 3 )
         
          Case 0
             PositionObject z\obj, _RBORD + Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 1
             PositionObject z\obj, _LBORD - Rand( MINRNG, MAXRNG ), Rand( _fix, _DBORD )     
          Case 2
             PositionObject z\obj, Rand( _fix2, _RBORD ), _DBORD + Rand( MINRNG, MAXRNG )     
          Case 3
             PositionObject z\obj, Rand( _fix2, _RBORD ), _UBORD - Rand( MINRNG, MAXRNG )         
         
       EndSelect
       ShowObject z\obj, ON   

    EndFunction
   
    Function blood(x,y,angle)
    DrawToImage tausta
    Lock Image(tausta)
        For i=0 To 200
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(angle + Rand(-25,25))*Rand(1,55)
            py = py - Sin(angle + Rand(-25,25))*Rand(1,55)
            If px < 799 And px > 0 And py > 0 And py < 599 Then PutPixel2 px,py,vari
        Next i
        For i=0 To 400
            vari = 0 + (0 Shl 8) + (Rand(100,255) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,35)
            py = py - Sin(Rand(0,360))*Rand(1,35)
            If px < 799 And px > 0 And py > 0 And py < 599 Then PutPixel2 px,py,vari
            vari = 0 + (0 Shl 8) + (Rand(50,200) Shl 16) + (255 Shl 24)
            px# = x
            py# = y
            px = px + Cos(Rand(0,360))*Rand(1,15)
            py = py - Sin(Rand(0,360))*Rand(1,15)
            If px < 799 And px > 0 And py > 0 And py < 599 Then PutPixel2 px,py,vari
        Next i
    Unlock Image(tausta)
    DrawToScreen
EndFunction
EDIT:

GitHubissa on, pitäkää kivaa :D

saffan
Newcomer
Posts: 1
Joined: Tue Nov 01, 2011 9:30 am

Re: Pikku pelit

Post by saffan »

tässä olisi tämmöinen hauska peli jossa on kolme riviä koodia :D
Attachments
peli.zip
MAV
(586.7 KiB) Downloaded 556 times
Latexi95
Guru
Posts: 1166
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Pikku pelit

Post by Latexi95 »

saffan wrote:tässä olisi tämmöinen hauska peli jossa on kolme riviä koodia :D
Heh heh... Mutta miksi kokonaiset 3 riviä? Eikö yksi olisi riittänyt?
User avatar
axu
Devoted Member
Posts: 854
Joined: Tue Sep 18, 2007 6:50 pm

Re: Pikku pelit

Post by axu »

Enpä nyt parempaakaan paikkaa keksinyt, joten laitetaan tänne: Yatzy-avustaja! Tällä hetkellä kulkee nimellä Jazzy.
Ei tätä ehkä peliksi voi väittää, mutta tästä voi olla apua pelatessa noppapelejä. Peli antaa 2 vaihtoehtoa.
Ensimmäinen kertoo sinulle enemmän todennäköisyyksiä yatzysta kuin haluat tietää ja esittää valistuneen mielipiteensä siitä, mitä sinun kannattaa yrittää (tosin useimmissa tapauksissa tämä "tekoäly" haluaa ottaa ykköset, koska niissä on usein pienin häviö). Keksin jo, miten tehdä tästä parempi, mutta taidan kirjoittaa sen C#:lla sitten (liikaa laskutoimituksia ja koodista tulisi sotkuista ilman olioita).
Toinen, tarpeellisempi vaihtoehto, kysyy sinulta noppayhdistelmää ja kertoo, kuinka suurella todennäköisyydellä heität sen. Voit esimerkiksi kysyä, millä todennäköisyydellä saan ykkösparin viidellä nopalla. EN suosittele kokeilemaan kymmenen nopan yhdistelmää :D

Code: Select all

SCREEN 500, 600
Dim Goal$, Curr$, Chance#, ExLoss#, MinLoss#

Print "Paina 1 avataksesi Yatzy-avustajan."
Print "Paina 2 avataksesi todennäköisyyslaskijan"
Repeat
    key = WaitKey()
    ClearKeys
    If key = 2 Then Exit
    If key = 3 Then Goto ProbCalculator
Forever

Dim Row$(14)
Global rlen
Row(00) = "Ykköset"
Row(01) = "Kakkoset"
Row(02) = "Kolmoset"
Row(03) = "Neloset"
Row(04) = "Viitoset"
Row(05) = "Kuutoset"

Row(06) = "Pari"
Row(07) = "Kolme samaa"
Row(08) = "Neljä samaa"
Row(09) = "Yatzy"
Row(10) = "Kaksi paria"
Row(11) = "Täyskäsi"
Row(12) = "Pieni suora"
Row(13) = "Iso suora"
Row(14) = "Sattuma"

For i = 0 To 14
    rlen = Max(rlen, Len(Row(i)))
Next i

Curr$ = ""
Repeat
    Curr = Input("Nykyinen yhdistelmä: ")
    DrawScreen
Until KeyHit(28) And Len(Curr) = 5
CloseInput
Print "Nykyinen yhdistelmä: " + Curr


MinLoss = 50
Print LSet("Yhdistelmä", rlen) + "Variaatio Todennäk. Pisteet  Odotettu häviö"
For r = 1 To 6                      //Ykkösistä kuutosiin
    Write LSet(Row(r - 1), rlen + 1)
    For i = 1 To 5
        Goal = String(Str(r), i) + String("X", 5 - i)
        Chance = CalcProb2(Curr, Goal)
        Gain = r * i
        Total = r * 5
        ExLoss = Total - (Chance * Gain)
        Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
        If ExLoss < MinLoss Then
            MinLoss = ExLoss
            Winner = r - 1
        EndIf
        Write LSet("", rlen + 1)
    Next i
    Print ""
    WaitKey
Next r

For r = 2 To 5                      //Pareista yatziin
    Write LSet(Row(r + 4), rlen + 1)
    For i = 1 To 6
        Goal = String(Str(i), r) + String("X", 5 - r)
        Chance = CalcProb2(Curr, Goal)
        If r < 5 Then
            Gain = r * i
            Total = r * 6
        Else
            Gain = 50
            Total = 50
        EndIf
        ExLoss = Total - (Chance * Gain)
        Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
        If ExLoss < MinLoss Then
            MinLoss = ExLoss
            Winner = r + 4
        EndIf
        Write LSet("", rlen + 1)
    Next i
    Print ""
    WaitKey
Next r

Write LSet(Row(10), rlen + 1)       //Kaksi paria
For i1 = 1 To 5
    For i2 = i1 + 1 To 6
        Goal = Str(i1) + i1 + i2 + i2 + "X"
        Chance = CalcProb2(Curr, Goal)
        Gain = (i1 + i2) * 2
        Total = 22
        ExLoss = Total - (Chance * Gain)
        Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
        If ExLoss < MinLoss Then
            MinLoss = ExLoss
            Winner = 10
        EndIf
        Write LSet("", rlen + 1)
    Next i2
Next i1
Print ""
WaitKey

Write LSet(Row(11), rlen + 1)       //Täyskäsi
For i1 = 1 To 5
    For i2 = i1 + 1 To 6
        For i = 0 To 1
            Goal = String(Str(i1), 3 - i) + String(Str(i2), 2 + i)
            Chance = CalcProb2(Curr, Goal)
            Gain = i1 * (3 - i) + i2 * (2 + i)
            Total = 28
            ExLoss = Total - (Chance * Gain)
            Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
            If ExLoss < MinLoss Then
                MinLoss = ExLoss
                Winner = 11
            EndIf
            Write LSet("", rlen + 1)
        Next i
    Next i2
Next i1
Print ""
WaitKey

Write LSet(Row(12), rlen + 1)       //Pieni suora
Chance = CalcProb2(Curr, "12345")
Gain = 15
Total = 15
ExLoss = Total - (Chance * Gain)
Print "12345    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
If ExLoss < MinLoss Then
    MinLoss = ExLoss
    Winner = 12
EndIf
Print ""
WaitKey

Write LSet(Row(13), rlen + 1)       //Iso suora
Chance = CalcProb2(Curr, "23456")
Gain = 20
Total = 20
ExLoss = Total - (Chance * Gain)
Print "23456    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
If ExLoss < MinLoss Then
    MinLoss = ExLoss
    Winner = 13
EndIf
Print ""
Print "Suosittelen: " + Row(Winner) + " (odottettu häviö: " + MinLoss + ")"
WaitKey
End





ProbCalculator:
AddText "Anna yhdistelmä jonona numeroita. X = mikä tahansa luku"
AddText "Esim. ykköspari neljällä nopalla: 11XX"
Repeat
    For l = 1 To 15
        Repeat
            Goal = Input("Tavoiteltu yhdistelmä: ")
            DrawScreen
        Until KeyHit(28)
        CloseInput
        
        AddText "Tavoiteltu yhdistelmä: " + Goal
        AddText "Todennäköisyys: " + (CalcProb(Goal) * 100) + "%"
        AddText ""
    Next l
    ClearText
    AddText "Tavoiteltu yhdistelmä: " + Goal
    AddText "Todennäköisyys: " + (CalcProb(Goal) * 100) + "%"
    AddText ""
Forever



Function Yahtzee(Curr$)
    MinLoss# = 50
    Print LSet("Yhdistelmä", rlen) + "Variaatio Todennäk. Pisteet  Odotettu häviö"
    For r = 1 To 6                      //Ykkösistä kuutosiin
        Write LSet(Row(r - 1), rlen + 1)
        For i = 1 To 5
            Goal$ = String(Str(r), i) + String("X", 5 - i)
            Chance# = CalcProb2(Curr, Goal)
            Gain = r * i
            Total = r * 5
            ExLoss# = Total - (Chance * Gain)
            Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
            If ExLoss < MinLoss Then
                MinLoss = ExLoss
                Winner = r - 1
            EndIf
            Write LSet("", rlen + 1)
        Next i
        Print ""
        WaitKey
    Next r
    
    For r = 2 To 5                      //Pareista yatziin
        Write LSet(Row(r + 4), rlen + 1)
        For i = 1 To 6
            Goal$ = String(Str(i), r) + String("X", 5 - r)
            Chance# = CalcProb2(Curr, Goal)
            If r < 5 Then
                Gain = r * i
                Total = r * 6
            Else
                Gain = 50
                Total = 50
            EndIf
            ExLoss# = Total - (Chance * Gain)
            Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
            If ExLoss < MinLoss Then
                MinLoss = ExLoss
                Winner = r + 4
            EndIf
            Write LSet("", rlen + 1)
        Next i
        Print ""
        WaitKey
    Next r
    
    Write LSet(Row(10), rlen + 1)       //Kaksi paria
    For i1 = 1 To 5
        For i2 = i1 + 1 To 6
            Goal$ = Str(i1) + i1 + i2 + i2 + "X"
            Chance# = CalcProb2(Curr, Goal)
            Gain = (i1 + i2) * 2
            Total = 22
            ExLoss# = Total - (Chance * Gain)
            Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
            If ExLoss < MinLoss Then
                MinLoss = ExLoss
                Winner = 10
            EndIf
            Write LSet("", rlen + 1)
        Next i2
    Next i1
    Print ""
    WaitKey
    
    Write LSet(Row(11), rlen + 1)       //Täyskäsi
    For i1 = 1 To 5
        For i2 = i1 + 1 To 6
            For i = 0 To 1
                Goal$ = String(Str(i1), 3 - i) + String(Str(i2), 2 + i)
                Chance# = CalcProb2(Curr, Goal)
                Gain = i1 * (3 - i) + i2 * (2 + i)
                Total = 28
                ExLoss# = Total - (Chance * Gain)
                Print Goal + "    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
                If ExLoss < MinLoss Then
                    MinLoss = ExLoss
                    Winner = 11
                EndIf
                Write LSet("", rlen + 1)
            Next i
        Next i2
    Next i1
    Print ""
    WaitKey
    
    Write LSet(Row(12), rlen + 1)       //Pieni suora
    Chance# = CalcProb2(Curr, "12345")
    Gain = 15
    Total = 15
    ExLoss# = Total - (Chance * Gain)
    Print "12345    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
    If ExLoss < MinLoss Then
        MinLoss = ExLoss
        Winner = 12
    EndIf
    Print ""
    WaitKey
    
    Write LSet(Row(13), rlen + 1)       //Iso suora
    Chance# = CalcProb2(Curr, "23456")
    Gain = 20
    Total = 20
    ExLoss# = Total - (Chance * Gain)
    Print "23456    " + LSet(Str(Chance * 100), 5) + "%    " + RSet(Str(Gain), 2) + "/" + LSet(Str(Total), 2) + "    (" + (ExLoss) + ")"
    If ExLoss < MinLoss Then
        MinLoss = ExLoss
        Winner = 13
    EndIf
    Print ""
    Print "Suosittelen: " + Row(Winner) + " (odottettu häviö: " + MinLoss + ")"
    WaitKey
    
End Function

Function CalcProb2(Curr$, Goal$)                        //Tämä funktio kertoo, kuinka todennäköistä on saada yhdestä yhdistelmästä toinen heittämällä osa nopista uudelleen
    Dices = Len(Curr)
    Goal = Replace(Goal, "X", "")
    For i = 1 To Len(Curr)                              //Säästetään nopat, jotka auttavat eteenpäin
        f = InStr(Goal, Mid(Curr, i, 1))
        If f > 0 Then
            If Len(Goal) = 1 Then Return 1.0            //Jos yhdistelmä on jo saatu, se on varma tapaus
            Goal = StrRemove(Goal, f, 1)
            Dices = Dices - 1
        End If
    Next i
    Return Float(CalcSuc(Goal, Dices))/(6^Dices)        //Todennäköisyys = Suotuisat tapaukset / Kaikki tapaukset
End Function

Function CalcProb(Goal$, Dices = 0)                     //Tämä funktio kertoo, kuinka todennäköistä on saada tietty yhdistelmä
    If Dices = 0 Then Dices = Len(Goal)                     //Jos noppien määrä jätetään kertomatta, saadaan se selville ehdon pituudesta (X-termit ovat pakollisia tällöin)
    Goal = Replace(Goal, "X", "")                           //X-termit ovat varmasti oikein, voidaan poistaa jo tässä vaiheessa algoritmin nopeuttamiseksi
    Return Float(CalcSuc(Goal, Dices))/(6^Dices)            //Todennäköisyys = Suotuisat tapaukset / Kaikki tapaukset
End Function

Function CalcSuc(Goal$, Dices)                          //Tämä funktio kertoo, kuinka moni yhdistelmä on suotuisa annetulle ehdolle
    Dices = Dices - 1
    For i = 1 To 6                                          //Käydään jokainen noppa kerrallaan
        f = InStr(Goal, Str(i))                                 //Tutkitaan löytyykö kyseistä noppaa
        If f > 0 Then                                           //Jos löytyi...
            If Dices = 0 Then Return 1                              //Jos on viimeinen noppa ja se on oikein, muita vaihtoehtoja ei ole (eli lisätään yksi oikein)
            
            If Len(Goal) = 1 Then
                Suc = Suc + 6^(Dices)                               //Jos on jo saatu kaikki oikein, jäljellä olevat yhdistelmät ovat kaikki suotuisia
            Else
                Suc = Suc + CalcSuc(StrRemove(Goal, f, 1), Dices)   //Muussa tapauksessa tutkitaan jäljellä olevat yhdistelmät
            EndIf
        Else                                                    //Huti...
            If Dices >= Len(Goal) Then Suc = Suc + CalcSuc(Goal, Dices) //Tutkitaan jäljellä olevat yhdistelmät, jos niitä voi olla (eli noppia on tarpeeksi)
        EndIf
    Next i
    Return Suc                                              //Palautetaan löytyneiden yhdistelmien määrä
End Function
Jotkut saattavat haluta tutkia koodin lopussa olevia funktioita, jotka ovat ohjelman sydän. Ne on hyvin kommentoitu ja suht. helposti muotoiltavissa esim. korttipeliongelmiin. Tuohon Yatzy-avustajaan ei kannate tutustua, se on purkalla koossa ja oikeastaan se ei osaa ottaa huomioon, jos tiettyjä noppia heittämällä voi yrittää useampaa yhdistelmää (kuten jo sanoin, minulla on jo idea tätä varten).
Jos tämä viesti on kirjoitettu alle 5 min. sitten, päivitä sivu. Se on saattanut jo muuttua :roll:
Image
Latexi95
Guru
Posts: 1166
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Pikku pelit

Post by Latexi95 »

Kun tässä viime aikoina on ollut paljon lentokonepelejä tekeillä, niin päätin kaivaa kovalevyn pohjilta lentokoneen fysiikat, jotka aikasemmin olivat jäänneet kesken taidon puutteesta. Nyt onnistuin tekemään ne valmiiksi ja olen varsin tyytyväinen loppu tulokseen. Lentokoneen fysiikat olen laittanut vastaamaan mahdollisimman paljon BAe Hawkin tietoja ja piirsin Hawkin kuvankin lentokoneeksi. :D
Paketissa on mukana lähdekoodi ja lentokoneen kuva sekä valkoinen ruudukko joka löytyy CB:n median kansiosta.
EDIT:

Ja lähdekoodia saa hyödyntää mielinmäärin samoin kuin lentokoneen kuvaakin.

Attachments
Airplane physics.rar
(8.68 KiB) Downloaded 547 times
tuhoojabotti
Advanced Member
Posts: 485
Joined: Tue Aug 28, 2007 3:53 pm
Location: Suomi, Finland
Contact:

Re: Pikku pelit

Post by tuhoojabotti »

Hieno esimerkki! Itse olisin laittanut dedikoituun ketjuun Esimerkit & tutoriaalit -alueelle. Tulen luultavasti hyödyntämään esimerkkiä pelissäni. (btw. Ainakin minusta f(x)=-0.006*(x+5)*(x-29) tuntui riittävän nousukertoimeksi, vaikka voihan esialustettu taulukko olla nopeampi laskennalliselta kannalta. :P)
Imagedev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”
Latexi95
Guru
Posts: 1166
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Pikku pelit

Post by Latexi95 »

tuhoojabotti wrote:Hieno esimerkki! Itse olisin laittanut dedikoituun ketjuun Esimerkit & tutoriaalit -alueelle. Tulen luultavasti hyödyntämään esimerkkiä pelissäni. (btw. Ainakin minusta f(x)=-0.006*(x+5)*(x-29) tuntui riittävän nousukertoimeksi, vaikka voihan esialustettu taulukko olla nopeampi laskennalliselta kannalta. :P)
Mikähän kaava tuo mahtaa olla? Taulukko vastaa siiven nosteen kerroin erilaisilla siiven ja ilmavirran välisillä kulmilla (Angle of Attack). Yleensä siis arvot ovat jotain taulukko on tällä hetkellä 73 arvon kokoinen, kun en enempää jaksanut tehdä. Käytännössä arvot ovat useimmiten väliltä -1 - 1 astetta, ellei lentokonetta käännetä erittäin nopeasti ja lähde jotenkin pyörimään. Siitä syystä en ole edes laittanut taulukon keskiosan arvoja, kun niillä ei ole käytänössä merkitystä. Korkeusperäsimen "nosteen" taulukkoon ihan generoin, koska se ei vaatinut niin oikeata(?) vastaavia arvoja. Korkeusperäsin ei aiheuta tässä esimerkissä lainkaan nostetta, ellei se ole kulmassa ilman virtaukseen nähden. Siivet taas ovat lentokoneen painopisteen kohdalla.

Voisihan tämän tietysti laittaa Esimerkit ja tutoriaalit -alueellekkin, niin tämä ei unohtuisi tämän ketjun pohjille. Luon iltapäivällä oman ketjun tälle esimerkille.
tuhoojabotti
Advanced Member
Posts: 485
Joined: Tue Aug 28, 2007 3:53 pm
Location: Suomi, Finland
Contact:

Re: Pikku pelit

Post by tuhoojabotti »

Tuo on vain paraabeli, jonka nollakohdat ja maksimi vastaa sitä Wikipedian kuvaa. :D
Imagedev.tuhoojabotti.com — “Programmer (noun): An organism that turns caffeine into code.”
Latexi95
Guru
Posts: 1166
Joined: Sat Sep 20, 2008 5:10 pm
Location: Lempäälä

Re: Pikku pelit

Post by Latexi95 »

tuhoojabotti wrote:Tuo on vain paraabeli, jonka nollakohdat ja maksimi vastaa sitä Wikipedian kuvaa. :D
:D
Muuten kyllä varmaan toimisi, mutta jos lentokone menee jotenkin päätyy tilaan, jossa nokka osoittaa vastakkaiseen suuntaan kuin lentokone liikkuu, niin voi olla että tuloksena on katastrofi (lentokone kimpoa holtittomasti jonnekkin helvettiin). Noilla säädöillä ilman ulkoisia voimia sellainen tilanne tuskin on mahdollinen, mutta fysiikkamoottorin liittäminen ja vastustaja lentokoneelle räjähtävien ohjusten antaminen saattaisi aiheuttaa sen. Tuossa käytössä X voi olla väliltä -180 - +180 eli pahimmassa tapauksessa kertoimeksi saattaisi siis tulla yli 150:ntä.
Untitled.bmp
Member
Posts: 52
Joined: Sat May 12, 2012 7:11 pm
Location: C:/WINDOWS/system32

Re: Pikku pelit

Post by Untitled.bmp »

Tein tälläisen yksinkertaisen pelin, joka testaa nopeutesi. Pelissä sinä ensiksi klikkailet hiiren nappuloita niin nopeasti kuin mahdollista minuutin ajan, sen jälkeen saat selville, kuinka monta kertaa ehdit painaa hiiren nappuloita. Sitten sama toistuu näppäimistössä. Oma ennätykseni:
Clickit: 646 Logitechin laserhiirellä, vasteajasta ei hajua.
Napsit: 1300 Logitechin jollain näppäimistöllä.

Code: Select all

SCREEN 800,800
AddText "Tehtäväsi on klikkailla hiirtä mahdollisimman monta kertaa minuutissa! Onnea yritykseen(Tarvitset sitä.)"
AddText "Voit käyttää kaikkia hiiren näppäimiä"
AddText "Aloita painamalla mitä tahansa nappia."
DrawScreen 
WaitKey
ClearText
hetki=Timer()
Repeat
If MouseHit(1) Or MouseHit(2) Or MouseHit(3) Then click=click+1
Text 0,0,"Clickit: "+click
DrawScreen
Until Timer()>hetki+60000
Cls
Text 0,0,"Onnittelut! Sait "+click+" clickiä minuutissa!"
DrawScreen
WaitKey 
Cls
hetki=Timer()
AddText "Nyt testaamme naputtelunopeutesi! Paina mitä tahansa näppäimiä(paitsi esciä) kokoajan!"
DrawScreen
WaitKey
ClearText
Repeat
i=GetKey()
If i Then naps=naps+1
Text 0,0,"Napsit: "+naps
DrawScreen
Until Timer()>hetki+60000
Cls
Text 0,0,"Onnittelut! Sait "+naps+" napsia minuutissa!"
DrawScreen
waitmouse

 

System Requirements:

OS: Windows 98 to Windows 7
processor: vähintään 2ghz
näytönohjain: Mikä tahansa, kunhan tukee väh. kahta väriä.
hiiri: Mikä tahansa hiiri, suositeltavaa on hankkia hiiri, jossa on mahdollisimman lyhyt vasteaika ja mahdollisimman monta ohjelmoitavaa näppäintä.
näppäimistö: Lähes sama kuin hiiressä.
Intel core i7 3960X 3,9ghz 15mb
Sapphire Radeon HD7970
160gb ssd
2tb hdd
8gb Ram
Windows 7 Ultimate 64-bit & Linux Ubuntu 12.04LTS
Jammu
Newcomer
Posts: 1
Joined: Thu Dec 13, 2012 6:50 pm

Re: Pikku pelit

Post by Jammu »

Heippa!

Sain ensimmäisen Coolbasic pelini valmiiksi. Peli on todella yksinkertainen, tapetaan zombeja, kunnes kuollaan.

Huom. alussa pitää painaa "Start" tekstistä.

Pelin voi ladata tuolta: http://www.mediafire.com/?my0ivjb30q12zg8
skorpioni-cb
Advanced Member
Posts: 364
Joined: Wed Dec 03, 2008 3:48 pm
Location: Turku

Re: Pikku pelit

Post by skorpioni-cb »

Jammu wrote:Heippa!

Sain ensimmäisen Coolbasic pelini valmiiksi. Peli on todella yksinkertainen, tapetaan zombeja, kunnes kuollaan.

Huom. alussa pitää painaa "Start" tekstistä.

Pelin voi ladata tuolta: http://www.mediafire.com/?my0ivjb30q12zg8
Voi ei, miksi AINA näissä peleissä on Zombeja, on niitä muitakin juttui tommosiin peleihin kuin zombit tai alienit
En tiedä, mitä tiedän, mutta tiedän ettei se ole mitään kaunista.

I know not what I know, but I do know that it's not beautiful.
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Pikku pelit

Post by esa94 »

skorpioni-cb wrote:Voi ei, miksi AINA näissä peleissä on Zombeja, on niitä muitakin juttui tommosiin peleihin kuin zombit tai alienit
Kuten?
User avatar
Frozen
Advanced Member
Posts: 282
Joined: Fri Jan 01, 2010 4:46 pm
Location: Suomi

Re: Pikku pelit

Post by Frozen »

esa94 wrote:
skorpioni-cb wrote:Voi ei, miksi AINA näissä peleissä on Zombeja, on niitä muitakin juttui tommosiin peleihin kuin zombit tai alienit
Kuten?
Hullut lehmät? Mielenosoittajat? Paparazzit? Kyllä vaihtoehtoja aina löytyy,
Image
Työn alla:
Jotakin epäjulkaistua
Awaclus
Forum Veteran
Posts: 2939
Joined: Tue Aug 28, 2007 2:50 pm

Re: Pikku pelit

Post by Awaclus »

Ei zombeja (tai muutakaan) pidä välttää vain sen takia, että ne ovat suosittuja. Jos zombit sopivat peliin paremmin kuin mikään muu vaihtoehto, tulee silloin käyttää zombeja.
User avatar
esa94
Guru
Posts: 1855
Joined: Tue Sep 04, 2007 5:35 pm

Re: Pikku pelit

Post by esa94 »

Awaclus wrote:Ei zombeja (tai muutakaan) pidä välttää vain sen takia, että ne ovat suosittuja. Jos zombit sopivat peliin paremmin kuin mikään muu vaihtoehto, tulee silloin käyttää zombeja.
Niin. Siksihän tuolla ylhäällä on tuo oma zombopelinikin, joskaan se ei ole niinkään peli kuin metafora tiettyjen asioiden välttämättömyydelle.
MrMonday
Advanced Member
Posts: 378
Joined: Fri Oct 10, 2008 2:35 pm

Re: Pikku pelit

Post by MrMonday »

Jonkin mittaisen tauon jälkeen ajattelin aikani kuluksi kokeilla, että vieläkö sitä jotain muistaisi/osaisi. No, siitä syntyi sitten hyvin simppeli matopeli.

VAROITUS! Koodin tutkiminen saattaa aiheuttaa aivovaurion, joten sitä ei missään nimessä suositella. Koodin laitoin siksi, ettei näin pienen pelin lataamien olisi mielekästä. Toteutettu sillä periaatteella, että mikäli se toimii, niin se kelpaa, ihan sama miksi tai miten se toimii, joten seassa voi olla paljon turhaa, sekä optimointivaraa ja paranneltavaa muutenkin löytyisi todella paljon. Koodi on sanalla sanoen purkkaa. VAROITUS!

Itse pelistä: tavallinen matopeli, vain yksi tiedetty bugi, mistä ei kuitenkaan ole suurta haittaa.

Ohjaus: nuolinäppäimet, välilyönnistä kulkee hitusen nopeampaa..
EDIT:

ps. oma ennätys 76 pistettä

Code: Select all

nopeus = 20

SCREEN 200,200

Type MATO
    Field ID
    Field X
    Field Y
    Field R
    Field G
    Field B
EndType

Type RUOKA
    Field X
    Field Y
EndType

    muren.RUOKA = New(RUOKA)
    muren\X = Rand(0,19)*10 
    muren\Y = Rand(0,19)*10

    osa.MATO = New(MATO)
    osa\ID = 1
    osa\X = 10
    osa\Y = 10
    osa\R = 255
    osa\G = 0
    osa\B = 0
    
    osa.MATO = New(MATO)
    osa\ID = 1
    osa\X = 10
    osa\Y = 10
    osa\R = 255
    osa\G = 0
    osa\B = 0
    
    osa.MATO = New(MATO)
    osa\ID = 1
    osa\X = 10
    osa\Y = 10
    osa\R = 0
    osa\G = 100
    osa\B = 0

suunta = 4

Repeat

    For tausta_y = 0 To 19
    
        If väri = 200
            väri = 190
        Else
            väri = 200
        EndIf
        
        Color väri,väri,50
        Box 0,tausta_y*10,200,10
        
    Next tausta_y

    osa = First(MATO)

        If KeyHit(200) And suunta <> 2
            suunta = 1
        ElseIf KeyHit(208) And suunta <> 1
            suunta = 2
        ElseIf KeyHit(203) And suunta <> 4
            suunta = 3
        ElseIf KeyHit(205) And suunta <> 3
            suunta = 4
        EndIf
        
        If suunta = 1 Then osa\Y = osa\Y - 1
        If suunta = 2 Then osa\Y = osa\Y + 1
        If suunta = 3 Then osa\X = osa\X - 1
        If suunta = 4 Then osa\X = osa\X + 1 
    
        pääx = osa\X
        pääy = osa\Y
        
        Gosub ruokaa

    While After(osa) <> NULL
    
        If osa\ID <> 1 And osa\X = pääx And osa\Y = pääy Then Goto loppu

        If osa\X < 0 Then osa\X = 19
        If osa\X > 19 Then osa\X = 0
            
        If osa\Y < 0 Then osa\Y = 19
        If osa\Y > 19 Then osa\Y = 0   
    
        osa = After(osa)
    
    Wend
    
        If osa\X < 0 Then osa\X = 19
        If osa\X > 19 Then osa\X = 0
            
        If osa\Y < 0 Then osa\Y = 19
        If osa\Y > 19 Then osa\Y = 0          
        
        Color osa\R,osa\G,osa\B
        Circle osa\X*10,osa\Y*10,10 
    
    osa = Last(MATO)

    Gosub päivitä_mato

        nopeus = 20
        If KeyDown(57) Then nopeus = 10
        
    DrawScreen

        Wait nopeus*10

Until KeyHit(1)

ruokaa:

    If muren\X = pääx*10 And muren\Y = pääy*10
        pisteet = pisteet + 1
        
        uudelleenarvonta:
        
        muren\X = Rand(0,19)*10 
        muren\Y = Rand(0,19)*10

    osa = First(MATO)

    While After(osa) <> NULL
        If muren\X = osa\X*10 And muren\Y = osa\Y*10 Then Goto uudelleenarvonta
        osa = After(osa)
    Wend
       
    osa = First(MATO)
    
        Gosub uusi_osa
    
    EndIf

    Color 100,50,100
    Circle muren\X,muren\Y,10

Return
        
uusi_osa:

    i = i + 1

    osa.MATO = New(MATO)
    osa\ID = i+1
    osa\X = 10+i
    osa\Y = 10
    osa\R = 0
    osa\G = 100
    osa\B = 0
    
    Gosub päivitä_mato
    
Return

päivitä_mato:

    While Before(osa) <> NULL
        
        osa = Before(osa)
            x = osa\X
            y = osa\Y
            Color osa\R,osa\G,osa\B
            Circle osa\X*10,osa\Y*10,10
        osa = After(osa)
            osa\X = x
            osa\Y = y
            Color osa\R,osa\G,osa\B
            Circle osa\X*10,osa\Y*10,10 
        osa = Before(osa)
        
    Wend
    
Return

loppu:

    ClsColor 0,50,0
    Cls
    Color 255,255,255
    Text ScreenWidth()/2-TextWidth("Pisteet: "+pisteet)/2,ScreenHeight()/2-TextHeight("Pisteet: "+pisteet)/2-6,"Pisteet: "+pisteet
    Gosub taitotaso
    DrawScreen
    Wait 500
    WaitKey
    
End

taitotaso:

If pisteet < 5
     Text ScreenWidth()/2-TextWidth("Taso: Puuttuva rengas")/2,ScreenHeight()/2-TextHeight("Taso: Puuttuva rengas")/2+6,"Taso: Puuttuva rengas"
ElseIf pisteet < 10
     Text ScreenWidth()/2-TextWidth("Taso: Yritä edes...")/2,ScreenHeight()/2-TextHeight("Taso: Yritä edes...")/2+6,"Taso: Yritä edes..."
ElseIf pisteet < 20
     Text ScreenWidth()/2-TextWidth("Taso: Heikohkoa")/2,ScreenHeight()/2-TextHeight("Taso: Heikohkoa")/2+6,"Taso: Heikohkoa"
ElseIf pisteet < 50
     Text ScreenWidth()/2-TextWidth("Taso: Menettelee...")/2,ScreenHeight()/2-TextHeight("Taso: Menettelee...")/2+6,"Taso: Menettelee..."
ElseIf pisteet < 100
     Text ScreenWidth()/2-TextWidth("Taso: Ei huono")/2,ScreenHeight()/2-TextHeight("Taso: Ei huono")/2+6,"Taso: Ei huono"
ElseIf pisteet < 150
     Text ScreenWidth()/2-TextWidth("Taso: Hyvä")/2,ScreenHeight()/2-TextHeight("Taso: Hyvä")/2+6,"Taso: Hyvä"
ElseIf pisteet < 200
     Text ScreenWidth()/2-TextWidth("Taso: Kunnioitettavaa")/2,ScreenHeight()/2-TextHeight("Taso: Kunnioitettavaa")/2+6,"Taso: Kunnioitettavaa"
ElseIf pisteet < 300 
     Text ScreenWidth()/2-TextWidth("Taso: Loistavaa!")/2,ScreenHeight()/2-TextHeight("Taso: Loistavaa!")/2+6,"Taso: Loistavaa!"
ElseIf pisteet > 299
     Text ScreenWidth()/2-TextWidth("Taso: -=MESTARI=-")/2,ScreenHeight()/2-TextHeight("Taso: -=MESTARI=-")/2+6,"Taso: -=MESTARI=-"
EndIf

Return
User avatar
valscion
Moderator
Moderator
Posts: 1599
Joined: Thu Dec 06, 2007 7:46 pm
Location: Espoo
Contact:

Re: Pikku pelit

Post by valscion »

MrMonday wrote:Jonkin mittaisen tauon jälkeen ajattelin aikani kuluksi kokeilla, että vieläkö sitä jotain muistaisi/osaisi. No, siitä syntyi sitten hyvin simppeli matopeli.
Varsin mukava pieni matopeli :) pidin taustan kevyestä kellertävän sävyisestä värityksestä. Matopeli on aina hyvä tapa opetella tietorakenteiden käyttöä
cbEnchanted, uudelleenkirjoitettu runtime. Uusin versio: 0.4.1 — Nyt myös sorsat GitHubissa!
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com
Post Reply