Microsoft Small Basic

Program Listing: HHF931-2

List Program

' Igo06.smallbasic - 囲碁 Igo v0.6
'
' 履歴：
' 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行)
'
' 参考文献：
' [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 - 手数
' work: boolean bDebug - デバッグ中
'
sVersion = "v0.6"
bDebug = "False"
If bDebug Then
DrawGrid() ' 画面設計用格子の表示
EndIf
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 - 手数
' out: integer iPass - パス回数
' out: boolean bResign - 投了
' out: boolean bInGame - 対局中
Sub EachTurn
iMove = iMove + 1
If (Math.Remainder(iMove, 2) = 1) 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()
Human()
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
Goto lSkipRemove
EndIf
iXTurn = iX
iYTurn = iY
iX = iXTurn + 1
iY = iYTurn
InitLiberty()
CountLiberty()
If iLiberty = 0 Then
RemoveString()
iPrisoner[iCTurn] = iPrisoner[iCTurn] + iString
Shapes.SetText(oPrisoner[iCTurn], iPrisoner[iCTurn])
EndIf
iX = iXTurn
iY = iYTurn + 1
InitLiberty()
CountLiberty()
If iLiberty = 0 Then
RemoveString()
iPrisoner[iCTurn] = iPrisoner[iCTurn] + iString
Shapes.SetText(oPrisoner[iCTurn], iPrisoner[iCTurn])
EndIf
iX = iXTurn - 1
iY = iYTurn
InitLiberty()
CountLiberty()
If iLiberty = 0 Then
RemoveString()
iPrisoner[iCTurn] = iPrisoner[iCTurn] + iString
Shapes.SetText(oPrisoner[iCTurn], iPrisoner[iCTurn])
EndIf
iX = iXTurn
iY = iYTurn - 1
InitLiberty()
CountLiberty()
If iLiberty = 0 Then
RemoveString()
iPrisoner[iCTurn] = iPrisoner[iCTurn] + iString
Shapes.SetText(oPrisoner[iCTurn], iPrisoner[iCTurn])
EndIf
iColor = iCTurn
iX = iXTurn
iY = iYTurn
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 ' 盤外
UPPERA = Text.GetCharacterCode("A") ' Aの文字コード
UPPERZ = Text.GetCharacterCode("Z") ' Zの文字コード
LOWERA = Text.GetCharacterCode("a") ' aの文字コード
LOWERZ = Text.GetCharacterCode("z") ' zの文字コード
LETTER0 = 48 ' 0の文字コード
LETTER9 = 57 ' 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 = "開く"
sSave = "=" ' Windings 保存マーク
sNew = "新規"
sReplay = "4" ' Windings 再生マーク
sPause = ";" ' Windings ポーズマーク
sPass = "パス"
sResign = "投了"
GraphicsWindow.Title = "Igo " + sVersion
bInProgram = "True"
EndSub
'
' コントロール部の初期化
' in: real rCX - 文字幅
' in: real 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 - ［パス］ボタン
' out: object oPrisoner[] - アゲハマ表示用テキスト
' out: object oSGF - SGF棋譜ファイル名のテキストボックス
' out: iBLX, iBLY - 黒番を示すランプの位置
' out: 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()
sBlack = "Human"
oBlack = Controls.AddTextBox(iBX1 + rCX, iBY0)
Controls.SetTextBoxText(oBlack, sBlack)
oWhite = Controls.AddTextBox(iBX1 + rCX, iBY0 + idLY * iRo / 2)
sWhite = "Human"
Controls.SetTextBoxText(oWhite, sWhite)
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 - 再生モード
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 sBlack - 黒プレイヤー名
' out: string sWhite - 白プレイヤー名
' out: string sSGF - SGFファイル名
Sub OnTextTyped
If Controls.LastTypedTextBox = oBlack Then
sBlack = Controls.GetTextBoxText(oBlack)
ElseIf Controls.LastTypedTextBox = oWhite Then
sWhite = 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
'
' 終了モード - 再生, 保存または新規ボタンの入力
' out: boolean bShowMove - 手数を表示する
' out: boolean bInGame - 対局中
' out: boolean bReplay - 再生モード
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
Sound.PlayBellRingAndWait()
EndIf
EndIf
EndSub
'
' 連を取り除く
' in: integer iString, iXS[], iYS[] - 連
' work: integer i, iX, iY
' out: iBoard[][] - 碁盤
Sub RemoveString
For i = 1 To iString
iX = iXS[i]
iY = iYS[i]
iBoard[iX][iY] = SPACE
EraseStone()
EndFor
EndSub
'
' 呼吸点を数える準備
' out: integer iLiberty - 呼吸点の数
' out: integer iCheck[][] - チェック
' out: integer iString - 連の数
' work: integer iXL, iYL
Sub InitLiberty
For iXL = 1 To iRo
For iYL = 1 To iRo
bNotChecked[iXL][iYL] = "TRUE"
EndFor
EndFor
iLiberty = 0
iString = 0
EndSub
'
' 連の呼吸点を数える
' in: integer iX, iY, iColor - 連の起点
' in/out: integer iLiberty - 呼吸点の数
' work: integer iXSave, iYSave
' out: integer iXS[], iYS[] - 連
' out: integer iString - 連の数
Sub CountLiberty
Stack.PushValue("liberty", iXSave)
Stack.PushValue("liberty", iYSave)
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
iString = iString + 1
iXS[iString] = iX
iYS[iString] = iY
iX = iXSave + 1
iY = iYSave
CountLiberty()
iX = iXSave
iY = iYSave + 1
CountLiberty()
iX = iXSave - 1
iY = iYSave
CountLiberty()
iX = iXSave
iY = iYSave - 1
CountLiberty()
EndIf
EndIf
iYSave = Stack.PopValue("liberty")
iXSave = Stack.PopValue("liberty")
EndSub
'
' 終局の判定
' in: integer iPass - パスの数
' out: boolean bInGame - 対局中
' out: string sScore - 結果
Sub Judge
bInGame = "True"
If iPass >= 2 Then
bInGame = "False"
CountScore()
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 iScore - 黒石－白石を返す
Sub CountScore
iBlackScore = 0 ' 本来は地を数える
iWhiteScore = 0 ' 本来は地を数える
iBlackScore = iBlackScore + iPrisoner[BLACK] ' アゲハマを加える
iWhiteScore = iWhiteScore + iPrisoner[WHITE] ' アゲハマを加える
iScore = iBlackScore - iWhiteScore
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
'
' ---------------------------------
' 棋譜ファイル関連
' ---------------------------------
' 棋譜の初期化
' 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 + "'はすでに存在します。", "保存")
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[" + sBlack + "]PW[" + sWhite + "]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 + "'は存在しません。", "開く")
bError = "True"
Else
ParsePL() ' (
ParseSemicolon() ' ;
ParseGame() ' GM[1]
ParseFF() ' FF[1]
ParseSize() ' SZ[6]
ParsePB() ' PB[黒のプレイヤー名]
ParsePW() ' PW[白のプレイヤー名]
ParseRE() ' RE[結果]
ParseNewLine() ' 改行
ParseDate() ' DT[yyyy-mm-dd]
ParseKomi() ' KM[0.0]
ParseRule() ' RU[Japanese]
ParseNewLine() ' 改行
bError = "True"
While bError
ParsePR() ' )
If bError Then
ParseSemicolon() ' ;
ParseBlack() ' B[xy]
ParseWhite() ' W[xy]
ParseErase() ' E[xy]
ParseNewLine() ' 改行
bError = "True"
EndIf
EndWhile
bError = "False"
EndIf
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
ParseProperty()
EndSub
'
' SGF字句解析 FF[1] - file format ファイルフォーマット
Sub ParseFF
ParseProperty()
EndSub
'
' SGF字句解析 SZ[6] - size サイズ
Sub ParseSize
ParseProperty()
EndSub
'
' SGF字句解析 PB[黒のプレイヤー名]
Sub ParsePB
cChar = "P"
ParseChar()
cChar = "B"
ParseChar()
ParseText()
sBlack = sText
Controls.SetTextBoxText(oBlack, sBlack)
EndSub
'
' SGF字句解析 PW[白のプレイヤー名]
Sub ParsePW
cChar = "P"
ParseChar()
cChar = "W"
ParseChar()
ParseText()
sWhite = sText
Controls.SetTextBoxText(oWhite, sWhite)
EndSub
'
' SGF字句解析 RE[1] - result 結果
Sub ParseRE
ParseProperty()
EndSub
'
' SGF字句解析 DT[yyyy-mm-dd] - date 日付
Sub ParseDate
ParseProperty()
EndSub
'
' SGF字句解析 KM[0.0] - コミ
Sub ParseKomi
ParseProperty()
EndSub
'
' SGF字句解析 RU[Japanese] - ルール
Sub ParseRule
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
iPtrSaved = iBufPtr
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
iPtrSaved = iBufPtr
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 プロパティ
Sub ParseProperty
ParseUpper()
If bError Then
Goto lNotProperty
EndIf
ParseUpper()
If bError Then
Goto lNotProperty
EndIf
ParseBL()
If bError Then
Goto lNotProperty
EndIf
bError = "True"
While bError
ParseBR()
If bError Then
iBufPtr = iBufPtr + 1
EndIf
EndWhile
lNotProperty:
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
'
' ---------------------------------
' 思考ルーチン関連
' ---------------------------------
' 着手可能な手のリスト作成
' in: integer iboard[][] - 碁盤
' out: integer iPossible - 着手可能な手の数
' out: integer iPX[], iPX[] - 着手可能な手
' work: integer i - iBoard[][]の座標 x, yの代わり
Sub GetPossiblePuts
iPossible = 0
For i = 0 To iRo * iRo - 1
If iBoard[Math.Remainder(i, iRo) + 1][Math.Floor(i / iRo) + 1] = SPACE Then
iPossible = iPossible + 1
iPX[iPossible] = Math.Remainder(i, iRo) + 1
iPY[iPossible] = Math.Floor(i / iRo) + 1
EndIf
EndFor
EndSub
'
' 次の手を打つ - Human (人)
' in: integer iPossible - 着手可能な手
' in: integer iMove - 手数
' work: i - 着手可能な手の添字
' work: integer iMX, iMY - マウス座標
' work: boolean bNotClicked - マウスがクリックされていない
' out: integer iX, iY - 次の手(碁盤の座標)
' out: integer iColor - 碁石の色
' out: integer iBoard[][] - 碁盤
' out: integer iPrisoner[] - アゲハマ
' out: boolean bPass - パス
' out: boolean bResign - 投了
Sub Human
bPass = "False"
bResign = "False"
GraphicsWindow.MouseDown = OnMouseDown
Controls.ButtonClicked = OnButtonClicked
While "True"
bNotClicked = "True"
While bNotClicked
Program.Delay(200)
EndWhile
If bPass Or bResign Then
Goto lPossiblePut
EndIf
GetPosition()
For i = 1 To iPossible
If iPX[i] = iX And iPY[i] = iY Then
Goto lPossiblePut
EndIf
EndFor
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 - 碁盤の座標
Sub GetPosition
iX = Math.Floor((iMX - iLX0 + idLX / 2) / idLX) + 1
iY = Math.Floor((iMY - iLY0 + idLY / 2) / idLY) + 1
If iX < 1 Then
iX = 1
EndIf
If iY < 1 Then
iY = 1
EndIf
If iX > iRo Then
iX = iRo
EndIf
If iY > iRo Then
iY = iRo
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
'
' ---------------------------------
' デバッグ関連
' ---------------------------------
' 画面設計用の格子の表示
Sub DrawGrid
cx = 15.6 ' 43 chars / line
cy = 24 ' 18 lines / 443 height
GraphicsWindow.FontSize = cy
GraphicsWindow.FontName = "Courier New"
GraphicsWindow.BrushColor = "SlateBlue"
GraphicsWindow.PenColor = "Cyan"
GraphicsWindow.Clear()
x = 0
y = 0
text = "----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8"
GraphicsWindow.DrawText(x, y - 3, text)
For i = 0 To 19
text = i
GraphicsWindow.DrawText(x, y - 3, text)
y = y + cy
EndFor
w = GraphicsWindow.Width
h = GraphicsWindow.Height
text = w + "," + h + " "
GraphicsWindow.DrawText(x + cx * 4, cy * 17 - 3, text)
For i = 0 To 624 Step cx
GraphicsWindow.DrawLine(i, 0, i, 443)
EndFor
For i = 0 To 443 Step cy
GraphicsWindow.DrawLine(0, i, 624, i)
EndFor
EndSub
'
Sub PrintRecord
For i = 1 To iNumRec
TextWindow.WriteLine(sStone[iRecord[i]["turn"]] + "(" + iRecord[i]["x"] + "," + iRecord[i]["y"] + ")")
EndFor
EndSub
'
Sub PrintString
For i = 1 To iString
TextWindow.WriteLine("(" + iXS[i]+ "," + iYS[i] + ")")
EndFor
EndSub