Tässä olisi pokeripelini, jos vielä ehtii mukaan. Peli tunnistaa vain parin, kolmoset, neloset, vitoset, värin ja suoran ja grafiikat on piirtokomennoilla
Code: Select all
SCREEN 800,600
ClsColor cbgold
Dim nimi(5) As String
Dim rahat(5)'pelaajien rahat
Dim käsi(4,5)'5 korttia 6 pelaajalla
Dim pisteet(5)
Dim nroa(13)
Dim maata(3)
Dim pakka(53)'52 korttia+2 jokeria
Dim maa(53)
Dim nro(53)
Global jokeri
jokeri=1
For m=0 To 3
For n=1 To 13
maa(m*13+n)=m
nro(m*13+n)=n
pakka(m*13+n)=m*13+n
Next n
Next m
uusi:
pelaa=5
For a=0 To 5
rahat(a)=1000
Next a
menu:
For a=0 To 4
For b=0 To 5
käsi(a,b)=0
Next b
Next a
If rahat(0)=0 Then Goto hävisit
For a=1 To 4
If rahat(a)=0 Then
For b=a To 4
rahat(b)=rahat(b+1)
nimi(b)=nimi(b+1)
Next b
pelaa=pelaa-1
EndIf
Next a
If rahat(5)=0 Then pelaa=pelaa-1
If pelaa=0 Then Goto voitit
Repeat
For a=0 To 5
Text 0,20*a,"Pelaajalla"+(a+1)+"rahaa:"+rahat(a)
Next a
If nappi(200,200,300,30,"Jokeripokeri") Then Goto jokeripokeri
If nappi(200,250,300,30,"Ilman jokereita") Then Goto pokeri
If nappi(200,300,300,30,"Uusi peli") Then Goto uusi
If nappi(200,350,300,30,"Lopeta") Then End
DrawScreen
Forever
jokeripokeri:
jokeri=1
jaa:
sekoita()
For a=0 To 4
For b=0 To 5
käsi(a,b)=pakka(a+b*5)
Next b
Next a
järjestä()
Repeat
Text 0,0,"paina enter"
For a=0 To 4
kortti(100*a+150,450,maa(käsi(a,0)),nro(käsi(a,0)))
Next a
DrawScreen
Until KeyHit(28)
For a=0 To 5
pisteet(a)=0
For b=0 To 3
maata(b)=0
Next b
For b=1 To 13
nroa(b)=0
Next b
For b=0 To 4
If nro(käsi(b,a))> 0 Then
maata(maa(käsi(b,a)))=maata(maa(käsi(b,a)))+1
nroa(nro(käsi(b,a)))=nroa(nro(käsi(b,a)))+1
Else
For c=1 To 13
nroa(c)=nroa(c)+1
Next c
For c=0 To 3
maata(c)=maata(c)+1
Next c
EndIf
Next b
For b=1 To 13
pisteet(a)=Max(pisteet(a),nroa(b)*nroa(b))
Next b
For b=0 To 3
If maata(b)=5 Then pisteet(a)=Max(10,pisteet(a))
Next b
If nro(käsi(0,a))+1=nro(käsi(1,a)) And nro(käsi(0,a))+2=nro(käsi(2,a)) And nro(käsi(0,a))+3=nro(käsi(3,a)) And nro(käsi(0,a))+4=nro(käsi(4,a)) Then pisteet(a)=Max(pisteet(a),11)
Text 0,30*a,pisteet(a)
mpisteet=Max(mpisteet,pisteet(a))
Next a
For a=0 To 5
If pisteet(a)=mpisteet Then
rahat(a)=rahat(a)+300
Else
rahat(a)=rahat(a)-100
EndIf
Next a
Goto menu
pokeri:
jokeri=0
Goto jaa
voitit:
MakeError "voitit"
hävisit:
MakeError "hävisit"
End
Function sekoita()
For a=0 To 53
b=Rand(0,51+2*jokeri)
If jokeri=0 Then
If pakka(a)=0 Or pakka(a)=53 Then
b=52+jj
jj=1
EndIf
EndIf
c=pakka(a)
pakka(a)=pakka(b)
pakka(b)=c
Next a
EndFunction
Function järjestä()
For a=0 To 5
For b=0 To 3
For c=0 To 3-b
If käsi(c,a)>käsi(c+1,a) Then
d=käsi(c,a)
käsi(c,a)=käsi(c+1,a)
käsi(c+1,a)=d
EndIf
Next c
Next b
Next a
EndFunction
Function nappi(x,y,w,h,t$)
Box x,y,w,h,0
CenterText x+w/2,y+h/2,t$,2
If MouseHit(1) And MouseX()>x And MouseY()>y And MouseX()<x+w And MouseY()<y+h Then Return 1
EndFunction
Function kortti(x,y,m,n)
Color cbwhite
Box x,y,100,150,1
Select m
Case 0
Color cbblack
Line x+50,y+75,x+50,y+125
Line x+25,y+100,x+75,y+100
Case 1
Color cbred
Line x+50,y+75,x+25,y+100
Line x+50,y+75,x+75,y+100
Line x+50,y+125,x+25,y+100
Line x+50,y+125,x+75,y+100
Case 2
Color cbblack
Line x+50,y+75,x+50,y+125
Line x+50,y+75,x+25,y+100
Line x+50,y+75,x+75,y+100
Case 3
Color cbred
Line x+50,y+125,x+25,y+100
Line x+50,y+125,x+75,y+100
EndSelect
If n>0 Then
CenterText x+50,y+50,n,2
Else
Color cbgold
CenterText x+50,y+75,"Joker",2
EndIf
Box x,y,100,150,0
EndFunction
Pelasin melkein 5 minsaa ennen kuin huomasin että pelissä ei voi voittaa!
