ポーカーのテクニカルノートです

[1,2,3,4,5,6,,,,,48,49,50,51,52]というような普通の番号リストを用意します。それをシャッフルします。具体的にどのようにするのかというと、ランダムに数字を抜き出し、それを普通の番号リストの最後（５３番目）に配置します。そして元の位置にあった数字をカットすればよいのです。これを適当な回数繰り返してやるとバラバラの数字が並んだリストが完成します。
次にこのシャッフルされたリストの１から１０番目を抜き出します。この最初の５枚がCPUのカード、そして残りの５枚が人間のカードになります。

まずすべてのカードが５４までの数字で表されていますが、それを変換するところから始めましょう。１〜１３は問題ありませんが、１４以降はわり算を行います。たとえば３３ならば、３３＝１３＊２＋７となり、マークは３番目（ハート）数字は７となります。これを先ほど１０枚抜きだしたカードに施し、それぞれ[数字のリスト]と[マークのリスト]を作ります。
次にマークの配置ですが、全トランプのマークの相関座標をリストにして配置しておきます。たとえば７の時は７つのマークがどれぐらいの距離離れて並んでいるのかというのを、数字のデータとして格納しておきます。
その距離間のデータを読み込んで、マークを表示します。軌跡効果を使うので、いっぱい並んでいるように見えるのです。

それぞれのカードの組について「同じ数字が重なっている箇所があるか」「つながって並んでいる箇所があるか」「すべて同じマークかどうか」等について判定し、役を決定しています。コンピュータが自分で考える場合も同様ですが、ペアでないカードを切ったり、違うマークのカードを切るように設定しておきます。

setPrefとgetPrefのコマンドを使っています。

on init
　global CardList,HaitiVList,HaitiHList ,MarkList,AtamaList,OwariList,MarkItemsList,ZureHList,ZureVList,changeList,changeflag,bet,CPUscore,HumanScore,NowMarkList,NowNumberList,NowList,NowMarkCastList,NowMarkCastColorList
　set CardList=[]
　set NowList=[]
　set HaitiHList=[45, 45,45, 45,45,45, 30,60,30,60, 30,60,45,30,60, 30,60,30,60,30,60, 30,60,45,30,60,30,60, 30,60,45,30,60,45,30,60, 30,60,30,60,45,30,60,30,60, 30,60,45,30,60,30,60,45,30,60, 45, 45, 45]
　set HaitiVList=[60, 40,80, 30,60,90, 40,40,80,80, 30,30,60,90,90, 30,30,60,60,90,90, 30,30,45,60,60,90,90, 30,30,45,60,60,75,90,90, 23,24,48,48,60,72,72,96,96, 24,24,36,48,48,72,72,84,96,96 , 60, 60, 60]
　set MarkList=[9,10,11,12,12]
　set AtamaList=[1,2,4,7,11,16,22,29,37,46,56,57,58]
　set OwariList=[1,3,6,10,15,21,28,36,45,55,56,57,58]
　set MarkItemList=[1,2,3,4,5,6,7,8,9,10,1,1,1]
　set ZureHList=[13,108,203,298,393,13,108,203,298,393]
　set ZureVList=[6,6,6,6,6,187,187,187,187,187]
　set changeList=[1,1,1,1,1,1,1,1,1,1]
　set changeflag=0
　set bet=1
　set Humanscore=0
　set NowMarkList=[]
　set NowNumberList=[]
　set NowMarkCastList=[]
　set NowMarkCastColorList=[]
　repeat with fieldfont=21 to 30
　　set the textsize of cast fieldfont to 12
　end repeat
　set the textsize of field "syouhai" to 24
　put "" into field "message"
　repeat with c=1 to 52
　　setAt CardList,c,c
　end repeat
　repeat with shaffle=1 to 200
　　put random(52) into target
　　setAt CardList, 52+1, getAt(CardList, target)
　　deleteAt CardList, target
　end repeat
　repeat with now=1 to 10
　　setAt NowList,now,getAt(CardList,now)
　end repeat
　repeat with m=1 to 10
　　puppetSprite m,TRUE
　　set the forecolor of sprite m to 35
　end repeat
　repeat with number=1 to 5
　　put "" into field "CPU"&number
　　put "" into field "Human"&number
　end repeat
　kubaru 10
end

on Kubaru spNum
　global CardList,NowList,changeList
　repeat with Card=1 to spNum
　　set the visible of sprite Card to False
　　updatestage
　end repeat
　puppetSound "shaffle"
　updatestage
　startTImer
　repeat while the Timer < 1*50
　　nothing
　end repeat
　repeat with openCard=1 to spNum
　　set the visible of sprite Opencard to TRUE
　　set the forecolor of sprite OpenCard to 35
　　puppetSound "card"
　　updatestage
　end repeat
end

on MarKAndNumber
　global CardList,NowList,NowMarkList,NowNumberList,NowMarkCastList,NowMarkCastColorList,changeList
　repeat with m=1 to 10
　　if getat(changeList,m)=1 then
　　　put integer((GetAt (NowList,m )-1) /13 +1) into Mark
　　　put getAt (MarkList,Mark) into MarkCast
　　　setAt NowMarkList,m,MarkCast
　　　put GetAt (NowList,m)mod 13 into Number
if Number=0 then set Number =13
setAt NowNumberList ,m,Number
　　if MarkCast=9 then
put 61 into NMK
set NMCC to 255
else if MarkCast=10 then
put 62 into NMK
set NMCC to 255
else if MarkCast=11 then
put 63 into NMK
set NMCC to 35
else if MarkCast=12 then
put 64 into NMK
set NMCC to 35
end if
setAt NowMarkCastList,m,NMK
setAt NowMarkCastColorList,m,NMCC
end if
end repeat
end
on hyouzi start,end
global CardList,NowList,HaitiVList,haitiHList,MarkList,AtamaList,OwariList,MarkItemsList,NowMarkList,NowNumberList,changeList,NowMarkCastList,NowMarkCastColorList
　repeat with Now=Start to End
　　if getAt(changeList,Now) = 1 then
　　　set the castNum of sprite Now to 4
　　　set the forecolor of sprite Now to 256
　　　repeat with markDrawStart=getAt(AtamaList,getAt(NowNumberList,Now)) to getAt(OwariList,getAt(NowNumberList,Now))
　　　put GetAt(NowNumberList,Now) into Num
　　　if Num=11 then
　　　　set the castNum of sprite Now+20 to 13
　　　else if Num=12 then
　　　　set the castNum of sprite Now+20 to 14
　　　else if Num=13 then
　　　　set the castNum of sprite Now+20 to 15
　　　else
　　　　set the castNum of sprite Now+20 to getAt(NowMarkList,Now)
　　　end if
　　　set the locH of sprite Now+20 to getAt(HaitiHList,markDrawStart) + getAt(ZureHList,Now)
　　　set the locV of sprite Now+20 to getAt(HaitiVList,markDrawStart) + getAt(ZureVList,Now)
　　　　updatestage
　　end repeat
　　put getAt(NowNumberList,Now) into DisplayText
　　if DisplayText=11 then set DisplayText to "J"
　　if DisplayText=12 then set DisplayText to "Q"
　　if DisplayText=13 then set DisplayText to "K"
　　put DisPlayText into cast Now+20
　　set the castNum of sprite 42 to getAt(NowMarkCastList,Now)
　　set the locH of sprite 42 to getAt(ZureHList,Now)+7
set the locV of sprite 42 to getAt(ZureVList,Now)+25
set the forecolor of sprite 42 to getAt(NowMarkCastColorList,Now)
　　updatestage
　　end if
　end repeat
　set changeList=[0,0,0,0,0,0,0,0,0,0]
　set the locH of sprite 42 to -200
end
on hantei
global CardList,NowList,NowMarkList,NowNumberList,BunruiNumberHumanList,HumanMarkListNew,HumanNumberListNew,humanScore,humanNumberHead
set BunruiNumberHumanList=[0,0,0,0,0,0,0,0,0,0,0,0,0]
set HumanMarkListNew=[]
set HumanNumberListNew=[]
set humanNumberHead to 0
set humanscore to 0
repeat with copy =6 to 10
setAt HumanMarkListNew,copy-5,getAt(NowMarkList,copy)
setAt HumanNumberListNew,copy-5,getAt(NowNumberList,copy)
end repeat
sort HumanMarkListNew
sort HumanNumberListNew
put "" into field "message"
repeat with add=6 to 9
setAt HumanNumberListNew,add,0
end repeat
repeat with m=1 to 13
put getOne(HumanNumberListNew,m) into head
if head=0 then
nothing
else
setAt BunruiNumberHumanList,m,1
if head <=4 and getAt(HumanNumberListNew,head) =getAt(HumanNumberListNew,head+1) then setAt BunruiNumberHumanList,m,2
if head <=3 and getAt(HumanNumberListNew,head) =getAt(HumanNumberListNew,head+2) then setAt BunruiNumberHumanList,m,3
if head <= 2 and getAt(HumanNumberListNew,head) =getAt(HumanNumberListNew,head+3) then setAt BunruiNumberHumanList,m,4
end if
end repeat
put "Nothing" into field "message"
if getOne( BunruiNumberHumanList,2)<>0 then
put getOne( BunruiNumberHumanList,2) into pairHead
repeat with Q=pairHead+1 to 13
if getAt(BunruiNumberHumanList,Q)=2 then
put" 2pair" into field "message"
set humanscore=2
exit repeat
else
put pairhead into humanNumberHead
put"1pair of " &pairhead into field "message"
set humanscore=1
end if
end repeat
if pairhead=13 then put "1pair of 13" into field "message"
end if
if getOne( BunruiNumberHumanList,3)<>0 then
put getOne( BunruiNumberHumanList,3) into humanNumberHead
put "3Card of "&humanNumberHead & "!!" into field "message"
set humanscore=3
end if
if getOne( BunruiNumberHumanList,3)<>0 and getOne( BunruiNumberHumanList,2)<>0 then
put "FullHouse " into field "message"
set humanscore=6
end if
if getOne( BunruiNumberHumanList,4)<>0 then
put "4 Card !! " into field "message"
set humanscore=100
end if
if max(BunruiNumberHumanList) = 1 and getOne (BunruiNumberHumanList,1) <=9 then
put getOne (BunruiNumberHumanList,1) into singleHead
if getAt(BunruiNumberHumanList,singleHead+1)=1 and getAt(BunruiNumberHumanList,singleHead+2)=1 and getAt(BunruiNumberHumanList,singleHead+3)=1 and getAt(BunruiNumberHumanList,singleHead+4)=1 then
put "Straight " into field "message"
set humanscore=4
end if
if getAt(HumanMarkListNew,1) = getAt(HumanMarkListNew,2) and getAt(HumanMarkListNew,3) = getAt(HumanMarkListNew,4) and getAt(HumanMarkListNew,5) = getAt(HumanMarkListNew,1) and getAt(HumanMarkListNew,2) = getAt(HumanMarkListNew,3) then
if humanScore=0 then
put "Flush !!" into field "message"
else
put "Flush" after field "message"
end if
set humanscore=humanscore+5
end if
if getAt(BunruiNumberHumanList,1) = 1 and getAt(BunruiNumberHumanList,10) = 1 and getAt(BunruiNumberHumanList,11) = 1 and getAt(BunruiNumberHumanList,12) = 1 and getAt(BunruiNumberHumanList,13) = 1 ﾂ
and getAt(HumanMarkListNew,1) = getAt(HumanMarkListNew,2) and getAt(HumanMarkListNew,3) = getAt(HumanMarkListNew,4) and getAt(HumanMarkListNew,5) = getAt(HumanMarkListNew,1) and getAt(HumanMarkListNew,2) = getAt(HumanMarkListNew,3) then
put "ROYAL STRAIGHT FLUSH !!!" into field "message"
set humanscore=10000
end if
end if
end
on btnEffectDown
global changeList
put the clickOn into NowSpNum
puppetSprite NowSpNum , TRUE
put the locV of sprite NowSpNum into NowV
put the locH of sprite NowSpNum into NowH
set the locH of sprite NowSpNum to NowH +2
set the locV of sprite NowSpNum to NowV +2
updatestage
repeat while the mouseDown
nothing
end repeat
set the locV of sprite NowSpNum to NowV
set the locH of sprite NowSpNum to NowH
set the castNum of sprite NowSpNum to 17
set the forecolor of sprite nowSpNum to 35
updatestage
setAt changeList, NowSpNum-38,1
end
on btnEffectUp
global changeList
put the clickOn into NowSpNum
puppetSprite NowSpNum , TRUE
put the locV of sprite NowSpNum into NowV
put the locH of sprite NowSpNum into NowH
set the locH of sprite NowSpNum to NowH +2
set the locV of sprite NowSpNum to NowV +2
updatestage
repeat while the mouseDown
nothing
end repeat
set the locV of sprite NowSpNum to NowV
set the locH of sprite NowSpNum to NowH
set the castNum of sprite NowSpNum to 16
set the forecolor of sprite nowSpNum to 255
updatestage
setAt changeList, NowSpNum-38,0
end
on reDraw start,End
global changeList
repeat with redrawcard=Start to End
if getAt(changeList,redrawcard) =1 then
puppetsound "card"
put "" into cast redrawcard+20
set the locH of sprite redrawcard+20 to -300
set the locV of sprite redrawcard+20 to -300
updatestage
set the castNum of sprite redrawCard to 54
updatestage
end if
end repeat
end
on CPUthink
global CardList,BunruiNumberCPUList,NowMarkListNew,NowNumberListNew,ChangeList,changeFlag,CPUscore,CPUNumberhead,NowMarkList,NowNumberList,BunruiMarkCPUList
set BunruiNumberCPUList=[0,0,0,0,0,0,0,0,0,0,0,0,0]
set BunruiMarkCPUList=[0,0,0,0]
set CPUMarkListNew=[]
set CPUNumberListNew=[]
set CPUNumberhead=0
repeat with a=1 to 5
setAt CPUMarkListNew,a,getAt(NowMarkList,a)
setAt CpuNumberListNew,a ,getAt(NowNumberList,a)
end repeat
sort CPUMarkListNew
sort CPUNumberListNew
put "" into field "CPUmessage"
repeat with Q=1 to 5
setAt BunruiMarkCPUList , getAt(CPUMarkListNew,Q),getAt(BunruiMarkCPUList,getAt(CPUMarkListNew,Q)-8)
end repeat
repeat with add=6 to 9
setAt CPUNumberListNew,add,0
end repeat
repeat with m=1 to 13
put getOne(CPUNumberListNew,m) into head
if head=0 then
nothing
else
setAt BunruiNumberCPUList,m,1
if head <=4 and getAt(CPUNumberListNew,head) =getAt(CPUNumberListNew,head+1) then setAt BunruiNumberCPUList,m,2
if head <=3 and getAt(CPUNumberListNew,head) =getAt(CPUNumberListNew,head+2) then setAt BunruiNumberCPUList,m,3
if head <= 2 and getAt(CPUNumberListNew,head) =getAt(CPUNumberListNew,head+3) then setAt BunruiNumberCPUList,m,4
end if
end repeat
put "Nothing" into field "CPUmessage"
if getOne( BunruiNumberCPUList,2)<>0 then
put getOne( BunruiNumberCPUList,2) into pairHead
repeat with Q=pairHead+1 to 13
if getAt(BunruiNumberCPUList,Q)=2 then
put "2pair" into field "CPUmessage"
set CPUscore=2
exit repeat
else
set CPUscore=1
set CPUNumberHead=pairhead
put "1pair of "& pairhead into field "CPUmessage"
end if
end repeat
if pairhead=13 then
set CPUNumberHead=13
put "1pair of 13" into field "CPUmessage"
end if
end if
if getOne( BunruiNumberCPUList,3)<>0 then
set CPUscore=3
put getOne( BunruiNumberCPUList,3) into CPUNumberHead
put "3Card of "&CPUNumberHead &"!!" into field "CPUmessage"
end if
if getOne( BunruiNumberCPUList,3)<>0 and getOne( BunruiNumberCPUList,2)<>0 then
put "FullHouse" into field "CPUmessage"
set CPUscore=6
end if
if getOne( BunruiNumberCPUList,4)<>0 then
put "Four Card !!" into field "CPUmessage"
set CPUscore=1000
end if
if max(BunruiNumberCPUList) = 1 and getOne (BunruiNumberCPUList,1) <=9 then
put getOne (BunruiNumberCPUList,1) into singleHead
if getAt(BunruiNumberCPUList,singleHead+1)=1 and getAt(BunruiNumberCPUList,singleHead+2)=1 and getAt(BunruiNumberCPUList,singleHead+3)=1 and getAt(BunruiNumberCPUList,singleHead+4)=1 then
set CPUscore=4
put "Straight" into field "CPUmessage"
end if
end if
if getAt(CPUMarkListNew,1) = getAt(CPUMarkListNew,2) and getAt(CPUMarkListNew,3) = getAt(CPUMarkListNew,4) and getAt(CPUMarkListNew,5) = getAt(CPUMarkListNew,1) and getAt(CPUMarkListNew,2) = getAt(CPUMarkListNew,3) then
if CPUscore=0 then
put "Flush" into field "CPUmessage"
else
put "Flush" after field "CPUmessage"
end if
set CPUscore=CPUscore+5
end if
if getAt(BunruiNumberCPUList,1) = 1 and getAt(BunruiNumberCPUList,10) = 1 and getAt(BunruiNumberCPUList,11) = 1 and getAt(BunruiNumberCPUList,12) = 1 and getAt(BunruiNumberCPUList,13) = 1 ﾂ
and getAt(CPUMarkListNew,1) = getAt(CPUMarkListNew,2) and getAt(CPUMarkListNew,3) = getAt(CPUMarkListNew,4) and getAt(CPUMarkListNew,5) = getAt(CPUMarkListNew,1) and getAt(CPUMarkListNew,2) = getAt(CPUMarkListNew,3) then
put "Royal Straight Flush !!!" into field "CPUmessage"
set CPUscore=100000
end if
if changeflag=1 then
set changeflag=0
else
if CPUscore <= 1000 then
set ChangeList=[0,0,0,0,0,0,0,0,0,0]
set CPUscore to 0
if Max(BunruiMarkCPUList)=4 then
setAt Changelist,getOne(NowMarkList,getOne(BunruiMarkCPUList, 1)),1
else
repeat with checkNumber=1 to 5
if GetAt(BunruiNumberCPUList,GetAt(NowNumberList,checkNumber))=1 then setAt ChangeList,checkNumber,1
end repeat
end if
repeat with swap=1 to 5
if getAt(ChangeList,swap)=1 then setAt NowList,swap,getAt(CardList,swap+10)
end repeat
set changeFlag to 1
end if
end if
end

on syouhai
　global CPUscore,humanscore,bet,yourmoney,humanNumberHead,CPUNumberHead
　if cpuscore > humanscore then
　　put "You LOST" into field "syouhai"
　　set yourmoney = yourmoney - bet*CpuScore
　else if Cpuscore=humanscore then
　　if humanNumberHead < CPUNumberHead then
　　　put "You LOST" into field "syouhai"
　　　set yourmoney = yourmoney - bet*CpuScore
　　else if humanNumberHead = CPUNumberHead then
　　　put "Draw" into field "syouhai"
　　else
　　　put "You Win "into field "syouhai"
　　　set yourmoney = yourmoney + bet * HumanScore
　　end if
　else
　　put "You Win "into field "syouhai"
　　set yourmoney = yourmoney + bet * HumanScore
　　puppetsound"connect"
　end if
　put "$" && yourmoney into field "yourName"
　updatestage
　setPref "Poker.txt",string(yourmoney)
end
© Akira SAno 1996
一応こんなページでも著作権は佐野彰に存在します
リンクフリーですが、メールでご連絡頂けたら嬉しいです。
96/12/7更新 ホームに戻る