Microsoft Small Basic

Program Listing: TLW572

List Program

' Igo08.smallbasic - 囲碁 Igo v0.8
' Copyright (c) 2010 NonkiTakahashi
'
' 履歴：
' v0.1 2010/07/21 初版：碁盤の表示 (243行 NBK992)
' v0.2 2010/07/23 手数の表示 (265行 JVR185)
' v0.3 2010/07/24 人による次の手の処理 (378行 HHF931)
' v0.4 2010/07/31 棋譜の再生 (706行 HHF931-0)
' v0.5 2010/08/03 棋譜ファイルの入出力 (1088行 HHF931-1)
' v0.6 2010/08/08 勝敗の表示 、自動的に石を取る (1312行 HHF931-2)
' v0.7 2010/08/19 地の認識、着手禁止の判定、Territory (1801行 HHF931-3)
' v0.8 2010/08/28 bEyes、モンテカルロ法 (1945行)
'
' 参考文献：
' [1]清愼一, 山下宏, 佐々木宣介: 『コンピュータ囲碁の入門』, 共立出版, 2005.
' [2]石倉昇, 梅沢由香里, 黒瀧正憲, 兵頭俊夫: 『東大教養囲碁講座』, 光文社新書, 2007.
' [3]Anders Kierulf: File Format FF[1], http://www.red-bean.com/sgf/, 1990.
' [4]Karl Baker: The Way to Go, American Go Association, 1986.
' [5]美添一樹: モンテカルロ木検索, 情報処理, Vol.49 No.6, pp.686-693 (2008).
' [6]山下宏:『強豪囲碁ソフト「彩」について』,http://www32.ocn.ne.jp/~yss/index_j.html, 2009.
'
' ---------------------------------
' メインプログラム
' ---------------------------------
'
sVersion = "v0.8"
bDebug = "False"
bSound = "False"
InitProgram() ' プログラムの初期化
InitBoard() ' 盤の初期化
InitControls() ' コントロール部の初期化
' プログラム終了が指定されるまで｛｝内繰り返し
While bInProgram
'｛
' 新規
ClearBoard() ' 盤面のクリア
ShowBoard() ' 盤の表示
lRetry:
InputGameInfo() ' 対戦者名（または棋譜名）の入力
StartClock()
If bOpen Then
ReadRecord() ' 棋譜の読み込み
If bError Then
Goto lRetry
EndIf
ReplayGame() ' 棋譜の再生
Else
Shapes.SetText(oPrisoner[BLACK], 0) ' アゲハマのクリア
Shapes.SetText(oPrisoner[WHITE], 0) ' アゲハマのクリア
InitRecord() ' 棋譜の初期化
SaveGameDate() ' 対局日の保存
iMove = 0 ' 手数のクリア
' 対局または棋譜読み込み - 終局になるまで｛｝内繰り返し
While bInGame
'｛
EachTurn() ' 黒番
If bInGame Then
EachTurn() ' 白番
EndIf
' ｝
EndWhile
EndIf
StopClock()
PrintTime()
' 再生または棋譜書き出し
' 対戦者名（または棋譜名）の入力
bInGame = "True"
While bInGame
InputGameEndInfo()
If　bReplay Then
ReplayGame() ' 棋譜の再生
ElseIf bSave Then
WriteRecord() ' 棋譜の保存
EndIf
EndWhile
' ｝
EndWhile
'
' それぞれの手番
Sub EachTurn
iMove = iMove + 1
iColor = Math.Remainder((iMove - 1), 2) + 1
If iColor = BLACK Then
' 黒番ランプ表示
iX = iBLX
iY = iBLY
bOn = "True"
DrawLamp()
iX = iWLX
iY = iWLY
bOn = "False"
DrawLamp()
Else
' 白番ランプ表示
iX = iWLX
iY = iWLY
bOn = "True"
DrawLamp()
iX = iBLX
iY = iBLY
bOn = "False"
DrawLamp()
EndIf
' 次の手を打つ
If bReplay Then
Replay()
Else
' 着手可能な手を調べる
If sPlayer[iColor] = "Random" Or sPlayer[iColor] = "CPU" Or sPlayer[iColor] = "Easy" Then
bEyes = "True"
Else
bEyes = "False"
EndIf
GetPossiblePuts()
If sPlayer[iColor] = "Random" Then
bEasy = "False"
Random()
ElseIf sPlayer[iColor] = "Easy" Then
bEasy = "True"
Random()
ElseIf sPlayer[iColor] = "Territory" Then
Territory()
ElseIf sPlayer[iColor] = "CPU" Then
PlayOut() ' モンテカルロ法で次の手を決める
Else
Human()
EndIf
EndIf
' 投了なら終局
If bResign Then
bInGame = "False"
If (Math.Remainder(iMove, 2) = 1) Then
sScore = "W+R" ' 黒の投了
GraphicsWindow.Title = "Igo " + sVersion + " - 白の中押し勝ち"
Else
sScore = "B+R" ' 白の投了
GraphicsWindow.Title = "Igo " + sVersion + " - 黒の中押し勝ち"
EndIf
Else
' パスならパス回数をカウントアップ
If bPass Then
iPass = iPass + 1
Else
iPass = 0
EndIf
' 棋譜の記録
If bReplay = "False" Then
Record()
EndIf
' 盤の表示
bShow = "True" ' 結果を表示する
If bPass = "False" Then
DrawStone()
If bSound Then
Sound.PlayClickAndWait()
EndIf
' 四方の石が囲まれたら取り除く
RemoveCapturedStones()
If iRemoved > 0 Then
Shapes.SetText(oPrisoner[iColor], iPrisoner[iColor])
EndIf
EndIf
' 終局の判定
Judge()
EndIf
EndSub
'
' 四方の石が囲まれたら取り除く
Sub RemoveCapturedStones
iRemoved = 0
bEnclosed = "True" ' 四方を囲われている
iCTurn = iColor
If iColor = BLACK Then
iColor = WHITE
ElseIf iColor = WHITE Then
iColor = BLACK
ElseIf iColor = SPACE Then
Goto lSkipRemove
EndIf
iXTurn = iX
iYTurn = iY
For iET = 1 To 4
iX = iXTurn + idX4[iET]
iY = iYTurn + idY4[iET]
If iBoard[iX][iY] = iCTurn Or iBoard[iX][iY] = SPACE Then
bEnclosed = "False"
EndIf
If iX >=1 And iX <= iRo And iY >=1 And iY <= iRo Then
InitLiberty()
CountLiberty()
If iLiberty = 0 Then
RemoveUnit()
iRemoved = iRemoved + iUnit
iRX = iX
iRY = iY
iPrisoner[iCTurn] = iPrisoner[iCTurn] + iUnit
EndIf
EndIf
EndFor
iColor = iCTurn
iX = iXTurn
iY = iYTurn
If bEnclosed And iRemoved = 1 Then
iKo = iMove
iKX = iRX
iKY = iRY
EndIf
lSkipRemove:
EndSub
'
' ---------------------------------
' プログラム関連
' ---------------------------------
' プログラムの初期化
Sub InitProgram
SPACE = 0 ' 空点
BLACK = 1 ' 黒
WHITE = 2 ' 白
OB = 3 ' 盤外
BANDW = 4 ' 黒と白（CheckSpaceUnit()等で使用）
UPPERA = Text.GetCharacterCode("A") ' Aの文字コード
UPPERZ = Text.GetCharacterCode("Z") ' Zの文字コード
LOWERA = Text.GetCharacterCode("a") ' aの文字コード
LOWERZ = Text.GetCharacterCode("z") ' zの文字コード
LETTER0 = Text.GetCharacterCode("0") ' 0の文字コード
LETTER9 = Text.GetCharacterCode("9") ' 9の文字コード
CR = 13 ' キャリッジリターン（復改）の文字コード
LF = 10 ' ラインフィード（行送り）の文字コード
sNL = Text.GetCharacter(CR) + Text.GetCharacter(LF)
iRo = 4 ' 路数
rCX = 15.6
rCY = 24
GraphicsWindow.FontSize = rCY
sBoardColor = "Wheat"
For i = 0 To iRo
sAlpha[i] = Text.GetSubText(" abcdefghijklmnopqrs", i + 1, 1)
EndFor
sAlpha[iRo + 1] = "t" ' パス
iPass = 0
sStone[SPACE] = "SPACE"
sStone[BLACK] = "BLACK"
sStone[WHITE] = "WHITE"
sStone[OB] = "OB"
sGame = "対局"
sOpen = "開く"
sIsNotExist = "は存在しません。"
sIsNotGoFormat = "は囲碁の棋譜ではありません。"
sSave = "=" ' Windings 保存マーク
sSave2 = "保存"
sAlreadyExists = "はすでに存在します。"
sNew = "新規"
sReplay = "4" ' Windings 再生マーク
sPause = ";" ' Windings ポーズマーク
sPass = "パス"
sResign = "投了"
GraphicsWindow.Title = "Igo " + sVersion
bInProgram = "True"
InitEffect() ' 影響範囲座標の初期化
Init4() ' 四方の座標の初期化
iPlayOut = 1 ' モンテカルロ法のプレイアウト回数
EndSub
'
' コントロール部の初期化
Sub InitControls
GraphicsWindow.BackgroundColor = "Silver"
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FillEllipse(iBX1 + rCX, iBY0 + idLY, iSR * 2, iSR * 2)
iBHX = iBX1 + rCX + iSR * 2.5
iBHY = iBY0 + rCY * 2.5
oPrisoner[BLACK] = Shapes.AddText(0)
Shapes.Move(oPrisoner[BLACK], iBHX, iBHY)
iBLX = iBHX + rCX * 5
iBLY = iBHY
bOn = "True"
iX = iBLX
iY = iBLY
DrawLamp()
sPlayer[BLACK] = "Random" ' 黒プレイヤー初期値
oBlack = Controls.AddTextBox(iBX1 + rCX, iBY0)
Controls.SetTextBoxText(oBlack, sPlayer[BLACK])
oWhite = Controls.AddTextBox(iBX1 + rCX, iBY0 + idLY * iRo / 2)
sPlayer[WHITE] = "CPU" ' 白プレイヤー初期値
Controls.SetTextBoxText(oWhite, sPlayer[WHITE])
oPass = Controls.AddButton(sPass, iBX1 + rCX, iBY0 + idLY * iRo)
oResign = Controls.AddButton(sResign, iBX1 + rCX * 6, iBY0 + idLY * iRo)
Shapes.HideShape(oPass)
Shapes.HideShape(oResign)
oSGF = Controls.AddTextBox(iBX1 + rCX, iBY0 + idLY * iRo)
sSGF = "temp.sgf"
Controls.SetTextBoxText(oSGF, sSGF)
oNewGame = Controls.AddButton(sGame, iBX1 + rCX, iBY0 + idLY * iRo + rCY * 2)
oOpen = Controls.AddButton(sOpen, iBX1 + rCX * 6, iBY0 + idLY * iRo + rCY * 2)
oNew = Controls.AddButton(sNew, iBX1 + rCX, iBY0 + idLY * iRo + rCY * 2)
Controls.HideControl(oNew)
GraphicsWindow.FontName = "Webdings"
oReplay = Controls.AddButton(sReplay, iBX1 + rCX * 6, iBY0 + idLY * iRo + rCY * 2)
GraphicsWindow.BrushColor = "Red"
oSave = Controls.AddButton(sSave, iBX1 + rCX * 9, iBY0 + idLY * iRo + rCY * 2)
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontName = "Tahoma"
Controls.HideControl(oReplay)
Controls.HideControl(oSave)
iWHX = iBX1 + rCX + iSR * 2.5
iWHY = iBY0 + idLY * (iRo / 2) + rCY * 2.5
oPrisoner[WHITE] = Shapes.AddText(0)
Shapes.Move(oPrisoner[WHITE], iWHX, iWHY)
iWLX = iWHX + rCX * 5
iWLY = iWHY
bOn = "False"
iX = iWLX
iY = iWLY
DrawLamp()
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillEllipse(iBX1 + rCX, iBY0 + idLY * (iRo / 2 + 1), iSR * 2, iSR * 2)
Controls.TextTyped = OnTextTyped
EndSub
'
' ランプの表示
Sub DrawLamp
sSavedColor = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(iX + 1, iY + 1, 21, 7)
GraphicsWindow.BrushColor = "DimGray"
GraphicsWindow.FillRectangle(iX - 2, iY - 2, 21, 7)
If bOn Then
GraphicsWindow.BrushColor = "Lime"
Else
GraphicsWindow.BrushColor = "Black"
EndIf
GraphicsWindow.FillRectangle(iX, iY, 20, 6)
GraphicsWindow.BrushColor = sSavedColor
EndSub
'
' ---------------------------------
' ゲーム関連
' ---------------------------------
' 新規モード - 対戦者名（または棋譜名）の入力
Sub InputGameInfo
bShowMove = "False"
bInGame = "True"
bReplay = "False"
bResign = "False"
GraphicsWindow.Title = "Igo " + sVersion
Controls.ShowControl(oNewGame)
Controls.ShowControl(oOpen)
Controls.ShowControl(oSGF)
Controls.HideControl(oPass)
Controls.HideControl(oResign)
Controls.ButtonClicked = OnButtonClicked1
bNotClicked = "True"
While bNotClicked
Program.Delay(200)
EndWhile
Controls.HideControl(oNewGame)
Controls.HideControl(oOpen)
Controls.HideControl(oSGF)
Controls.ShowControl(oPass)
Controls.ShowControl(oResign)
EndSub
'
' TextBoxイベント処理
Sub OnTextTyped
If Controls.LastTypedTextBox = oBlack Then
sPlayer[BLACK] = Controls.GetTextBoxText(oBlack)
ElseIf Controls.LastTypedTextBox = oWhite Then
sPlayer[WHITE] = Controls.GetTextBoxText(oWhite)
ElseIf Controls.LastTypedTextBox = oSGF Then
sSGF = Controls.GetTextBoxText(oSGF)
EndIf
EndSub
'
' 新規モードのボタンイベント処理
Sub OnButtonClicked1
If Controls.LastClickedButton = oNewGame Then
bNotClicked = "False"
bOpen = "False"
ElseIf Controls.LastClickedButton = oOpen Then
bNotClicked = "False"
bOpen = "True"
EndIf
EndSub
'
' 終了モード - 再生, 保存または新規ボタンの入力
Sub InputGameEndInfo
bShowMove = "True"
bInGame = "True"
bReplay = "False"
bSave = "False"
bResign = "False"
Controls.HideControl(oPass)
Controls.HideControl(oResign)
Controls.ShowControl(oNew)
Controls.ShowControl(oReplay)
Controls.ShowControl(oSave)
Controls.ShowControl(oSGF)
Controls.ButtonClicked = OnButtonClicked2
bNotClicked = "True"
While bNotClicked
Program.Delay(200)
EndWhile
Controls.HideControl(oNew)
Controls.HideControl(oReplay)
Controls.HideControl(oSave)
Controls.HideControl(oSGF)
EndSub
'
' 終了モードのボタンイベント処理
Sub OnButtonClicked2
If Controls.LastClickedButton = oNew Then
bNotClicked = "False"
bSave = "False"
bReplay = "False"
bInGame = "False"
ElseIf Controls.LastClickedButton = oSave Then
bNotClicked = "False"
bSave = "True"
bReplay = "False"
bInGame = "True"
ElseIf Controls.LastClickedButton = oReplay Then
If iNumRec > 0 Then
bNotClicked = "False"
bReplay = "True"
bSave = "False"
bInGame = "True"
Else
If bSound Then
Sound.PlayChimeAndWait()
EndIf
EndIf
EndIf
EndSub
'
' 連を取り除く
Sub RemoveUnit
For i = 1 To iUnit
iX = iXU[i]
iY = iYU[i]
iBoard[iX][iY] = SPACE
If bShow Then
EraseStone()
EndIf
EndFor
EndSub
'
' 活路を数える準備
Sub InitLiberty
For iXL = 0 To iRo + 1
For iYL = 0 To iRo + 1
bNotChecked[iXL][iYL] = "True"
EndFor
EndFor
iLiberty = 0
iUnit = 0
EndSub
'
' 未確認フラグの保存
Sub SaveNC
For iXC = 0 To iRo + 1
For iYC = 0 To iRo + 1
bSavedNC[iXC][iYC] = bNotChecked[iXC][iYC]
EndFor
EndFor
EndSub
'
' 未確認フラグの復元
Sub RestoreNC
For iXC = 0 To iRo + 1
For iYC = 0 To iRo + 1
bNotChecked[iXC][iYC] = bSavedNC[iXC][iYC]
EndFor
EndFor
EndSub
'
' 連の活路を数える
Sub CountLiberty
Stack.PushValue("liberty", iXSave)
Stack.PushValue("liberty", iYSave)
Stack.PushValue("liberty", i)
iXSave = iX
iYSave = iY
If bNotChecked[iX][iY] Then
bNotChecked[iX][iY] = "False"
If iBoard[iX][iY] = SPACE Then
iLiberty = iLiberty + 1
ElseIf iBoard[iX][iY] = iColor Then
iUnit = iUnit + 1
iXU[iUnit] = iX
iYU[iUnit] = iY
For i = 1 To 4
iX = iXSave + idX4[i]
iY = iYSave + idY4[i]
CountLiberty()
EndFor
EndIf
EndIf
i = Stack.PopValue("liberty")
iYSave = Stack.PopValue("liberty")
iXSave = Stack.PopValue("liberty")
EndSub
'
' 地の空点の連を調べる
Sub CheckSpaceUnitInTerritory
Stack.PushValue("space", iXSave)
Stack.PushValue("space", iYSave)
Stack.PushValue("space", i)
iXSave = iX
iYSave = iY
If bNotChecked[iX][iY] Then
bNotChecked[iX][iY] = "False"
If iTerritory[iX][iY] = SPACE Then
iUnit = iUnit + 1
iXU[iUnit] = iX
iYU[iUnit] = iY
For i = 1 To 4
iX = iXSave + idX4[i]
iY = iYSave + idY4[i]
CheckSpaceUnitInTerritory()
EndFor
ElseIf iTerritory[iX][iY] = BLACK Then
If iColor = SPACE Then
iColor = BLACK
ElseIf iColor = WHITE Then
iColor = BANDW
EndIf
ElseIf iTerritory[iX][iY] = WHITE Then
If iColor = SPACE Then
iColor = WHITE
ElseIf iColor = BLACK Then
iColor = BANDW
EndIf
EndIf
EndIf
i = Stack.PopValue("space")
iYSave = Stack.PopValue("space")
iXSave = Stack.PopValue("space")
EndSub
'
' 空点の連を調べる
Sub CheckSpaceUnit
Stack.PushValue("space", iXSave)
Stack.PushValue("space", iYSave)
Stack.PushValue("space", i)
iXSave = iX
iYSave = iY
If bNotChecked[iX][iY] Then
bNotChecked[iX][iY] = "False"
If iBoard[iX][iY] = SPACE Then
iUnit = iUnit + 1
iXU[iUnit] = iX
iYU[iUnit] = iY
For i = 1 To 4
iX = iXSave + idX4[i]
iY = iYSave + idY4[i]
CheckSpaceUnit()
EndFor
ElseIf iBoard[iX][iY] = BLACK Then
If iColor = SPACE Then
iColor = BLACK
ElseIf iColor = WHITE Then
iColor = BANDW
EndIf
ElseIf iBoard[iX][iY] = WHITE Then
If iColor = SPACE Then
iColor = WHITE
ElseIf iColor = BLACK Then
iColor = BANDW
EndIf
EndIf
EndIf
i = Stack.PopValue("space")
iYSave = Stack.PopValue("space")
iXSave = Stack.PopValue("space")
EndSub
'
' （単独の）眼かどうか調べる
Sub CheckMyEye
bMyEye = "False"
If iBoard[iX][iY] = SPACE Then
For i = 1 To 4
iX1 = iX + idX4[i]
iY1 = iY + idY4[i]
iC1 = iBoard[iX1][iY1]
If iC1 = 3 - iColor Or iC1 = SPACE Then ' 相手の石か空
Goto lNotMyEye
EndIf
EndFor
EndIf
bMyEye = "True"
lNotMyEye:
EndSub
'
' （単独の）眼かどうか調べる
Sub CheckEye
If iBoard[iX][iY] = SPACE Then
iColor = SPACE
For i = 1 To 4
iX1 = iX + idX4[i]
iY1 = iY + idY4[i]
iC1 = iBoard[iX1][iY1]
If iC1 = SPACE Then
iColor = SPACE
Goto lCExit
ElseIf iC1 <> OB Then
If iColor = 3 - iC1 Then
iColor = SPACE
Goto lCExit
EndIf
iColor = iC1
EndIf
EndFor
EndIf
lCExit:
EndSub
'
' 終局の判定
Sub Judge
bInGame = "True"
If iPass >= 2 Then
bInGame = "False"
CountScore() ' 勝敗の判定
If bEasy = "False" Then
AdjustTerritory() ' 地の調整
EndIf
If bShow Then
DrawTerritory() ' 地の描画
XDeadStones() ' 死に石に×を付ける
If iScore > 0 Then
sScore = "B+" + iScore
GraphicsWindow.Title = "Igo " + sVersion + " - 黒の" + iScore + "目勝ち"
ElseIf iScore < 0 Then
sScore = "W+" + (-iScore)
GraphicsWindow.Title = "Igo " + sVersion + " - 白の" + (-iScore) + "目勝ち"
Else ' iScore = 0
sScore = "0"
GraphicsWindow.Title = "Igo " + sVersion + " - 引き分け（持碁）"
EndIf
EndIf
EndIf
EndSub
'
' 勝敗の判定
Sub CountScore
EvalBoard() ' 地の認識
iBlackScore = iBlackScore + iPrisoner[BLACK] ' アゲハマを加える
iWhiteScore = iWhiteScore + iPrisoner[WHITE] ' アゲハマを加える
iBlackScore = iBlackScore + iDead[WHITE] ' 死に石を加える
iWhiteScore = iWhiteScore + iDead[BLACK] ' 死に石を加える
iScore = iBlackScore - iWhiteScore
EndSub
'
' 地の調整
Sub AdjustTerritory
' 一方の石に囲まれている空白は地iTerritory[][]に加える
For iY = 1 To iRo
For iX = 1 To iRo
If iTerritory[iX][iY] = SPACE Then
InitLiberty()
iColor = SPACE
iXSave = iX
iYSave = iY
CheckSpaceUnitInTerritory()
iX = iXSave
iY = iYSave
If iColor = BLACK Then
For i = 1 To iUnit
iTerritory[iXU[i]][iYU[i]] = BLACK
EndFor
iBlackScore = iBlackScore + iUnit
ElseIf iColor = WHITE Then
For i = 1 To iUnit
iTerritory[iXU[i]][iYU[i]] = WHITE
EndFor
iWhiteScore = iWhiteScore + iUnit
EndIf
EndIf
EndFor ' iX
EndFor ' iY
iScore = iBlackScore - iWhiteScore
EndSub
'
' 盤面の評価
Sub EvalBoard
iCSave = iColor
If bEasy Then
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] = SPACE Then
CheckEye()
If iColor = BLACK Then
iBlackScore = iBlackScore + 1
ElseIf iColor = WHITE Then
iWhiteScore = iWhiteScore + 1
EndIf
EndIf
EndFor ' iX
EndFor ' iY
Else
iDead[BLACK] = 0
iDead[WHITE] = 0
iDeadSum = 0
For iY = 1 To iRo
For iX = 1 To iRo
iBlackEffect[iX][iY] = 0
iWhiteEffect[iX][iY] = 0
iTerritory[iX][iY] = SPACE
EndFor
EndFor
SaveBoard()
' 活路 iLiberty =1 の連をiBoard[][]から消し、死に石として記憶する
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] <> SPACE Then
iColor = iBoard[iX][iY]
iXSave = iX
iYSave = iY
InitLiberty()
CountLiberty()
If iLiberty = 1 Then
For i = 1 To iUnit
iX = iXU[i]
iY = iYU[i]
iBoard[iX][iY] = SPACE
iDeadSum = iDeadSum + 1
iDX[iDeadSum] = iX
iDY[iDeadSum] = iY
EndFor
iDead[iColor] = iDead[iColor] + iUnit
EndIf
iX = iXSave
iY = iYSave
EndIf
EndFor ' iX
EndFor ' iY
' 石の影響範囲を計算する
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] = BLACK Then
SetBlackEffect()
ElseIf iBoard[iX][iY] = WHITE Then
SetWhiteEffect()
EndIf
EndFor
EndFor
iBlackScore = 0 ' 黒の地を数える
iWhiteScore = 0 ' 白の地を数える
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] = BLACK Then
iTerritory[iX][iY] = BLACK
ElseIf iBoard[iX][iY] = WHITE Then
iTerritory[iX][iY] = WHITE
Else
If iBlackEffect[iX][iY] > iWhiteEffect[iX][iY] Then
iTerritory[iX][iY] = BLACK
iBlackScore = iBlackScore + 1
ElseIf iBlackEffect[iX][iY] < iWhiteEffect[iX][iY] Then
iTerritory[iX][iY] = WHITE
iWhiteScore = iWhiteScore + 1
EndIf
EndIf
EndFor
EndFor
RestoreBoard()
EndIf
iColor = iCSave
EndSub
'
' 碁盤の保存（盤面の評価用）
Sub SaveBoard
For iY = 1 To iRo
For iX = 1 To iRo
iSaved[iX][iY] = iBoard[iX][iY]
EndFor
EndFor
EndSub
'
' 碁盤の復元（盤面の評価用）
Sub RestoreBoard
For iY = 1 To iRo
For iX = 1 To iRo
iBoard[iX][iY] = iSaved[iX][iY]
EndFor
EndFor
EndSub
'
' 碁盤の保存2（モンテカルロ用）
Sub SaveBoard2
For iY = 1 To iRo
For iX = 1 To iRo
iSaved2[iX][iY] = iBoard[iX][iY]
EndFor
EndFor
EndSub
'
' 碁盤の復元2（モンテカルロ用）
Sub RestoreBoard2
For iY = 1 To iRo
For iX = 1 To iRo
iBoard[iX][iY] = iSaved2[iX][iY]
EndFor
EndFor
EndSub
'
' ゲーム属性の保存
Sub SaveGameProperties
iSKo = iKo
iSKX = iKX
iSKY = iKY
iSPrisoner[BLACK] = iPrisoner[BLACK]
iSPrisoner[WHITE] = iPrisoner[WHITE]
iSPass = iPass
EndSub
'
' ゲーム属性の復元
Sub RestoreGameProperties
iKo = iSKo
iKX = iSKX
iKY = iSKY
iPrisoner[BLACK] = iSPrisoner[BLACK]
iPrisoner[WHITE] = iSPrisoner[WHITE]
iPass = iSPass
EndSub
'
' 四方の座標差分の初期化
Sub Init4
idX4[1] = 1 ' 右
idY4[1] = 0
idX4[2] = 0 ' 上
idY4[2] = -1
idX4[3] = -1 ' 左
idY4[3] = 0
idX4[4] = 0 ' 下
idY4[4] = 1
EndSub
'
' 影響範囲（距離2）の座標差分の初期化
Sub InitEffect
idXE[1] = 0 ' 一番上
idYE[1] = -2
idXE[2] = -1 ' 左上
idYE[2] = -1
idXE[3] = 0 ' 上
idYE[3] = -1
idXE[4] = 1 ' 右上
idYE[4] = -1
idXE[5] = -2 ' 一番左
idYE[5] = 0
idXE[6] = -1 ' 左
idYE[6] = 0
idXE[7] = 0 ' 中央
idYE[7] = 0
idXE[8] = 1 ' 右
idYE[8] = 0
idXE[9] = 2 ' 一番右
idYE[9] = 0
idXE[10] = -1 ' 左下
idYE[10] = 1
idXE[11] = 0 ' 下
idYE[11] = 1
idXE[12] = 1 ' 右下
idYE[12] = 1
idXE[13] = 0 ' 一番下
idYE[13] = 2
EndSub
'
Sub SetBlackEffect
For i = 1 To 13
iXE = iX + idXE[i]
iYE = iY + idYE[i]
If iXE > 0 And iXE <= iRo And iYE > 0 And iYE <= iRo Then
iBlackEffect[iXE][iYE] = iBlackEffect[iXE][iYE] + 1
EndIf
EndFor
EndSub
'
Sub SetWhiteEffect
For i = 1 To 13
iXE = iX + idXE[i]
iYE = iY + idYE[i]
If iXE > 0 And iXE <= iRo And iYE > 0 And iYE <= iRo Then
iWhiteEffect[iXE][iYE] = iWhiteEffect[iXE][iYE] + 1
EndIf
EndFor
EndSub
'
' 盤の初期化
Sub InitBoard
For i = 0 To iRo + 1
iBoard[0][i] = OB
iBoard[iRo + 1][i] = OB
iBoard[i][0] = OB
iBoard[i][iRo + 1] = OB
EndFor
idLX = rCX * 3 ' 線の間隔
iSR = idLX / 2 - 2　' 碁石の半径
idLY = rCY * 2 ' 線の間隔
iLX0 = rCX * 6.5 ' 左端の線
iLY0 = rCY * 4.5 ' 上端の線
iLX1 = iLX0 + idLX * (iRo - 1) ' 右端の線
iLY1 = iLY0 + idLY * (iRo - 1) ' 下端の線
iBX0 = iLX0 - idLX * 1.5 ' 盤の左端
iBY0 = iLY0 - idLY * 1.5 ' 盤の上端
iBX1 = iLX1 + idLX ' 盤の右端
iBY1 = iLY1 + idLY ' 盤の下端
EndSub
'
' 盤面のクリア
Sub ClearBoard
For iX = 1 To iRo
For iY = 1 To iRo
iBoard[iX][iY] = SPACE
EndFor
EndFor
iPrisoner[BLACK] = 0
iPrisoner[WHITE] = 0
Controls.SetTextBoxText(oPrisoner[BLACK], 0)
Controls.SetTextBoxText(oPrisoner[WHITE], 0)
EndSub
'
' 盤の表示
Sub ShowBoard
' 盤の色を塗る
GraphicsWindow.BrushColor = sBoardColor
GraphicsWindow.FillRectangle(iBX0, iBY0, iBX1 - iBX0, iBY1 - iBY0)
' 枠を描く
iPW = GraphicsWindow.PenWidth
GraphicsWindow.PenWidth = 4
GraphicsWindow.DrawRectangle(iLX0, iLY0, idLX * (iRo - 1), idLY * (iRo - 1))
GraphicsWindow.PenWidth = iPW
' 線を描く
GraphicsWindow.PenColor = "Black"
For iX = iLX0 To iLX1 Step idLX
GraphicsWindow.DrawLine(iX, iLY0, iX, iLY1)
EndFor
For iY = iLY0 To iLY1 Step idLY
GraphicsWindow.DrawLine(iLX0, iY, iLX1, iY)
EndFor
' 数字を書く
GraphicsWindow.BrushColor = "Black"
For iX = 1 To iRo
GraphicsWindow.DrawText(iLX0 + (iX - 1.2) * idLX, iLY0 - idLY - 3, iX)
EndFor
For iY = 1 To iRo
GraphicsWindow.DrawText(iLX0 - idLX, iLY0 + (iY - 1.25) * idLY - 3, iY)
EndFor
EndSub
'
' 碁石を描く
Sub DrawStone
If iColor = WHITE Then
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillEllipse(iLX0 + (iX - 1) * idLX - iSR, iLY0 + (iY - 1) * idLY - iSR, iSR * 2, iSR * 2)
If bShowMove Then
GraphicsWindow.BrushColor = "Black"
If iMove > 9 Then
iND = 2
Else
iND = 1
EndIf
iNX = iLX0 + (iX - 1) * idLX - rCX / (3 - iND)
iNY = iLY0 + (iY - 1) * idLY - rCY / 2 - 3
GraphicsWindow.DrawText(iNX, iNY, iMove)
EndIf
ElseIf iColor = BLACK Then
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FillEllipse(iLX0 + (iX - 1) * idLX - iSR, iLY0 + (iY - 1) * idLY - iSR, iSR * 2, iSR * 2)
If bShowMove Then
GraphicsWindow.BrushColor = "White"
If iMove > 9 Then
iND = 2
Else
iND = 1
EndIf
iNX = iLX0 + (iX - 1) * idLX - rCX / (3 - iND)
iNY = iLY0 + (iY - 1) * idLY - rCY / 2 - 3
GraphicsWindow.DrawText(iNX, iNY, iMove)
EndIf
EndIf
EndSub
'
' 碁石を消す
Sub EraseStone
' 碁石を碁盤の色で消す
GraphicsWindow.BrushColor = sBoardColor
GraphicsWindow.FillRectangle(iLX0 + (iX - 1) * idLX - iSR, iLY0 + (iY - 1) * idLY - iSR, iSR * 2, iSR * 2)
GraphicsWindow.PenColor = "Black"
' 横線の引き直し
If iX = 1 Then
iEX0 = iLX0
Else
iEX0 = iLX0 + (iX - 1) * idLX - iSR
EndIf
If iX = iRo Then
iEX1 = iLX0 + (iX - 1) * idLX
Else
iEX1 = iLX0 + (iX - 1) * idLX + iSR
EndIf
iEY0 = iLY0 + (iY - 1) * idLY
iEY1 = iLY0 + (iY - 1) * idLY
iPW = GraphicsWindow.PenWidth
If iY = 1 Or iY = iRo Then
GraphicsWindow.PenWidth = 4
GraphicsWindow.DrawLine(iEX0 - 2, iEY0, iEX1 + 2, iEY1)
Else
GraphicsWindow.DrawLine(iEX0, iEY0, iEX1, iEY1)
EndIf
GraphicsWindow.PenWidth = iPW
' 縦線の引き直し
iEX0 = iLX0 + (iX - 1) * idLX
iEX1 = iLX0 + (iX - 1) * idLX
If iY = 1 Then
iEY0 = iLY0
Else
iEY0 = iLY0 + (iY - 1) * idLY - iSR
EndIf
If iY = iRo Then
iEY1 = iLY0 + (iY - 1) * idLY
Else
iEY1 = iLY0 + (iY - 1) * idLY + iSR
EndIf
If iX = 1 Or iX = iRo Then
GraphicsWindow.PenWidth = 4
GraphicsWindow.DrawLine(iEX0, iEY0 - 2, iEX1, iEY1 + 2)
Else
GraphicsWindow.DrawLine(iEX0, iEY0, iEX1, iEY1)
EndIf
GraphicsWindow.PenWidth = iPW
EndSub
'
' 碁石に×を付ける
Sub XDeadStones
If iDeadSum > 0 Then
sPC = GraphicsWindow.PenColor
GraphicsWindow.PenColor = "Red"
iPW = GraphicsWindow.PenWidth
GraphicsWindow.PenWidth = 4
For i = 1 To iDeadSum
iX = iDX[i]
iY = iDY[i]
GraphicsWindow.DrawLine(iLX0 + (iX - 1) * idLX - iSR / 2, iLY0 + (iY - 1) * idLY - iSR / 2, iLX0 + (iX - 1) * idLX + iSR / 2, iLY0 + (iY - 1) * idLY + iSR / 2)
GraphicsWindow.DrawLine(iLX0 + (iX - 1) * idLX + iSR / 2, iLY0 + (iY - 1) * idLY - iSR / 2, iLX0 + (iX - 1) * idLX - iSR / 2, iLY0 + (iY - 1) * idLY + iSR / 2)
EndFor
GraphicsWindow.PenColor = sPC
GraphicsWindow.PenWidth = iPW
EndIf
EndSub
'
' 地に四角を描く
Sub DrawTerritory
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] = SPACE And iTerritory[iX][iY] = BLACK Then
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FillRectangle(iLX0 + (iX - 1) * idLX - iSR / 2, iLY0 + (iY - 1) * idLY - iSR / 2, iSR, iSR)
ElseIf iBoard[iX][iY] = SPACE And iTerritory[iX][iY] = WHITE Then
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(iLX0 + (iX - 1) * idLX - iSR / 2, iLY0 + (iY - 1) * idLY - iSR / 2, iSR, iSR)
EndIf
EndFor
EndFor
EndSub
'
' ---------------------------------
' 思考ルーチン関連
' ---------------------------------
' 着手可能な手のリスト作成
Sub GetPossiblePuts
iPossible = 0
iColor = Math.Remainder((iMove - 1), 2) + 1
For iY = 1 To iRo
For iX = 1 To iRo
If iBoard[iX][iY] <> SPACE Then
Goto lNotPossible
EndIf
If iMove > 1 And iKo = iMove - 1 And iKX = iX And iKY = iY Then
Goto lNotPossible ' コウダテが必要
EndIf
CheckSuiside() ' 自殺手のチェック
If bSuiside Then
Goto lNotPossible
EndIf
If bEyes Then ' 眼を守る
CheckMyEye() ' 眼かどうか調べる
If bMyEye Then ' 眼なら打たない（ただしコウを埋める手を除く）
If iMove = 1 Or iKo <> iMove - 2 Or iKX <> iX Or iKY <> iY Then
Goto lNotPossible
EndIf
EndIf
EndIf
iPossible = iPossible + 1
iPX[iPossible] = iX
iPY[iPossible] = iY
lNotPossible:
EndFor ' iX
EndFor ' iY
EndSub
'
' 自殺手のチェック
Sub CheckSuiside
bSuiside = "False"
iBoard[iX][iY] = iColor ' 仮に置く
iXSave = iX
iYSave = iY
InitLiberty()
CountLiberty() ' 活路を数える
If iLiberty = 0 Then ' 自殺手かもしれない
iCSave = iColor
iColor = 3 - iColor ' 相手の石
For i = 1 To 4 ' 接点の石が取れるか
iX = iXSave + idX4[i]
iY = iYSave + idY4[i]
If iX >= 1 And iX <= iRo And iY >= 1 And iY <= iRo And iBoard[iX][iY] = iColor Then
InitLiberty()
CountLiberty() ' 活路を数える
If iLiberty = 0 Then
Goto lNotSuiside
EndIf
EndIf
EndFor
bSuiside = "True"
lNotSuiside:
iColor = iCSave
EndIf
iX = iXSave
iY = iYSave
iBoard[iX][iY] = SPACE ' 元に戻す
EndSub
'
' 次の手を打つ - Random (コンピューター)
Sub Random
bPass = "False"
bResign = "False"
If iPossible > 0 Then
i = Math.GetRandomNumber(iPossible)
iX = iPX[i]
iY = iPY[i]
iColor = Math.Remainder((iMove - 1), 2) + 1
iBoard[iX][iY] = iColor
Else
bPass = "True"
EndIf
EndSub
'
' 次の手を打つ - Territory (コンピューター)
Sub Territory
bPass = "False"
bResign = "False"
If iPossible > 0 Then
iMax = -999
For iP = 1 To iPossible
iX = iPX[iP]
iY = iPY[iP]
iColor = Math.Remainder((iMove - 1), 2) + 1
iBoard[iX][iY] = iColor ' 仮に置いてみる
CountScore()
iX = iPX[iP]
iY = iPY[iP]
If iColor = WHITE Then
iScore = - iScore
EndIf
If iScore > iMax Then
iXMax = iX
iYMax = iY
iMax = iScore
EndIf
iBoard[iX][iY] = SPACE ' 元に戻す
EndFor
If iMax > -10 Then
iX = iXMax
iY = iYMax
iBoard[iX][iY] = iColor
Else
bPass = "True"
EndIf
Else
bPass = "True"
EndIf
EndSub
'
' 次の手を打つ - Montecarlo (コンピューター)
Sub PlayOut
If iPossible = 0 Then
bPass = "True"
Goto lPass
EndIf
If iPossible > 12 Then
iPlayOut = 1
ElseIf iPossible > 8 Then
iPlayOut = 2
Else
iPlayOut = 10
EndIf
SaveBoard2() ' 碁盤を保存
SavePossiblePuts() ' 着手可能な手を保存
SaveGameProperties() ' コウ、アゲハマ、パスを保存
iSMove = iMove ' 手数を保存
iSColor = iColor ' 石の色を保存
For i = 1 To iSNP ' 着手可能な手に対し
rWin[i] = 0.0 ' 勝ち数をクリア
rLose[i] = 0.0 ' 負け数をクリア
EndFor
bEyes = "True" ' 着手可能な手に自分の眼を含めない
bShow = "False" ' 終局判定で結果を表示しない
For iCP = 1 To iSNP
iX = iSX[iCP]
iY = iSY[iCP]
DumpPoint()
For iG = 1 To iPlayOut
iMove = iSMove - 1 ' 手数を1つ戻す
RestoreBoard2() ' 碁盤を元に戻す
RestoreGameProperties() ' コウ、アゲハマ、パスを元に戻す
iColor = BLACK
If Math.Remainder(iSMove, 2) = 0 Then
iColor = WHITE
Goto lNextWhite
EndIf
'
lNextBlack:
' 黒番
iMove = iMove + 1
GetPossiblePuts()
If iMove = iSMove Then
iX = iSX[iCP] ' 最初の手
iY = iSY[iCP] ' 最初の手
bPass = "False"
Else
Random()
EndIf
If bPass Then
iPass = iPass + 1
Else
iPass = 0
RemoveCapturedStones() ' 取られた石を取り除く
EndIf
Judge()
If bInGame <> "True" Then
Goto lEndGame
EndIf
'
lNextWhite:
' 白番
iMove = iMove + 1
GetPossiblePuts()
If iMove = iSMove Then
iX = iSX[iCP] ' 最初の手
iY = iSY[iCP] ' 最初の手
bPass = "False"
Else
Random()
EndIf
If bPass Then
iPass = iPass + 1
Else
iPass = 0
RemoveCapturedStones() ' 取られた石を取り除く
EndIf
Judge()
If bInGame Then
Goto lNextBlack
EndIf
'
lEndGame:
If iScore > 0 And iSColor = BLACK Or iScore < 0 And iSColor = WHITE Then
rWin[iCP] = rWin[iCP] + 1.0
ElseIf iScore = 0 then
rWin[iCP] = rWin[iCP] + 0.5
rLose[iCP] = rLose[iCP] + 0.5
Else
rLose[iCP] = rLose[iCP] + 1.0
EndIf
EndFor
EndFor
DumpNewLine()
'
rMax = 0.0
For i = 1 To iSNP
rAve[i] = rWin[i] / (rWin[i] + rLose[i])
If rAve[i] > rMax Then
rMax = rAve[i]
EndIf
EndFor
iPossible = 0
For i = 1 To iSNP
If rAve[i] = rMax Then
iPossible = iPossible + 1
iPX[iPossible] = iSX[i]
iPY[iPossible] = iSY[i]
EndIf
EndFor
RestoreBoard2() ' 碁盤を元に戻す
RestoreGameProperties() ' コウ、アゲハマ、パスを元に戻す
iMove = iSMove ' 手数を元に戻す
iColor = iSColor ' 石の色を元に戻す
Random() ' 同じ勝率の手からランダムに選ぶ
RestorePossiblePuts() ' 着手可能な手を元に戻す
lPass:
EndSub
'
' 着手可能な手の保存
Sub SavePossiblePuts
iSNP = iPossible
For i = 1 To iSNP
iSX[i] = iPX[i]
iSY[i] = iPY[i]
EndFor
EndSub
'
' 着手可能な手の復元
Sub RestorePossiblePuts
iPossible = iSNP
For i = 1 To iPossible
iPX[i] = iSX[i]
iPY[i] = iSY[i]
EndFor
EndSub
'
' 次の手を打つ - Human (人)
Sub Human
bPass = "False"
bResign = "False"
GraphicsWindow.MouseDown = OnMouseDown
Controls.ButtonClicked = OnButtonClicked
While "True"
bOutOfBoard = "True"
While bOutOfBoard
bNotClicked = "True"
While bNotClicked
Program.Delay(200)
EndWhile
If bPass Or bResign Then
Goto lPossiblePut
EndIf
GetPosition()
EndWhile
For i = 1 To iPossible
If iPX[i] = iX And iPY[i] = iY Then
Goto lPossiblePut
EndIf
EndFor
If bSound Then
Sound.PlayChimeAndWait()
EndIf
EndWhile
lPossiblePut:
iColor = Math.Remainder((iMove - 1), 2) + 1
If bPass = "False" And bResign = "False" Then
iBoard[iX][iY] = iColor
EndIf
EndSub
'
' マウスが押されたときの処理
Sub OnMouseDown
iMX = GraphicsWindow.MouseX
iMY = GraphicsWindow.MouseY
bNotClicked = "False"
EndSub
'
' マウスが押されたときの処理
Sub OnButtonClicked
If Controls.LastClickedButton = oResign Then
bResign = "True"
bNotClicked = "False"
ElseIf Controls.LastClickedButton = oPass Then
bPass = "True"
bNotClicked = "False"
EndIf
EndSub
'
' マウスをクリックした座標から碁盤の座標を得る
Sub GetPosition
iX = Math.Floor((iMX - iLX0 + idLX / 2) / idLX) + 1
iY = Math.Floor((iMY - iLY0 + idLY / 2) / idLY) + 1
If iX < 1 Or iX > iRo Or iY < 1 Or iY > iRo Then
bOutOfBoard = "True"
Else
bOutOfBoard = "False"
EndIf
EndSub
'
' 次の手を打つ - Replay (棋譜の再生)
Sub Replay
If iMove > iNumRec Then
bResign = "True"
Else
iColor = iRecord[iMove]["turn"]
iX = iRecord[iMove]["x"]
iY = iRecord[iMove]["y"]
If iX = iRo + 1 Then
bPass = "True"
Else
iBoard[iX][iY] = iColor
bPass = "False"
EndIf
EndIf
Program.Delay(200)
lReplayExit:
EndSub
'
' ---------------------------------
' 棋譜ファイル関連
' ---------------------------------
' 棋譜の初期化
Sub InitRecord
iNumRec = 0
EndSub
'
' 棋譜の記録
Sub Record
iNumRec = iNumRec + 1
If bPass Then
iX = iRo + 1
iY = iRo + 1
EndIf
iRecord[iNumRec]["x"] = iX
iRecord[iNumRec]["y"] = iY
iRecord[iNumRec]["turn"] = iColor
EndSub
'
' 棋譜による対局の再生
Sub ReplayGame
bShowMove = "True"
ClearBoard() ' 盤面のクリア
ShowBoard() ' 盤の表示
Shapes.SetText(oPrisoner[BLACK], 0) ' アゲハマのクリア
Shapes.SetText(oPrisoner[WHITE], 0) ' アゲハマのクリア
iMove = 0 ' 手数のクリア
bInGame = "True"
bReplay = "True"
While bInGame
'｛
EachTurn() ' 黒番
If bInGame Then
EachTurn() ' 白番
EndIf
' ｝
EndWhile
bInGame = "True"
EndSub
'
' 棋譜ファイルの書き出し（保存）
Sub WriteRecord
sBuf = "" ' Silverlight対策
' The following line could be harmful and has been automatically commented.
' sBuf = File.ReadContents(sSGF)
If Text.GetLength(sBuf) > 0 Then
GraphicsWindow.ShowMessage("'" + sSGF + "'" + sAlreadyExists, sSave2)
Else
iSGFLine = 1
sBuf = sBuf + "(;GM[1]FF[1]SZ[" + iRo + "]PB[" + sPlayer[BLACK] + "]PW[" + sPlayer[WHITE] + "]RE[" + sScore + "]" + sNL
iSGFLine = 2
sBuf = sBuf + "DT[" + sDate + "]KM[0.0]RU[Japanese]" + sNL
iSGFLine = 3
sLine = ""
For i = 1 To iNumRec
iX = iRecord[i]["x"]
iY = iRecord[i]["y"]
iColor = iRecord[i]["turn"]
If (iColor = BLACK) Then
sLine = sLine + ";B[" + sAlpha[iX] + sAlpha[iY] + "]"
ElseIf (iColor = WHITE) Then
sLine = sLine + ";W[" + sAlpha[iX] + sAlpha[iY] + "]"
EndIf
If Math.Remainder(i, 10) = 0 Then
sBuf = sBuf + sLine + sNL
iSGFLine = iSGFLine + 1
sLine = ""
EndIf
EndFor
sBuf = sBuf + sLine + ")" + sNL
iSGFLine = iSGFLine + 1
sLine = ""
' The following line could be harmful and has been automatically commented.
' File.WriteContents(sSGF, sBuf)
EndIf
EndSub
'
' 棋譜ファイルの読み込み（開く）
Sub ReadRecord
InitRecord()
sBuf = "" ' Silverlight対策
' The following line could be harmful and has been automatically commented.
' sBuf = File.ReadContents(sSGF)
iBufPtr = 1
iBufLen = Text.GetLength(sBuf)
If iBufLen = 0 Then
GraphicsWindow.ShowMessage("'" + sSGF + "'" + sIsNotExist, sOpen)
bError = "True"
Else
ParsePL() ' (
ParseSemicolon() ' ;
ParseNewLine() ' 改行 for CgfGoBan
ParseGame() ' GM[1]
If sValue <> "1" Then
GraphicsWindow.ShowMessage("'" + sSGF + "'" + sIsNotGoFormat +" GM[" + sValue + "]", sOpen)
bError = "True"
Goto lErrorExit
EndIf
ParseFF() ' FF[1]
ParseSize() ' SZ[6]
ParseNewLine() ' 改行 ... for CgfGoBan
ParsePB() ' PB[黒のプレイヤー名]
ParseNewLine() ' 改行 ... for CgfGoBan
ParsePW() ' PW[白のプレイヤー名]
ParseNewLine() ' 改行 ... for CgfGoBan
ParseBS() ' BS[黒の種別] ... for お父さんの囲碁3 FMV
ParseWS() ' WS[白の種別] ... for お父さんの囲碁3 FMV
ParseDate() ' DT[YYYY-MM-DD] for CgfGoBan
ParseNewLine() ' 改行 ... for CgfGoBan
ParseRE() ' RE[結果]
ParseNewLine() ' 改行
ParseDate() ' DT[YYYY-MM-DD]
ParseKomi() ' KM[0.0] ... for CgfGoBan
ParseTime() ' TM[持ち時間] ... for CgfGoBan
ParseHA() ' HA[ハンディ] ... for お父さんの囲碁3 FMV
ParseRule() ' RU[Japanese] ... for CgfGoBan
ParsePlace() ' PC[対局場所]
ParseEvent() ' EV[イベント]
ParseGN() ' GN[ゲーム名]
ParseAP() ' AP[プログラム名] ... for CgfGoBan
ParseView() ' VW[表示範囲] ... for お父さんの囲碁3 FMV
ParseNewLine() ' 改行 ... for CgfGoBan
ParseTime() ' TM[持ち時間]
ParseKomi() ' KM[0.0]
ParseRule() ' RU[Japanese]
ParseKomi() ' KM[0.0] ... for 勝也
ParseRE() ' RE[結果] ... for お父さんの囲碁3 FMV
ParsePlayer() ' PL[手番] ... for お父さんの囲碁3 FMV
ParseComment() ' C[コメント] ... for CgfGoBan
ParseNewLine() ' 改行 ... for CgfGoBan
ParseComment() ' C[コメント] ... for CgfGoBan
ParseNewLine() ' 改行 ... for CgfGoBan
ParseComment() ' C[コメント] ... for CgfGoBan
ParseNewLine() ' 改行
bError = "True"
While bError
ParsePR() ' )
If bError Then
ParseSemicolon() ' ;
ParseBlack() ' B[xy]
ParseWhite() ' W[xy]
ParseErase() ' E[xy] 互換のためしばらく残す
ParseComment() ' C[コメント] ... for 勝也
ParseT() ' T[消費時間] ... for CgfGoBan
ParseNewLine() ' 改行
bError = "True"
EndIf
EndWhile
bError = "False"
EndIf
lErrorExit:
EndSub
'
' 棋譜出力用の日付を保存
Sub SaveGameDate
sDate = Clock.Year + "-"
If Clock.Month <= 9 Then
sDate = sDate + "0"
EndIf
sDate = sDate + Clock.Month + "-"
If Clock.Day <= 9 Then
sDate = sDate + "0"
EndIf
sDate = sDate + Clock.Day
EndSub
'
' SGF字句解析 GM[1] - game ゲーム
Sub ParseGame
sID = "GM"
ParseProperty()
EndSub
'
' SGF字句解析 FF[1] - file format ファイルフォーマット
Sub ParseFF
sID = "FF"
ParseProperty()
EndSub
'
' SGF字句解析 SZ[6] - size サイズ
Sub ParseSize
sID = "SZ"
ParseProperty()
EndSub
'
' SGF字句解析 PB[黒のプレイヤー名]
Sub ParsePB
cChar = "P"
ParseChar()
cChar = "B"
ParseChar()
ParseText()
sPlayer[BLACK] = sText
Controls.SetTextBoxText(oBlack, sPlayer[BLACK])
EndSub
'
' SGF字句解析 PW[白のプレイヤー名]
Sub ParsePW
cChar = "P"
ParseChar()
cChar = "W"
ParseChar()
ParseText()
sPlayer[WHITE] = sText
Controls.SetTextBoxText(oWhite, sPlayer[WHITE])
EndSub
'
' SGF字句解析 RE[1] - result 結果
Sub ParseRE
sID = "RE"
ParseProperty()
EndSub
'
' SGF字句解析 DT[yyyy-mm-dd] - date 日付
Sub ParseDate
sID = "DT"
ParseProperty()
EndSub
'
' SGF字句解析 PC[Place] - 場所
Sub ParsePlace
sID = "PC"
ParseProperty()
EndSub
'
' SGF字句解析 EV[event name] - イベント名
Sub ParseEvent
sID = "EV"
ParseProperty()
EndSub
'
' SGF字句解析 GN[game name] - ゲーム名
Sub ParseGN
sID = "GN"
ParseProperty()
EndSub
'
' SGF字句解析 AP[application program name:version] - プログラム名
Sub ParseAP
sID = "AP"
ParseProperty()
EndSub
'
' SGF字句解析 TM[time] - 持ち時間
Sub ParseTime
sID = "TM"
ParseProperty()
EndSub
'
' SGF字句解析 T[time] - 消費時間 （SGFの仕様にない「CgfGoBan」オリジナル）
Sub ParseT
sID = "T"
ParseProperty()
EndSub
'
' SGF字句解析 KM[0.0] - コミ
Sub ParseKomi
sID = "KM"
ParseProperty()
EndSub
'
' SGF字句解析 C[comment] - コメント
Sub ParseComment
sID = "C"
ParseProperty()
EndSub
'
' SGF字句解析 RU[Japanese] - ルール
Sub ParseRule
sID = "RU"
ParseProperty()
EndSub
'
' SGF字句解析 PL[turn] - どちらの番からか
Sub ParsePlayer
sID = "PL"
ParseProperty()
EndSub
'
' SGF字句解析 HA[0] - handicap stones 置き石
Sub ParseHA
sID = "HA"
ParseProperty()
EndSub
'
' SGF字句解析 VW[range] - view 表示範囲
Sub ParseView
sID = "VW"
ParseProperty()
EndSub
'
' SGF字句解析 BS[0] - 黒の何か（SGFの仕様にない「お父さん」オリジナル）
Sub ParseBS
sID = "BS"
ParseProperty()
EndSub
'
' SGF字句解析 WS[4] - 白の何か（SGFの仕様にない「お父さん」オリジナル）
Sub ParseWS
sID = "WS"
ParseProperty()
EndSub
'
' 字句解析 ";" - セミコロン
Sub ParseSemicolon
cChar = ";"
ParseChar()
EndSub
'
' SGF字句解析 B[xy] - 黒の着手
Sub ParseBlack
cChar = "B"
ParseChar()
If bError = "False" Then
iColor = BLACK
ParsePoint()
iX = Text.GetIndexOf("abcdefghijklmnopqrst", cX)
iY = Text.GetIndexOf("abcdefghijklmnopqrst", cY)
If iX = 20 Then
bPass = "True"
Else
bPass = "False"
EndIf
Record()
EndIf
EndSub
'
' SGF字句解析 W[xy] - 白の着手
Sub ParseWhite
cChar = "W"
ParseChar()
If bError = "False" Then
iColor = WHITE
ParsePoint()
iX = Text.GetIndexOf("abcdefghijklmnopqrst", cX)
iY = Text.GetIndexOf("abcdefghijklmnopqrst", cY)
If iX = 20 Then
bPass = "True"
Else
bPass = "False"
EndIf
Record()
EndIf
EndSub
'
' SGF字句解析 E[xy] - erase 石を取り除く
' v0.6で不要になったが、しばらく残す
Sub ParseErase
cChar = "E"
ParseChar()
If bError = "False" Then
ParsePoint()
EndIf
EndSub
'
' SGF字句解析 [xy] - 位置
Sub ParsePoint
ParseBL()
ParseLower()
cX = c
ParseLower()
cY = c
ParseBR()
EndSub
'
' SGF字句解析 [text] - テキスト
Sub ParseText
sText = ""
ParseBL()
bError = "True"
While bError
ParseBR()
If bError Then
sText = sText + Text.GetSubText(sBuf, iBufPtr, 1)
iBufPtr = iBufPtr + 1
EndIf
EndWhile
EndSub
'
' SGF字句解析 ID[value] - property プロパティ
Sub ParseProperty
ParseID()
If bError Then
Goto lNotProperty
EndIf
ParseBL()
If bError Then
Goto lNotProperty
EndIf
bError = "True"
sValue = ""
While bError
ParseBR()
If bError Then
sValue = sValue + Text.GetSubText(sBuf,iBufPtr, 1)
iBufPtr = iBufPtr + 1
EndIf
EndWhile
lNotProperty:
EndSub
'
' SGF字句解析 ID
Sub ParseID
iPtrSaved = iBufPtr
For iPtr = 1 To Text.GetLength(sID)
cChar = Text.GetSubText(sID, iPtr, 1)
ParseChar()
If bError Then
iBufPtr = iPtrSaved
Goto lNotID
EndIf
EndFor
lNotID:
EndSub
'
' 字句解析 英大文字
Sub ParseUpper
c = Text.GetSubText(sBuf,iBufPtr, 1)
iCode = Text.GetCharacterCode(c)
If iCode >= UPPERA And iCode <= UPPERZ Then
bError = "False"
iBufPtr = iBufPtr + 1
Else
bError = "True"
EndIf
EndSub
'
' 字句解析 英小文字
Sub ParseLower
c = Text.GetSubText(sBuf,iBufPtr, 1)
iCode = Text.GetCharacterCode(c)
If iCode >= LOWERA And iCode <= LOWERZ Then
bError = "False"
iBufPtr = iBufPtr + 1
Else
bError = "True"
EndIf
EndSub
'
' 字句解析 数字
Sub ParseDigit
c = Text.GetSubText(sBuf,iBufPtr, 1)
iCode = Text.GetCharacterCode(c)
If iCode >= LETTER0 And iCode <= LETTER9 Then
bError = "False"
iBufPtr = iBufPtr + 1
Else
bError = "True"
EndIf
EndSub
'
' 字句解析 左かっこ
Sub ParsePL
cChar = "("
ParseChar()
EndSub
'
' 字句解析 右かっこ
Sub ParsePR
cChar = ")"
ParseChar()
EndSub
'
' 字句解析 左カギかっこ
Sub ParseBL
cChar = "["
ParseChar()
EndSub
'
' 字句解析 右カギかっこ
Sub ParseBR
cChar = "]"
ParseChar()
EndSub
'
' 字句解析 指定した文字
Sub ParseChar
c = Text.GetSubText(sBuf,iBufPtr, 1)
If c = cChar Then
bError = "False"
iBufPtr = iBufPtr + 1
Else
bError = "True"
EndIf
EndSub
'
' 字句解析 改行 (CR + LF)
Sub ParseNewLine
c = Text.GetSubText(sBuf,iBufPtr, 1)
i1 = Text.GetCharacterCode(c)
c = Text.GetSubText(sBuf,iBufPtr + 1, 1)
i2 = Text.GetCharacterCode(c)
If i1 = CR And i2 = LF Then
bError = "False"
iBufPtr = iBufPtr + 2
Else
bError = "True"
EndIf
EndSub
'
' ---------------------------------
' デバッグ関連
' ---------------------------------
Sub DumpPoint
TextWindow.Write("(" + iX + "," + iY + ")")
EndSub
'
Sub DumpNewLine
TextWindow.WriteLine("")
EndSub
'
' サブルーチン StartClock (時計を開始する)
Sub StartClock
iBeginTime = Clock.ElapsedMilliseconds
iEms = iBeginTime
TextWindow.Write("Start: ")
PrintClock()
EndSub
'
' サブルーチン StopClock (時計を終了する)
Sub StopClock
iEndTime = Clock.ElapsedMilliseconds
iEms = iEndTime
TextWindow.Write("Stop: ")
PrintClock()
EndSub
'
' サブルーチン PrintTime (時間を出力する)
Sub PrintTime
iEms = iEndtime - iBeginTime
TextWindow.Write("Time: ")
PrintClock()
EndSub
'
' サブルーチン PrintClock (時刻を出力する)
Sub PrintClock
ConvertEmsToTime()
TextWindow.WriteLine(iTime["Hour"] + ":" + iTime["Munite"] + ":" + iTime["Second"])
EndSub
'
' サブルーチン ConvertEmsToTime (Emsを時分秒に変換する)
Sub ConvertEmsToTime
iHMSMs = Math.Remainder(iEms, 24 * 60 * 60 * 1000)
iTime["Hour"] = Math.Floor(iHMSMs / (60 * 60 * 1000))
iMSMs = Math.Remainder(iHMSMs, 60 * 60 * 1000)
iTime["Munite"] = Math.Floor(iMSMs / (60 * 1000))
iSMs = Math.Remainder(iMSMs, 60 * 1000)
iTime["Second"] = Math.Floor(iSMs / 1000)
EndSub