Pikku pelit
Re: Pikku pelit
Aika hieno peli, tosiaan. Itse sain parin yrittämän jälkeen 130 000, mutta koneeni sai jo negatiivisen luvun. Tietenkään se ei ole täysin puhdas, koska palikoiden päivittämiseen 15*20 per frame olisi liian raskasta. Kun kaikki framen poistettavat palikat
iskeytyvä samalla kerralla combomittariin, tulee aika suuret määrät pisteitä. :F
iskeytyvä samalla kerralla combomittariin, tulee aika suuret määrät pisteitä. :F
Re: Pikku pelit
Tässä pikku spämmi peli, tylsä sellainen.
Code: Select all
SCREEN 500,700
SAFEEXIT ON
AddText "Kirjota mitä ikinä haluat kirjoittaa. Esc näppäimellä poistut."
// Tämä alkuun
Global __InputActive
// Luodaan kaksi inputtia
laatikko = NewInput()
laatikko2= NewInput()
// Asetetaan ensiksi luotu inputti aktiiviseksi
ActiveInput(laatikko)
AddText "Enter = vaihda riviä."
Repeat
// Piirretään inputit
teksti$ = Input2(laatikko, teksti$, 5,25)
teksti2$= Input2(laatikko2,teksti2$,5,55)
If KeyHit(cbkeyreturn) Then
If ActiveInput()=laatikko Then ActiveInput(laatikko2) Else ActiveInput(laatikko)
EndIf
DrawScreen
Forever
//------ Funktiot ------//
Function ActiveInput(mem=0)
If mem=0 Then
Return __InputActive
Else
__InputActive = mem
EndIf
End Function
Function NewInput()
tmpmem = MakeMEMBlock(27)
__InputActive=tmpmem
PokeInt tmpmem,23,TextHeight("I")
Return tmpmem
End Function
Function Input2(datmem,txt$,x,y)
aika=Timer()
active=(datmem=__InputActive)
h=PeekInt(datmem,23)
mx=MouseX():my=MouseY()
blink = PeekInt(datmem,0)
curpos = Max(PeekInt(datmem,4),0)
exs = PeekInt(datmem,9)
exc = PeekByte(datmem,13)
delay = PeekInt(datmem,14)
del = PeekByte(datmem,18)
blinkkaa=Not PeekByte(datmem,8)
mleft=4
mtop=2
riviväli=15
If active Then
For i=0 To 220
tmp=tmp+(i^2)*KeyDown(i)
Next i
If tmp<>exs Then exc=0:delay=0:del=0
k = GetKey()
If KeyHit(181) Then k=47
numpad=0
For i=71 To 83
If i=78 Or i=74 Then i+1
If KeyHit(i) Then numpad=i Then Exit
Next i
If numpad Then
Select numpad
Case 83:k=44
Case 82:k=48
Case 79:k=49
Case 80:k=50
Case 81:k=51
Case 75:k=52
Case 76:k=53
Case 77:k=54
Case 71:k=55
Case 72:k=56
Case 73:k=57
End Select
EndIf
If k Then
exc=k:delay=0:del=0:blink=aika+500:blinkkaa=False:PokeInt datmem,0,blink:PokeByte datmem,8,blinkkaa
EndIf
txtlen=Len(txt)
If (exc>31 And (exc<127 Or exc>159) And ((((tmp=exs) And tmp<>0) And aika>delay) Or k)) And (exc<>45 Or KeyDown(181)=0) Then
If del=0 Then delay=aika+400:del=1 Else delay=aika+20
txt=StrInsert(txt,curpos,Chr(exc))
curpos=curpos+1
blinkkaa=True
ElseIf (exc=8 Or exc=127) And curpos>0 And (aika>delay Or k) Then
If del=0 Then delay=aika+400:del=1 Else delay=aika+20
If exc=127 Then
ttt=curpos
For i=curpos To 1 Step -1
a=Asc(Mid(txt,i,1))
If ((a<48 Or (a>57 And a<65) Or (a>90 And a<97) Or (a>122 And a<192)) And a<>39) Then
If i=ttt Then txt=StrRemove(txt,i,1):curpos-1
Exit
EndIf
txt=StrRemove(txt,i,1)
curpos-1
Next i
Else
txt=StrRemove(txt,curpos,1)
curpos-1
EndIf
blinkkaa=True
ElseIf exc=4 And (aika>delay Or k) Then
If del=0 Then delay=aika+400:del=1 Else delay=aika+20
If curpos<txtlen Then txt=StrRemove(txt,curpos+1,1)
blinkkaa=True
ElseIf k=2 Then
curpos=txtlen
ElseIf k=1 Then
curpos=0
ElseIf (exc=30 Or exc=31) And (aika>delay Or k) Then
If del=0 Then delay=aika+400:del=1 Else delay=aika+20
blinkkaa=True
curpos=Min(Max(curpos+(exc=30)-(exc=31),0),txtlen)
EndIf
EndIf
If aika>blink Then
PokeInt datmem,0,aika+500
PokeByte datmem,8,blinkkaa
EndIf
txtlen=Len(txt)
exs=tmp
offset=1
i=0
Text x+mleft,y+mtop+i*riviväli,txt
If blinkkaa And active Then
ww=TextWidth(Mid(txt,offset,(curpos-offset)+1))
Text x+mleft+ww,y+mtop+i*riviväli,"_"
EndIf
PokeInt datmem,4,curpos
PokeInt datmem,9,exs
PokeByte datmem,13,exc
PokeInt datmem,14,delay
PokeByte datmem,18,del
Return txt
End Function
DRAWSCREEN PIIRTÄÄ NÄYTÖN. TÄRKEIN KOMENTO!
Re: Pikku pelit
Eiku aivan mahtava, oikein jännitti kun pelasinBabCoder wrote:Tässä pikku spämmi peli, tylsä sellainen.
Black city peleistä parhain
Re: Pikku pelit
Ai. Kiitti. Olisi muuten pitänyt heti ruveta noitten omien fuctioijen kanssa koodailemaan. Vaikka otinkin ton itse Koodikirjastossa. Yritän tehä paremman.11v wrote:Eiku aivan mahtava, oikein jännitti kun pelasinBabCoder wrote:Tässä pikku spämmi peli, tylsä sellainen.
DRAWSCREEN PIIRTÄÄ NÄYTÖN. TÄRKEIN KOMENTO!
Re: Pikku pelit
Tässäpä hetken mielijohteesta, tunnissa koodattu peli: ChainBoom. ChainBoomissa tarkoitus on räjäyttää kaikki pallot mahdollisimman vähillä klikkauksilla. Pallo räjähtää, kun se osuu jo räjähtäneeseen palloon, yritä saada mahdollisimman suuria komboja
Klikkaamalla luodaan räjähdys.
Oma ennätykseni: 23 klikkausta
Klikkaamalla luodaan räjähdys.
Code: Select all
FrameLimit 50
SCREEN 505, 505
SCREEN 500, 500, 0, 2
Type Ball
Field Size#
Field X#
Field Y#
Field VelX#
Field VelY#
Field ColR
Field ColG
Field ColB
End Type
Const DefSize = 7
Const MaxSize = 110
FontBig = LoadFont("Impact", 40)
FontSmall = LoadFont("Impact", 18)
Game:
Level + 1
For i = 1 To level * 15
nBall.Ball = New(Ball)
nBall\Size = DefSize
nBall\X = Rand(500)
nBall\Y = Rand(500)
A = Rand(259) : P# = Rnd(.5, 3)
nBall\VelX = Cos(A)*P#
nBall\VelY = Sin(A)*P#
nBall\ColR = Rand(50, 255) : nBall\ColG = Rand(50, 255) : nBall\ColB = Rand(50, 255)
Next i
SetWindow "ChainBoom - level "+Level
t = Timer()+1000
ClsGamma = 255
Repeat
BallCount = 0
For iBall.Ball = Each Ball
If Not (iBall\ColR = 200 And iBall\ColG = 200 And iBall\ColB = 200) Then BallCount + 1
iBall\X = iBall\X + iBall\VelX
iBall\Y = iBall\Y + iBall\VelY
If iBall\X>500 Or iBall\X<0 Then iBall\VelX = -iBall\VelX
If iBall\Y>500 Or iBall\Y<0 Then iBall\VelY = -iBall\VelY
Color iBall\ColR, iBall\ColG, iBall\ColB
If iBall\Size => DefSize Then
Circle iBall\X - iBall\Size/2, iBall\Y - iBall\Size/2, iBall\Size
Else
Circle iBall\X - (MaxSize + iBall\Size)/2, iBall\Y - (MaxSize + iBall\Size)/2, (MaxSize + iBall\Size)
EndIf
If iBall\Size > DefSize Then
If iBall\Size < MaxSize Then iBall\Size = CurveValue(MaxSize, iBall\Size, 10)
ElseIf iBall\Size = DefSize Then
For aBall.Ball = Each Ball
If aBall <> iBall And aBall\Size <> DefSize Then
Size = (iBall\Size + aBall\Size)/2
If aBall\Size =< 0 Then Size = (iBall\Size + (MaxSize + aBall\Size))/2
If Distance(iBall\X, iBall\Y, aBall\X, aBall\Y) < Size Then
iBall\Size = DefSize + 1
iBall\VelX = 0
iBall\VelY = 0
ClsGamma = Min(ClsGamma + 15, 255)
Exit
EndIf
EndIf
Next aBall
EndIf
If Int(iBall\Size) => MaxSize Then
iBall\Size = 0
ElseIf iBall\Size =< 0 Then
iBall\Size - 1
EndIf
If iBall\Size =<-MaxSize
Delete iBall
EndIf
Next iBall
If MouseHit(1) Then
nBall.Ball = New(Ball)
nBall\Size = DefSize+1
nBall\X = MouseX()
nBall\Y = MouseY()
nBall\ColR = 200 : nBall\ColG = 200 : nBall\ColB = 200
Clicks + 1
End If
SetFont FontSmall
Color 255,255,255
Text 1, 1, "Balls left: "+BallCount
Text 1, 15, "Clicks: "+Clicks
If t > Timer() Then
SetFont FontBig
Gamma = 255 - (Abs(500 - (t - Timer()))*0.5)
Color Gamma, Gamma, Gamma
CenterText 250, 250, "Level " + Level, 2
EndIf
If BallCount > 1 Then ClsGamma = CurveValue(0, ClsGamma, 20) Else ClsGamma = CurveValue(255, ClsGamma, 20)
ClsColor ClsGamma, ClsGamma, ClsGamma
DrawScreen
Until BallCount = 0
If level < 5 Then Goto Game
ClsColor 0,0,0
Cls
Color 255,255,255
SetFont FontBig
CenterText 250, 200, "You won!"
CenterText 250, 300, "Clicks: " + Clicks
SetFont FontSmall
CenterText 250, 470, "Press any key to quit"
DrawScreen
WaitKey
Re: Pikku pelit
Axu: Chain Rxn? ; )
Paranneltu versio laatikkojen poksauttelusta:
Paranneltu versio laatikkojen poksauttelusta:
Code: Select all
FrameLimit 50
Global gPoints, gComboMeter, gBlockWidth, gBlockID, gMouseX, gMouseY, gUpdateScreen As integer
gBlockWidth = 20
Dim BLOCKS(ScreenWidth()/gBlockWidth - 1,ScreenHeight()/gBlockWidth - 1,1) As integer
Dim Colors(5,2) As Byte
Colors(1,0) = 255
Colors(2,0) = 255
Colors(3,0) = 255
Colors(4,0) = 0
Colors(5,0) = 168
Colors(1,1) = 0
Colors(2,1) = 172
Colors(3,1) = 255
Colors(4,1) = 164
Colors(5,1) = 16
Colors(1,2) = 0
Colors(2,2) = 0
Colors(3,2) = 0
Colors(4,2) = 255
Colors(5,2) = 224
Type TEXTS
Field x#
Field y#
Field Value
Field cTimer
EndType
Type PAR
Field X#
Field Y#
Field r
Field g
Field b
Field Angle
Field Speed#
Field Gravity#
Field CurGravity#
Field Ver#
EndType
GenerateBlocks()
cTimer = Timer()
Repeat
SetWindow "Points: "+gPoints+" - Time left: "+Max(0,(15 - (Timer() - cTimer)/1000))
If Timer() - cTimer < 15000 Then
If MouseHit(1) Then
gMouseX = MouseX()
gMouseY = MouseY()
CheckBlocks(MouseX() / gBlockwidth,MouseY() / gBlockWidth,1)
ClearSelectedBlocks()
EndIf
UpdateBlockPosition()
DrawBlocks()
UpdateParticles()
UpdateTexts()
Else
Color cbwhite
Text (ScreenWidth() - TextWidth("You scored "+gPoints+" points!")) / 2, (ScreenHeight() - TextHeight("You scored "+gPoints+" points!")) / 2, "You scored "+gPoints+" points!"
Text 2,2,"Press R for a new game"
Text 2,18,"Press Q or ESC to quit"
EndIf
If KeyHit(cbKeyR) Then
For uusi.PAR = Each PAR
Delete uusi
Next uusi
GenerateBlocks()
gPoints = 0
gComboMeter = 0
cTimer = Timer()
EndIf
If KeyHit(cbkeyQ) Then End
DrawScreen
Forever
Function GenerateBlocks()
InitBlocks()
For a = 0 To ScreenHeight()/gBlockWidth - 1
For i = 0 To ScreenWidth()/gBlockWidth - 1
BLOCKS(i,a,0) = Rand(1,5)
Next i
Next a
EndFunction
Function InitBlocks()
For a = 0 To ScreenHeight()/gBlockWidth - 1
For i = 0 To ScreenWidth()/gBlockWidth - 1
BLOCKS(i,a,1) = 0
Next i
Next a
EndFunction
Function CheckBlocks(x#,y#,firstblock = 0)
x = RoundDown(x)
y = RoundDown(y)
If FirstBlock = True Then
gCombometer = 0
gBlockID = BLOCKS(int(x),int(y),0)
EndIf
If BLOCKS(int(x),int(y),0) = gBlockID And BLOCKS(int(x),int(y),1) = 0 Then
BLOCKS(int(x),int(y),1) = 1
gComboMeter + 1
CheckBlocks(LimitX(x - 1),LimitY(y))
CheckBlocks(LimitX(x + 1),LimitY(y))
CheckBlocks(LimitX(x),LimitY(y - 1))
CheckBlocks(LimitX(x),LimitY(y + 1))
EndIf
EndFunction
Function ClearSelectedBlocks()
If gComboMeter > 2 Then
uusi.TEXTS = New(TEXTS)
uusi\x = gMouseX - 20
uusi\y = gMouseY - 20
uusi\value = gComboMeter ^ 2 * 100
uusi\cTimer = Timer()
For a = 0 To ScreenHeight()/gBlockWidth - 1
For i = 0 To ScreenWidth()/gBlockWidth - 1
If BLOCKS(i,a,1) = 1 Then
CreateParticle(i,a,i * gBlockWidth,a * gBlockWidth,Rand(359),1.2,0.12,0)
BLOCKS(i,a,0) = 0
EndIf
Next i
Next a
gPoints = gPoints + gComboMeter ^ 2 * 100
EndIf
InitBlocks()
EndFunction
Function DrawBlocks()
For a = 0 To ScreenHeight()/gBlockWidth - 1
For i = 0 To ScreenWidth()/gBlockWidth - 1
Color COLORS(BLOCKS(i,a,0),0),COLORS(BLOCKS(i,a,0),1),COLORS(BLOCKS(i,a,0),2)
Box i * gBlockWidth,a * gBlockWidth,gBlockWidth,gBlockWidth
Color cbblack
Box i * gBlockWidth,a * gBlockWidth,gBlockWidth,gBlockWidth,0
Next i
Next a
EndFunction
Function UpdateBlockPosition()
For a = ScreenHeight()/gBlockWidth - 2 To 0 Step -1
For i = ScreenWidth()/gBlockWidth - 1 To 0 Step -1
If BLOCKS(i,a + 1,0) = 0 Then BLOCKS(i,a + 1,0) = BLOCKS(i,a,0) : BLOCKS(i,a,0) = 0
If a = 0 And BLOCKS(i,a,0) = 0 Then BLOCKS(i,0,0) = Rand(1,5)
Next i
Next a
EndFunction
Function LimitX(x)
Return Max(Min(ScreenWidth()/gBlockWidth - 1,x),0)
EndFunction
Function LimitY(y)
Return Max(Min(ScreenHeight()/gBlockWidth - 1,y),0)
EndFunction
Function UpdateTexts()
For uusi.TEXTS = Each Texts
If Timer() -uusi\cTimer > 1500 Then Delete uusi
uusi\y = uusi\y - 0.5
Color 255 - (Timer() - uusi\cTimer) / 12,255 - (Timer() - uusi\cTimer) / 12,255 - (Timer() - uusi\cTimer) / 12
Text uusi\x,uusi\y,uusi\Value
Next uusi
EndFunction
Function CreateParticle(i,a,x#,y#,angle,speed#,gravity#,ver#)
uusi.PAR = New(Par)
uusi\x = x
uusi\y = y
uusi\r = COLORS(BLOCKS(i,a,0),0)
uusi\g = COLORS(BLOCKS(i,a,0),1)
uusi\b = COLORS(BLOCKS(i,a,0),2)
uusi\Angle = Angle
uusi\Speed = Speed
uusi\Gravity = Gravity
uusi\CurGravity = ver * Rnd(0.1,0.9)
EndFunction
Function UpdateParticles()
For uusi.PAR = Each PAR
uusi\CurGravity = uusi\CurGravity + 1
uusi\x = uusi\x + Cos(uusi\Angle) * uusi\Speed
uusi\y = (uusi\y + uusi\gravity * uusi\CurGravity) - Sin(uusi\Angle) * uusi\Speed
Color uusi\r,uusi\g,uusi\b
box uusi\x, uusi\y, gBlockWidth, gBlockWidth
Color cbblack
Box uusi\x, uusi\y, gBlockWidth, gBlockWidth,0
If uusi\x< 0 Or uusi\x>ScreenWidth() Or uusi\y<0 Or uusi\y>ScreenHeight() Then Delete uusi
Next uusi
EndFunction
Hengität nyt manuaalisesti.
Re: Pikku pelit
Jep, plus boomshine muistaakseni....DatsuniG wrote:Axu: Chain Rxn? ; )
Re: Pikku pelit
Tässä pikku ajan tuhlausta.
P.S. Otin tän oppitunnissa.
Code: Select all
FrameLimit 40
ruoho = MakeObjectFloor ()
nurmikko = LoadImage ("Media\grass.bmp")
PaintObject ruoho, nurmikko
ukko1 = LoadObject ("Media\guy.bmp",72)
ukko2 = LoadObject ("Media\guy.bmp",72)
RotateObject ukko1,0
RotateObject ukko2,180
PositionObject ukko1,-150,100
PositionObject ukko2,150,-100
Repeat
If LeftKey() Then TurnObject ukko1,5
If RightKey() Then TurnObject ukko1,-5
If UpKey() Then MoveObject ukko1,2
If DownKey() Then MoveObject ukko1,-2
If KeyDown(cbKeyA) Then TurnObject ukko2,5
If KeyDown(cbKeyD) Then TurnObject ukko2,-5
If KeyDown(cbKeyW) Then MoveObject ukko2,2
If KeyDown(cbKeyS) Then MoveObject ukko2,-2
If ObjectX(ukko1)<-200 Then PositionObject ukko1,-200,ObjectY(ukko1)
If ObjectX(ukko1)>200 Then PositionObject ukko1,200,ObjectY(ukko1)
If ObjectY(ukko1)<-150 Then PositionObject ukko1,ObjectX(ukko1),-150
If ObjectY(ukko1)>150 Then PositionObject ukko1,ObjectX(ukko1),150
If ObjectX(ukko2)<-200 Then PositionObject ukko2,-200,ObjectY(ukko2)
If ObjectX(ukko2)>200 Then PositionObject ukko2,200,ObjectY(ukko2)
If ObjectY(ukko2)<-150 Then PositionObject ukko2,ObjectX(ukko2),-150
If ObjectY(ukko2)>150 Then PositionObject ukko2,ObjectX(ukko2),150
DrawScreen
Forever
DRAWSCREEN PIIRTÄÄ NÄYTÖN. TÄRKEIN KOMENTO!
Re: Pikku pelit
Ja sen kyllä huomaa. Tämähän on täsmälleen sama kuin oppitunti 8 paitsi, että tästä on poistettu kommentit ja jokainen koodirivi on sisennetty kerran. Miksi postasit tämän tänne, kun se on kerta kaikkien saatavilla oppitunneista?BabCoder wrote:P.S. Otin tän oppitunnissa.
Re: Pikku pelit
Mitä helv.. tossa ei oo kuin seinät ja kaksi tyyppiä.. tommosia ei kannata laittaa kyllä tänne.BabCoder wrote:Tässä pikku ajan tuhlausta.
P.S. Otin tän oppitunnissa.Code: Select all
FrameLimit 40 ruoho = MakeObjectFloor () nurmikko = LoadImage ("Media\grass.bmp") PaintObject ruoho, nurmikko ukko1 = LoadObject ("Media\guy.bmp",72) ukko2 = LoadObject ("Media\guy.bmp",72) RotateObject ukko1,0 RotateObject ukko2,180 PositionObject ukko1,-150,100 PositionObject ukko2,150,-100 Repeat If LeftKey() Then TurnObject ukko1,5 If RightKey() Then TurnObject ukko1,-5 If UpKey() Then MoveObject ukko1,2 If DownKey() Then MoveObject ukko1,-2 If KeyDown(cbKeyA) Then TurnObject ukko2,5 If KeyDown(cbKeyD) Then TurnObject ukko2,-5 If KeyDown(cbKeyW) Then MoveObject ukko2,2 If KeyDown(cbKeyS) Then MoveObject ukko2,-2 If ObjectX(ukko1)<-200 Then PositionObject ukko1,-200,ObjectY(ukko1) If ObjectX(ukko1)>200 Then PositionObject ukko1,200,ObjectY(ukko1) If ObjectY(ukko1)<-150 Then PositionObject ukko1,ObjectX(ukko1),-150 If ObjectY(ukko1)>150 Then PositionObject ukko1,ObjectX(ukko1),150 If ObjectX(ukko2)<-200 Then PositionObject ukko2,-200,ObjectY(ukko2) If ObjectX(ukko2)>200 Then PositionObject ukko2,200,ObjectY(ukko2) If ObjectY(ukko2)<-150 Then PositionObject ukko2,ObjectX(ukko2),-150 If ObjectY(ukko2)>150 Then PositionObject ukko2,ObjectX(ukko2),150 DrawScreen Forever
ja viel oppitunti..ei jumalauta.
Re: Pikku pelit
Hähää, 19 klikkausta (olis kyllä mukava jos vois viel ottaa siitä tuloksesta screenshotin tms... )axu wrote:Tässäpä hetken mielijohteesta, tunnissa koodattu peli: ChainBoom. ChainBoomissa tarkoitus on räjäyttää kaikki pallot mahdollisimman vähillä klikkauksilla. Pallo räjähtää, kun se osuu jo räjähtäneeseen palloon, yritä saada mahdollisimman suuria komboja
Klikkaamalla luodaan räjähdys.Oma ennätykseni: 23 klikkaustaCode: Select all
...peli...
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
NetMatch - se kunnon nettimättö-deathmatch! Avoimella lähdekoodilla varustettu
vesalaakso.com
Re: Pikku pelit
22 klikkausta here. Meni toinen taso persiilleen, se on mielestäni vaikein.
Re: Pikku pelit
Tässä on yks peli nimeltä kohtalo:
- Attachments
-
- Kohtalo.zip
- En laittanut koodia. Se olisi helpottanut pelin liian helpoksi...
- (586.91 KiB) Downloaded 305 times
DRAWSCREEN PIIRTÄÄ NÄYTÖN. TÄRKEIN KOMENTO!
Re: Pikku pelit
Topicin nimi on Pikku pelit, eikä "Muutaman rivin muita v*tuttavat pelit"! Olinpas töykeä...BabCoder wrote:Tässä on yks peli nimeltä kohtalo:
Re: Pikku pelit
Tässä olisi tälläinen Lehmien ammunta peli, jonka nimi on Ammuu.
EDIT:
Näppäimet ovat: R lataa, hiirellä ampuu.
- Attachments
-
- Ammuu.7z
- Peli, jossa ammutaan lehmiä =()
- (739.28 KiB) Downloaded 264 times
Black city peleistä parhain
Re: Pikku pelit
Jep. Jotenkin tuo "muutaman rivin muita v*tuttava peli" onnistui hidastamaan konettani juuri sopivasti, jotta jouduin sammuttamaan sen tehtävienhallinnasta.LittleGreen wrote:Topicin nimi on Pikku pelit, eikä "Muutaman rivin muita v*tuttavat pelit"! Olinpas töykeä...BabCoder wrote:Tässä on yks peli nimeltä kohtalo:
"Baby," I said. "I'm a genius but nobody knows it but me."
Re: Pikku pelit
50 rivin Ping Pong botilla : D
[/edit]
Code: Select all
FrameLimit 40
SetWindow "Ping Pong Impossible"
Global x As Float,y as Float, speed As Float, angle As Integer
Type PADS
Field X As Float
Field Y As Float
Field Bot
EndType
For i = 0 To 1
uusi.PADS = New(PADS)
uusi\bot = i
uusi\y = (ScreenHeight() - 10) * i
Next i
PrepareGame()
Repeat
Update()
DrawScreen
Forever
Function PrepareGame()
x = ScreenWidth() / 2 - 2
y = ScreenHeight() / 2 - 2
speed = 1
if rand(1) then angle = Rand(45,135) Else angle = Rand(225,315)
For uusi.PADS = Each PADS
uusi\x = ScreenWidth() / 2 - 25
Next uusi
EndFunction
Function Update()
For uusi.PADS = Each PADS
If uusi\bot Then
If uusi\x < x - 25 Then uusi\x = Min(ScreenWidth() - 50,uusi\x + (Min(Abs((x - 25) - uusi\x),1 * speed))) Else uusi\x = Max(0,uusi\x - Min(Abs((x - 25) - uusi\x),(1 * speed)))
If x > uusi\x And x < uusi\x + 50 And y > ScreenHeight() - 12 Then angle = WrapAngle(360 - angle)
Else
uusi\x = Min(Max(0,uusi\x + (RightKey() * speed) - (LeftKey() * speed)),ScreenWidth() - 50)
If x > uusi\x And x < uusi\x + 50 And y < 12 Then angle = WrapAngle(360 - angle)
EndIf
Box uusi\x,uusi\y,50,10
Next uusi
If x < 0 Then angle = WrapAngle(180 - angle)
If x > ScreenWidth() - 4 Then angle = WrapAngle(180 - angle)
speed = speed + 0.01
x = x + Cos(angle) * speed
y = y + Sin(angle) * speed
Circle x,y,4
Box 0,0,ScreenWidth(),ScreenHeight(),0
If OutOfScreen() Then PrepareGame()
EndFunction
Function OutOfScreen()
If y < 0 Or y > ScreenHeight() Then Return 1
EndFunction
EDIT:
Botin liike muutettu sulavammaksi. Nimi vaihdettu : D
Ja sama vielä 39 rivillä:
Code: Select all
Type PADS
Field X As Float
Field Y As Float
Field Bot
EndType
For i = 0 To 1
uusi.PADS = New(PADS)
uusi\bot = i
uusi\y = (ScreenHeight() - 10) * i
Next i
y# = -10
Repeat
speed# = speed + Float(0.4 / FPS())
x# = x# + Cos(angle) * speed#
y = y + Sin(angle) * speed#
Circle x,y,4
For uusi.PADS = Each PADS
If uusi\bot Then
If uusi\x < x - 25 Then uusi\x = Min(ScreenWidth() - 50,uusi\x + (Min(Abs((x - 25) - uusi\x),1 * speed))) Else uusi\x = Max(0,uusi\x - Min(Abs((x - 25) - uusi\x),(1 * speed)))
If x > uusi\x And x < uusi\x + 50 And y > ScreenHeight() - 12 Then angle = WrapAngle(360 - angle)
Else
uusi\x = Min(Max(0,uusi\x + (RightKey() * speed) - (LeftKey() * speed)),ScreenWidth() - 50)
If x > uusi\x And x < uusi\x + 50 And y < 12 Then angle = WrapAngle(360 - angle)
EndIf
Box uusi\x,uusi\y,50,10
Next uusi
If x < 0 Then angle = WrapAngle(180 - angle)
If x > ScreenWidth() - 4 Then angle = WrapAngle(180 - angle)
If y < 0 Or y > ScreenHeight() Then
x = ScreenWidth() / 2 - 2
y = ScreenHeight() / 2 - 2
speed = 1
If Rand(1) then angle = Rand(45,135) Else angle = Rand(225,315)
For uusi.PADS = Each PADS
uusi\x = ScreenWidth() / 2 - 25
Next uusi
EndIf
DrawScreen
Forever
Last edited by DatsuniG on Sat Jul 11, 2009 9:00 pm, edited 1 time in total.
Hengität nyt manuaalisesti.
- kaneli2000
- Guru
- Posts: 1059
- Joined: Mon Mar 17, 2008 2:40 pm
- Location: Lempäälä
Re: Pikku pelit
Osuva oli nimi :s .DatsuniG wrote:50 rivin Ping Pong botilla : D
Code: Select all
FrameLimit 40 SetWindow "Ping Pong Impossible" Global x As Float,y as Float, speed As Float, angle As Integer Type PADS Field X As Float Field Y As Float Field Bot EndType For i = 0 To 1 uusi.PADS = New(PADS) uusi\bot = i uusi\y = (ScreenHeight() - 10) * i Next i PrepareGame() Repeat Update() DrawScreen Forever Function PrepareGame() x = ScreenWidth() / 2 - 2 y = ScreenHeight() / 2 - 2 speed = 1 if rand(1) then angle = Rand(45,135) Else angle = Rand(225,315) For uusi.PADS = Each PADS uusi\x = ScreenWidth() / 2 - 25 Next uusi EndFunction Function Update() For uusi.PADS = Each PADS If uusi\bot Then If uusi\x < x - 25 Then uusi\x = Min(ScreenWidth() - 50,uusi\x + (Min(Abs((x - 25) - uusi\x),1 * speed))) Else uusi\x = Max(0,uusi\x - Min(Abs((x - 25) - uusi\x),(1 * speed))) If x > uusi\x And x < uusi\x + 50 And y > ScreenHeight() - 12 Then angle = WrapAngle(360 - angle) Else uusi\x = Min(Max(0,uusi\x + (RightKey() * speed) - (LeftKey() * speed)),ScreenWidth() - 50) If x > uusi\x And x < uusi\x + 50 And y < 12 Then angle = WrapAngle(360 - angle) EndIf Box uusi\x,uusi\y,50,10 Next uusi If x < 0 Then angle = WrapAngle(180 - angle) If x > ScreenWidth() - 4 Then angle = WrapAngle(180 - angle) speed = speed + 0.01 x = x + Cos(angle) * speed y = y + Sin(angle) * speed Circle x,y,4 Box 0,0,ScreenWidth(),ScreenHeight(),0 If OutOfScreen() Then PrepareGame() EndFunction Function OutOfScreen() If y < 0 Or y > ScreenHeight() Then Return 1 EndFunction
EDIT:Botin liike muutettu sulavammaksi. Nimi vaihdettu : D
I see the rainbow rising
Re: Pikku pelit
Pakko vastata: Eka yritys, 0.0 pikseliä.KillBurn wrote:Hahaa, ennätys 2.2 pikseliä.Ekalla yrityksellä.Jonhu wrote:Edellisessä oli pieni virhe..
Tuossa korjattuna: tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2)
Erityyppinen toinen versio:Code: Select all
SCREEN 800,600 AddText "Yritä asettaa ruksi mahdollisimman keskelle ympyrää!" ruksi=MakeImage(10,10) DrawToImage ruksi Color cbred : Line 0,0,10,10 : Line 10,0,0,10 DrawToScreen alku: ShowMouse OFF Const ympkoko=450 Const ympX = 100 Const ympY = 100 tee=0 : py#=0 : px#=0 Repeat Color cbred Circle ympX,ympY,ympkoko,0 If MouseDown(1) And tee=0 And Distance(ympX+ympkoko/2, ympY+ympkoko/2, MouseX(), MouseY())<= ympkoko/2 Then px#=MouseX() : py#=MouseY(): tee=2 EndIf If tee=2 Then tex$=etaisyys(ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2) tee=1 ShowMouse ON EndIf If px#>0 And py#>0 Then Text 3,20,tex$ Color cbdark : Line ympX+ympkoko/2, ympY+ympkoko/2, px#+ImageWidth(ruksi)/2, py#+ImageHeight(ruksi)/2 EndIf If nappi(580,500,170,40,0,0,1,1)=1 Then Goto alku If px#=0 And py#=0 Then DrawImage ruksi,MouseX(),MouseY() Else DrawImage ruksi,px#,py# Color cbwhite: Text 597,510,"Yritä uudestaan" DrawScreen Forever Function etaisyys(x1#, y1#, x2#, y2#) aa#=Distance(x1#, y1#, x2#, y2#) testi$="Etäisyys keskipisteestä oli: "+aa#+" pikseliä" Return testi$ EndFunction Function nappi(alkux,alkuy,kokox,kokoy,valiy,valix,maara,tayte) For a=0 To maara-1 Color cbred Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte If MouseX()>alkux+valix*a And MouseX()<alkux+valix*a+kokox And MouseY()<alkuy+valiy*a+kokoy And MouseY()>alkuy+valiy*a Then Color cbyellow Box alkux+valix*a,alkuy+valiy*a,kokox,kokoy,tayte Color cbblack: Box alkux+valix*a+3,alkuy+valiy*a+3,kokox-6,kokoy-6,tayte If MouseDown(1) Then Return (a+1) EndIf EndIf Next a EndFunction
Dead men tell no tales. Also, Python rocks!
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Codegolf: 99 bottles of beer (oneliner) - Water map partition
Re: Pikku pelit
DatsuniG wrote:50 rivin Ping Pong botilla : D
Code: Select all
Scriptiä[edit]Botin liike muutettu sulavammaksi. Nimi vaihdettu : D[/edit][/quote] Hehe pallo lähti 90 asteen kulmassa kimpoilemaan, mikäs siinä minulla ja botilla aikaa vietellessä. :D
Solar Eclipse
We're in a simulation, and God is trying to debug us.