Microsoft Small Basic

Program Listing:
Embed this in your website
' 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
Copyright (c) Microsoft Corporation. All rights reserved.