Page 22 of 22

Re: Pikku pelit

Posted: Sun May 22, 2011 12:59 pm
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

Re: Pikku pelit

Posted: Sun May 22, 2011 4:49 pm
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

Re: Pikku pelit

Posted: Sun May 22, 2011 4:57 pm
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


Re: Pikku pelit

Posted: Tue Nov 01, 2011 9:33 am
by saffan
tässä olisi tämmöinen hauska peli jossa on kolme riviä koodia :D

Re: Pikku pelit

Posted: Tue Nov 01, 2011 1:33 pm
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?

Re: Pikku pelit

Posted: Thu Jan 05, 2012 11:33 am
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).

Re: Pikku pelit

Posted: Sat Jan 07, 2012 1:35 pm
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.


Re: Pikku pelit

Posted: Mon Jan 09, 2012 8:54 am
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)

Re: Pikku pelit

Posted: Mon Jan 09, 2012 9:16 am
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.

Re: Pikku pelit

Posted: Wed Jan 11, 2012 5:46 pm
by tuhoojabotti
Tuo on vain paraabeli, jonka nollakohdat ja maksimi vastaa sitä Wikipedian kuvaa. :D

Re: Pikku pelit

Posted: Wed Jan 11, 2012 6:18 pm
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ä.

Re: Pikku pelit

Posted: Wed May 23, 2012 7:56 pm
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ä.

Re: Pikku pelit

Posted: Thu Dec 13, 2012 7:11 pm
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

Re: Pikku pelit

Posted: Wed Dec 19, 2012 4:58 pm
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

Re: Pikku pelit

Posted: Wed Dec 19, 2012 5:00 pm
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?

Re: Pikku pelit

Posted: Wed Dec 19, 2012 5:27 pm
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,

Re: Pikku pelit

Posted: Wed Dec 19, 2012 6:00 pm
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.

Re: Pikku pelit

Posted: Wed Dec 19, 2012 6:24 pm
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.

Re: Pikku pelit

Posted: Wed Aug 07, 2013 2:12 am
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

Re: Pikku pelit

Posted: Sun Aug 18, 2013 9:03 pm
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öä