#runtime "hsp3cl"
#cmpopt varinit 1
;トランプカードモジュール
suitStrs@TrumpCard="▲","▼","◆","■","JO"
powerStrs@TrumpCard="Ａ","２","３","４","５","６","７","８","９","10","Ｊ","Ｑ","Ｋ","KR"
#module TrumpCard name,suit,power
#modcfunc tcName
return name
#modcfunc tcPower
return power
#modcfunc tcSuit
return suit
#define news(%1,%2,%3) newmod %1,TrumpCard,%2,%3
#modinit int _suit,int _power
name=suitStrs(_suit)+powerStrs(_power)
power=_power
suit=_suit
return
#global
;トランプの束モジュール
#module TrumpDeck co,i,deck,count,hash
#modcfunc tdCount
return count
#define new(%1) dimtype %1,5:newmod %1,TrumpDeck
#modinit
randomize
#define deckDefine \
suits= \
0,0,0,0,0, 0,0,0,0,0, 0,0,0, \
1,1,1,1,1, 1,1,1,1,1, 1,1,1, \
2,2,2,2,2, 2,2,2,2,2, 2,2,2, \
3,3,3,3,3, 3,3,3,3,3, 3,3,3 \
/*,4,4*/ :\
powers= \
0,1,2,3,4,5, 6,7,8,9,10, 11,12, \
0,1,2,3,4,5, 6,7,8,9,10, 11,12, \
0,1,2,3,4,5, 6,7,8,9,10, 11,12, \
0,1,2,3,4,5, 6,7,8,9,10, 11,12 \
/*,13,13*/
deckDefine
foreach suits
news@TrumpCard deck,suits(cnt),powers(cnt)
hash(cnt)=cnt
loop
count=length(deck)
newlab co,1:return
gosub*trumpIter
return
#modfunc tdShuffle
foreach deck
r=rnd(count)
tmp=hash(cnt)
hash(cnt)=hash(r)
hash(r)=tmp
loop
return
*trumpIter
for i,0,length(suits)
_card=deck(hash(i))
newlab co,1:return
next
return
#modfunc local tdNext var card
gosub co
card=_card
return
#define global tdNext(%1,%2) dimtype %2,5:tdNext@TrumpDeck %1,%2
#global
;プレイヤーモジュール
#module Player deck,cardCnt,pass,isGameOut,name
#modcfunc plName
return name
#modcfunc plCardCnt
return cardCnt
#modcfunc plPass
return pass
#modcfunc plIsGameOut
return isGameOut
#modfunc plRefDeck array _deck
if cardCnt!=0 {
dimtype _deck,5,cardCnt
repeat cardCnt
_deck(cnt)=deck(cnt)
loop
}
else: dim _deck
return
#define news(%1,%2) newmod %1,Player,%2
#modinit str _name
name=_name
cardCnt=0
pass=0;3
isGameOut=1
return
#modfunc plSortDeck
repeat cardCnt
i=cnt
repeat cardCnt-i
n=i+cnt
#define ctype sortValue(%1) tcSuit(deck(%1))*13+tcPower(deck(%1))
if sortValue(n)<sortValue(i) {
tmp=deck(i)
deck(i)=deck(n)
deck(n)=tmp
}
loop
loop
return
#modfunc plAddCard var card
deck(cardCnt)=card
cardCnt++
return
#modfunc plRemoveCard str cardName
repeat cardCnt
if tcName(deck.cnt)=cardName {
delID=cnt
repeat cardCnt-delID-1
deck(delID+cnt)=deck(delID+cnt+1)
loop
cardCnt--
break
}
loop
return
#modcfunc plExistCard str cardName
existCard=-1
repeat cardCnt
if tcName(deck.cnt)=cardName {
existCard=cnt
break
}
loop
return existCard
#modfunc plUsePass
pass--
return
#modfunc plGameOut
isGameOut=0
return
#global
;トランプの場モジュール
#module TrumpField deck,cardCnt
#define new(%1) dimtype %1,5:newmod %1,TrumpField
#modfunc tfUseCard var _player,var card
deck(cardCnt)=card
plRemoveCard _player,tcName(card)
cardCnt++
return
#define global tfSortField(%1) plSortDeck %1
#modfunc tfView
foreach deck
mes tcName(deck.cnt)+" ",1
loop
return
#global
;七並べの列モジュール
#module SevensLine cardLine
#const jokerIndex 13
#const sevenIndex 6
#modfunc slRefCardLine array _cardLine
dimtype _cardLine,5,length(cardLine)
foreach cardLine
_cardLine(cnt)=cardLine(cnt)
loop
return
#define news(%1) newmod %1,SevensLine
#modinit
dim cardLine,13
cardLine(sevenIndex)=1
return
#modcfunc rangeMin
i=sevenIndex
repeat sevenIndex
i--
if cardLine(i)=0: break
loop
return i
#modcfunc rangeMax
i=sevenIndex
repeat sevenIndex,sevenIndex
i++
if cardLine(i)=0: break
loop
return i
#modcfunc slCheckUseCard int power
switch power
case jokerIndex
return 1
case rangeMin(thismod)
case rangeMax(thismod)
return 1
swend
return 0
#modfunc slUseCard int power
cardLine(power)=1
return
#global
;七並べモジュール
#module Sevens field,cardCnt,lines,rank,clearCnt
#define new(%1,%2) dimtype %1,5:newmod %1,Sevens,%2
#modinit array players
dimtype lines,5,4
repeat length(lines)
news@SevensLine lines
loop
dimtype deck,5
dimtype cardSevens,5,4
repeat 4
cardSevenName=suitStrs@TrumpCard(cnt)+powerStrs@TrumpCard(6)
foreach players
cardSevenIndex=plExistCard(players.cnt,cardSevenName)
if -1<cardSevenIndex {
plRefDeck players(cnt),deck
tfUseCard thismod,players(cnt),deck(cardSevenIndex)
break
}
loop
loop
dim rank,length(players)
clearCnt=0
return
#define svUseCard(%1,%2) \
slUseCard lines(tcSuit(%2)),tcPower(%2) :\
tfUseCard thismod,%1,%2
#define ctype svCheckUseCard(%1) \
slCheckUseCard(lines(tcSuit(%1)),tcPower(%1))
#modcfunc svTryUseCard var _player,var card
if 1!svCheckUseCard(card): return 0
svUseCard _player,card
return 1
#modcfunc svCheckPlayNext var _player
if 0<plPass(_player): return 1
dimtype deck,5
plRefDeck _player,deck
isPlayGame=0
foreach deck
if svCheckUseCard(deck.cnt) {
isPlayGame=1
break
}
loop
return isPlayGame
#modfunc svGameClear array players,int index
clearCnt++
rank(index)=clearCnt
plGameout players(index)
return
#modfunc svGameOver array players,int index
rank(index)=-1
dimtype deck,5
plRefDeck players(index),deck
foreach deck
svUseCard players(index),deck(cnt)
loop
plGameout players(index)
return
#modcfunc svCheckGameEnd
isGameEnd=1
foreach rank
if rank(cnt)=0 {
isGameEnd=0
break
}
loop
return isGameEnd
#modfunc svView
dim cardLine,13
s=""
foreach lines
i=cnt
ss=""
slRefCardLine lines(i),cardLine
repeat 13
if cardLine(cnt) {
s+=suitStrs@TrumpCard(i)
ss+=powerStrs@TrumpCard(cnt)
}
else {
s+="◇"
ss+="◇"
}
loop
s+="\n"+ss+"\n"
loop
mes s
return
#modfunc svResult array players
mes ""
foreach rank
if 0<rank(cnt): rankStr=strf("%d位",rank.cnt): else: rankStr="GameOver..."
mes strf("%s: %s",plName(players.cnt),rankStr)
loop
return
#global
;メイン処理
#module Program
#uselib "crtdll"
#cfunc getch "_getch"
#cfunc kbhit "_kbhit"
;カーソルの移動
#defcfunc move int _ch,int _csl,int max
csl=_csl
if _ch=$4b :csl-- ;左
if _ch=$4d :csl++ ;右
if csl<0 :csl=0
if max-1<csl :csl=max-1
return csl
;カーソルの表示
#deffunc cursolShow array items,int _csl
dim slct,length(items)
slct(_csl)=1
s=""
foreach items
if slct(cnt): s+=strf("[%s]",items(cnt)): else: s+=strf("%s",items(cnt))
loop
mes strf("%s\r",s),1
return
#deffunc main
repeat 100
mes ""
loop
mes {"
/---------------------------------------/
/ 七並べ /
/---------------------------------------/
"}
new@TrumpDeck trp
tdShuffle trp
dimtype p,5,4
repeat length(p)
news@Player p,"Player "+(cnt+1)
loop
repeat tdCount(trp)
tdNext trp,card
plAddCard p(cnt\4),card
loop
foreach p
plSortDeck p(cnt)
loop
new@Sevens field,p
svView field
dimtype deck,5
*selectLoop
foreach p
if 1!plIsGameOut(p.cnt): continue
if 1!svCheckPlayNext(field,p.cnt) {
svGameOver field,p(cnt),cnt
svView field
mes plName(p.cnt)+" GameOver...\n"
continue
}
plRefDeck p(cnt),deck
mes "【"+plName(p.cnt)+"】Pass: "+plPass(p.cnt)
sdim items
foreach deck
items(cnt)=tcName(deck.cnt)
loop
if 0<plPass(p.cnt): items(length(items))="PS:"+plPass(p.cnt)
while 1
cursol=0
cursolShow items,cursol
repeat
if kbhit() {
ch=getch()
if ch=$0d {
mes ""
break
}
if ch=$e0 {
cursol=move(getch(),cursol,length(items))
cursolShow items,cursol
}
}
loop
if 0<plPass(p.cnt) & length(items)-1=cursol {
plUsePass p.cnt
svView field
mes strf("残りパスは%d回です。\n",plPass(p.cnt))
_break
}
else:if svTryUseCard(field,p(cnt),deck(cursol)) {
svView field
mes strf("俺の切り札!! >「%s」\n",items(cursol))
if plCardCnt(p.cnt)=0 {
mes plName(p.cnt)+" Congratulations!!"
svGameClear field,p(cnt),cnt
}
_break
}
else {
mes "そのカードは出せないのじゃ…\n"
_continue
}
wend
if svCheckGameEnd(field): goto*exitSelect
loop
goto*selectLoop
*exitSelect
svResult field,p
return
#global
main