Microsoft Small Basic

Program Listing: HHF931-3

List Program

' Igo07.smallbasic - 囲碁 Igo v0.7
'
' 履歴：
' 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行)
'
' 参考文献：
' [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.
'
' ---------------------------------
' メインプログラム
' ---------------------------------
' work: boolean bInProgram - プログラム実行中
' work: boolean bInGame - 対局中
' work: integer iMove - 手数
'
sVersion = "v0.7"
InitProgram() ' プログラムの初期化
InitBoard() ' 盤の初期化
InitControls() ' コントロール部の初期化
' プログラム終了が指定されるまで｛｝内繰り返し
While bInProgram
'｛
' 新規
ClearBoard() ' 盤面のクリア
ShowBoard() ' 盤の表示
lRetry:
InputGameInfo() ' 対戦者名（または棋譜名）の入力
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
' 再生または棋譜書き出し
' 対戦者名（または棋譜名）の入力
bInGame = "True"
While bInGame
InputGameEndInfo()
If　bReplay Then
ReplayGame() ' 棋譜の再生
ElseIf bSave Then
WriteRecord() ' 棋譜の保存
EndIf
EndWhile
' ｝
EndWhile
'
' それぞれの手番
' in: boolean bReplay - 再生
' in: integer iMove - 手数
' work: integer iET
' out: integer iPass - パス回数
' out: boolean bResign - 投了
' out: boolean bInGame - 対局中
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
' 着手可能な手を調べる
GetPossiblePuts()
If sPlayer[iColor] = "Random" Then
Random()
ElseIf sPlayer[iColor] = "CPU" Then
Territory()
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
' 盤の表示
If bPass = "False" Then
DrawStone()
Sound.PlayClickAndWait()
' 4方の石が囲まれたら取り除く
iCTurn = iColor
If iColor = BLACK Then
iColor = WHITE
ElseIf iColor = WHITE Then
iColor = BLACK
ElseIf iColor = SPACE Then
iColor = iCTurn
Goto lSkipRemove
EndIf
iXTurn = iX
iYTurn = iY
iRemoved = 0
bEnclosed = "True" ' 四方を囲われている
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
Shapes.SetText(oPrisoner[iCTurn], iPrisoner[iCTurn])
EndIf
EndIf
EndFor
iColor = iCTurn
iX = iXTurn
iY = iYTurn
If bEnclosed And iRemoved = 1 Then
iKo = iMove
iKX = iRX
iKY = iRY
EndIf
lSkipRemove:
EndIf
' 終局の判定
Judge()
EndIf
EndSub
'
' ---------------------------------
' プログラム関連
' ---------------------------------
' プログラムの初期化
' work: integer i
' out: constant SPACE, BLACK, WHITE, OB - 石の色
' out: constant UPPERA, UPPERZ, LOWERA, LOWERB - 文字コード
' out: constant LETTER0, LETTER9, CR, LF - 文字コード
' out: integer iRo - 何路か
' out: integer iPass - パス回数
' out: real rCX, rCY - 文字幅, 文字の高さ
' out: integer iMove - 手数
' out: string sBoardColor - 碁盤の色
' out: string sAlpha[] - SGF棋譜のためのアルファベット
' out: string sStone[] - 石の名前
' out: string sNew, sOpen, sPass - 文字列: 新規, 開く, パス
' out: string sReplay, sResign, sSave - 文字列: 再生, 投了, 保存
' out: boolean bInProgram - プログラム実行中
Sub InitProgram
SPACE = 0 ' 空点
BLACK = 1 ' 黒
WHITE = 2 ' 白
OB = 3 ' 盤外
BANDW = 4 ' 黒と白（CorrectSpaceUnit()で使用）
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 ' ラインフィード（行送り）の文字コード
iRo = 6
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() ' 四方の座標の初期化
EndSub
'
' コントロール部の初期化
' in: real rCX, rCY - 文字幅, 文字の高さ
' in: integer idLX, idLY - 線の間隔
' in: integer iSR - 碁石の半径
' in: integer iBX0, iBY0, iBX1, iBY1 - 盤の左端, 上端, 右端, 下端
' in: string sNew, sReplay, sPass, sResign - ボタン用テキスト
' work: integer iBHX, iBHY - 黒アゲハマ表示位置
' work: integer iWHX, iWHX - 白アゲハマ表示位置
' out: object oBlack - 黒プレイヤー名のテキストボックス
' out: object oWhite - 白プレイヤー名のテキストボックス
' out: object oPass, oResign - ［パス］［投了］ボタン
' out: object oSave, oReplay - ［保存］［再生］ボタン
' out: object oPrisoner[] - アゲハマ表示用テキスト
' out: object oSGF - SGF棋譜ファイル名のテキストボックス
' out: integer iBLX, iBLY - 黒番を示すランプの位置
' out: integer iWLX, iWLY - 白番を示すランプの位置
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] = "CPU"
oBlack = Controls.AddTextBox(iBX1 + rCX, iBY0)
Controls.SetTextBoxText(oBlack, sPlayer[BLACK])
oWhite = Controls.AddTextBox(iBX1 + rCX, iBY0 + idLY * iRo / 2)
sPlayer[WHITE] = "Human"
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
'
' ランプの表示
' in: integer iX, iY - ランプの表示位置
' in: boolean bOn - ランプON
Sub DrawLamp
sSavedColor = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(iX + 2, iY + 2, 20, 6)
GraphicsWindow.BrushColor = "DimGray"
GraphicsWindow.FillRectangle(iX - 2, iY - 2, 20, 6)
If bOn Then
GraphicsWindow.BrushColor = "Lime"
Else
GraphicsWindow.BrushColor = "Black"
EndIf
GraphicsWindow.FillRectangle(iX, iY, 20, 6)
GraphicsWindow.BrushColor = sSavedColor
EndSub
'
' ---------------------------------
' ゲーム関連
' ---------------------------------
' 新規モード - 対戦者名（または棋譜名）の入力
' out: boolean bShowMove - 手数を表示する
' out: boolean bInGame - 対局中
' out: boolean bReplay - 再生モード
' work: boolean bNotClicked
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イベント処理
' out: string sPlayer[BLACK] - 黒プレイヤー名
' out: string sPlayer[WHITE] - 白プレイヤー名
' out: string sSGF - SGFファイル名
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
'
' 新規モードのボタンイベント処理
' out: boolean bNotClicked
' out: boolean bOpen
Sub OnButtonClicked1
If Controls.LastClickedButton = oNewGame Then
bNotClicked = "False"
bOpen = "False"
ElseIf Controls.LastClickedButton = oOpen Then
bNotClicked = "False"
bOpen = "True"
EndIf
EndSub
'
' 終了モード - 再生, 保存または新規ボタンの入力
' out: boolean bShowMove - 手数を表示する
' out: boolean bInGame - 対局中
' out: boolean bReplay - 再生モード
' out: boolean bSave - 保存
' out: boolean bResign - 投了
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
'
' 終了モードのボタンイベント処理
' out: boolean bInGame - 対局中
' out: boolean bReplay - 再生モード
' out: boolean bSave - 保存
' out: boolean bNotClicked
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
Sound.PlayChimeAndWait()
EndIf
EndIf
EndSub
'
' 連を取り除く
' in: integer iUnit, iXU[], iYU[] - 連
' work: integer i, iX, iY
' out: iBoard[][] - 碁盤
Sub RemoveUnit
For i = 1 To iUnit
iX = iXU[i]
iY = iYU[i]
iBoard[iX][iY] = SPACE
EraseStone()
EndFor
EndSub
'
' 活路を数える準備
' out: integer iLiberty - 活路の数
' out: integer iCheck[][] - チェック
' out: integer iUnit - 連の数
' work: integer iXL, iYL
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
'
' 連の活路を数える
' in: integer iBoard[][] - 碁盤
' in: integer iColor - 連の起点の石
' in/out: integer iX, iY - 連の起点
' in/out: integer iLiberty - 活路の数
' work: integer iXSave, iYSave, i
' out: integer iXU[], iYU[] - 連
' out: integer iUnit - 連の数
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
'
' 空点の連を調べる
' in: integer iTerritory[][] - 地
' in/out: integer iX, iY - 連の起点
' in/out: integer iColor - 囲んでいる石の色
' work: integer iXSave, iYSave
' out: integer iXU[], iYU[] - 連
' out: integer iUnit - 連の数
Sub CorrectSpaceUnit
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]
CorrectSpaceUnit()
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
'
' 終局の判定
' in: integer iPass - パスの数
' out: boolean bInGame - 対局中
' out: string sScore - 結果
Sub Judge
bInGame = "True"
If iPass >= 2 Then
bInGame = "False"
CountScore() ' 勝敗の判定
AdjustTerritory() ' 地の調整
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
EndSub
'
' 勝敗の判定
' in: iPrisoner[] - アゲハマの数
' work: integer iBlackScore, iWhiteScore - 地の数
' out: integer iTerritory[][] - 地
' out: integer iScore - 黒石－白石を返す
Sub CountScore
EvalBoard() ' 地の認識
iBlackScore = iBlackScore + iPrisoner[BLACK] ' アゲハマを加える
iWhiteScore = iWhiteScore + iPrisoner[WHITE] ' アゲハマを加える
iBlackScore = iBlackScore + iDead[WHITE] ' 死に石を加える
iWhiteScore = iWhiteScore + iDead[BLACK] ' 死に石を加える
iScore = iBlackScore - iWhiteScore
EndSub
'
' 地の調整
' in/out: integer iTerritory[][] - 地
' in/out: integer iBlackScore, iWhiteScore - 地の数
' out: integer iScore - 黒石－白石を返す
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
CorrectSpaceUnit()
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
'
' 盤面の評価
' work: iX, iY, i
' work: integer iBlackEffect[][] - 黒の影響範囲
' work: integer iWhiteEffect[][] - 白の影響範囲
' out: integer iDead[], iDeadSum - 死に石の数
' out: boolean iDX[], iDY[] - 死に石
' out: integer iTerritory[][] - 地
' out: integer iBlackScore - 黒の地
' out: integer iWhiteScore - 白の地
Sub EvalBoard
iCSave = iColor
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 の連を地iTerritory[][]から消す
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()
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
'
' 四方の座標差分
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
'
' 盤の初期化
' in: integer iRo - 何路か
' in: real rCX - 文字幅
' in: real rCY - 文字の高さ
' work: integer i, iX, iY
' out: integer iBoard[][] - 碁盤
' out: integer idLX, idLY - 線の間隔
' out: integer iSR - 碁石の半径
' out: integer iLX0, iLY0, iLX1, iLY1 - 左端, 上端, 右端, 下端の線
' out: integer iBX0, iBY0, iBX1, iBY1 - 盤の左端, 上端, 右端, 下端
' out: integer iPrisoner[] - アゲハマ
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
'
' 盤面のクリア
' in: integer iRo - 何路か
' work: integer i, iX, iY
' out: integer iBoard[][] - 碁盤
' out: integer iPrisoner[] - アゲハマ
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
'
' 盤の表示
' in: integer idLX, idLY - 線の間隔
' in: integer iSR - 碁石の半径
' in: integer iLX0, iLY0, iLX1, iLY1 - 左端, 上端, 右端, 下端の線
' in: integer iBX0, iBY0, iBX1, iBY1 - 盤の左端, 上端, 右端, 下端
' work: integer iX, iY
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
'
' 碁石を描く
' in: integer iX, iY - 碁石の座標
' in: integer iColor - 碁石の色
' in: boolean bShowMove - 手数を表示する
' in: integer iMove - 手数
' in: integer iLX0 - 左端の縦線のX座標
' in: integer iLY0 - 上端の横線のY座標
' in: integer idLX - 縦線の間隔
' in: integer idLY - 横線の間隔
' in: integer iSR - 碁石の半径
' work: integer iNX, iNY - 手数の座標
' work: integer iND - 手数の桁数
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
'
' 碁石を消す
' in: integer iX, iY - 碁石の座標
' work: integer iEX0, iEY0, iEX1, iEY1 - 書きなおす線の座標
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
'
' 碁石に×を付ける
' in: integer iX, iY - 碁石の座標
' work: integer i, iPW, string sPC
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
'
' 地に四角を描く
' work: integer iX, iY - 碁石の座標
' in: integer iBoard[][] - 碁盤
' in: integer iTerritory[][] - 地
' in: integer iLX0 - 左端の縦線のX座標
' in: integer iLY0 - 上端の横線のY座標
' in: integer idLX - 縦線の間隔
' in: integer idLY - 横線の間隔
' in: integer iSR - 碁石の半径
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
'
' ---------------------------------
' 思考ルーチン関連
' ---------------------------------
' 着手可能な手のリスト作成
' in: integer iboard[][] - 碁盤
' in: integer iMove - 手数
' in: integer iKo, iKX, iKY - コウの発生した手数と座標
' out: integer iPossible - 着手可能な手の数
' out: integer iPX[], iPX[] - 着手可能な手
' work: integer iX, iY - iBoard[][]の座標 x, y
' work: integer iColor - 石の色
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
iPossible = iPossible + 1
iPX[iPossible] = iX
iPY[iPossible] = iY
lNotPossible:
EndFor ' iX
EndFor ' iY
EndSub
'
' 自殺手のチェック
' in: integer iColor - 石の色
' in: integer iX, iY - 調べる点
' work: integer iXSave, iYSave, iCSave
' out: boolean bSuiside - 自殺手
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 (コンピューター)
' in: integer iPossible, iPX[], iPY[] - 着手可能な手
' in: integer iMove - 手数
' work: i - 着手可能な手の添字
' out: integer iX, iY - 次の手(碁盤の座標)
' out: integer iColor - 碁石の色
' out: integer iBoard[][] - 碁盤
' out: boolean bPass - パス
' out: boolean bResign - 投了
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 (コンピューター)
' in: integer iPossible, iPX[], iPY[] - 着手可能な手
' in: integer iMove - 手数
' work: iP - 着手可能な手の添字
' work: iMax
' out: integer iX, iY - 次の手(碁盤の座標)
' out: integer iColor - 碁石の色
' out: integer iBoard[][] - 碁盤
' out: boolean bPass - パス
' out: boolean bResign - 投了
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
'
' 次の手を打つ - Human (人)
' in: integer iPossible, iPX[], iPY[] - 着手可能な手
' in: integer iMove - 手数
' work: i - 着手可能な手の添字
' work: integer iMX, iMY - マウス座標
' work: boolean bNotClicked - マウスがクリックされていない
' out: integer iX, iY - 次の手(碁盤の座標)
' out: integer iColor - 碁石の色
' out: integer iBoard[][] - 碁盤
' out: boolean bPass - パス
' out: boolean bResign - 投了
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
Sound.PlayChimeAndWait()
EndWhile
lPossiblePut:
iColor = Math.Remainder((iMove - 1), 2) + 1
If bPass = "False" And bResign = "False" Then
iBoard[iX][iY] = iColor
EndIf
EndSub
'
' マウスが押されたときの処理
' out: integer iMX, iMY - マウス座標
' out: boolean bNotClicked - マウスがクリックされていない
Sub OnMouseDown
iMX = GraphicsWindow.MouseX
iMY = GraphicsWindow.MouseY
bNotClicked = "False"
EndSub
'
' マウスが押されたときの処理
' out: integer iMX, iMY - マウス座標
' out: boolean bNotClicked - マウスがクリックされていない
Sub OnButtonClicked
If Controls.LastClickedButton = oResign Then
bResign = "True"
bNotClicked = "False"
ElseIf Controls.LastClickedButton = oPass Then
bPass = "True"
bNotClicked = "False"
EndIf
EndSub
'
' マウスをクリックした座標から碁盤の座標を得る
' in: integer iMX, iMY - マウス座標
' out: integer iX, iY - 碁盤の座標
' out: boolean bOutOfBoard - 盤外でのクリックか
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 (棋譜の再生)
' in: integer iMove - 手番
' in: integer iRecord - 棋譜
' in: integer iNumRec - 棋譜の手数
' out: integer iX, iY - 次の手(碁盤の座標)
' out: integer iColor - 碁石の色
' out: integer iBoard[][] - 碁盤
' out: boolean bPass - パス
' out: boolean bResign - 投了
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
'
' ---------------------------------
' 棋譜ファイル関連
' ---------------------------------
' 棋譜の初期化
' out: integer iNumRec - 棋譜の手数
Sub InitRecord
iNumRec = 0
EndSub
'
' 棋譜の記録
' in: integer iX, iY - 次の手(碁盤の座標)
' in: integer iColor - 碁石の色
' in: boolean bPass - パス
' out: integer iRecord[][] - 棋譜
' out: integer iNumRec - 棋譜の手数
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
'
' 棋譜ファイルの書き出し（保存）
' in: integer iNumRec - 棋譜の手数
' in: integer iRecord[][] - 棋譜
' work: integer i, iX, iY, iColor
Sub WriteRecord
' 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
' The following line could be harmful and has been automatically commented.
' File.WriteLine(sSGF, iSGFLine, "(;GM[1]FF[1]SZ[" + iRo + "]PB[" + sPlayer[BLACK] + "]PW[" + sPlayer[WHITE] + "]RE[" + sScore + "]")
iSGFLine = 2
' The following line could be harmful and has been automatically commented.
' File.WriteLine(sSGF, iSGFLine, "DT[" + sDate + "]KM[0.0]RU[Japanese]")
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
' The following line could be harmful and has been automatically commented.
' File.WriteLine(sSGF, iSGFLine, sLine)
iSGFLine = iSGFLine + 1
sLine = ""
EndIf
EndFor
' The following line could be harmful and has been automatically commented.
' File.WriteLine(sSGF, iSGFLine, sLine + ")")
iSGFLine = iSGFLine + 1
sLine = ""
EndIf
EndSub
'
' 棋譜ファイルの読み込み（開く）
' work: string sBuf
' out: integer iNumRec - 棋譜の手数
' out: integer iRecord[][] - 棋譜
' our: boolean bError - 読み込みエラー
Sub ReadRecord
InitRecord()
' 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
'
' 棋譜出力用の日付を保存
' out: string sDate - SGF棋譜用日付
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] - 消費時間
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] - 位置
' out: character cX, cY
Sub ParsePoint
ParseBL()
ParseLower()
cX = c
ParseLower()
cY = c
ParseBR()
EndSub
'
' SGF字句解析 [text] - テキスト
' in: sBuf - バッファ
' in/out: iBufPtr - バッファポインター
' out: string sText
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 プロパティ
' in: string sID
' out: string sValue
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
' in: string sID
' work: integer iPtr
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
'
' 字句解析 英大文字
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: character c - 英大文字
' out: boolean bError - 字句解析エラー
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
'
' 字句解析 英小文字
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: character c - 英小文字
' out: boolean bError - 字句解析エラー
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
'
' 字句解析 数字
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: character c - 数字
' out: boolean bError - 字句解析エラー
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
'
' 字句解析 左かっこ
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: boolean bError - 字句解析エラー
Sub ParsePL
cChar = "("
ParseChar()
EndSub
'
' 字句解析 右かっこ
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: boolean bError - 字句解析エラー
Sub ParsePR
cChar = ")"
ParseChar()
EndSub
'
' 字句解析 左カギかっこ
' Parse Bracket Left
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: boolean bError - 字句解析エラー
Sub ParseBL
cChar = "["
ParseChar()
EndSub
'
' 字句解析 右カギかっこ
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' out: boolean bError - 字句解析エラー
Sub ParseBR
cChar = "]"
ParseChar()
EndSub
'
' 字句解析 指定した文字
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' in: character cChar - 字句解析する文字
' out: boolean bError - 字句解析エラー
Sub ParseChar
c = Text.GetSubText(sBuf,iBufPtr, 1)
If c = cChar Then
bError = "False"
iBufPtr = iBufPtr + 1
Else
bError = "True"
EndIf
EndSub
'
' 字句解析 改行 (CR + LF)
' in: string sBuf - バッファ
' in/out: integer iBufPtr - バッファポインター
' work: integer c, i1, i2
' out: boolean bError - 字句解析エラー
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