Imports System
Imports System.Collections.Generic
Imports System.Text

Module HexPawn

    ''' <summary>
    ''' 盤のマス等、白、黒、その他を表す
    ''' </summary>
    ''' <remarks></remarks>
    Enum HexPawnDefs As Byte
        None    ' 盤外、未定を表す
        Black   ' 黒を表す
        White   ' 白を表す
        Empty   ' 空き
    End Enum

    ''' <summary>
    ''' 盤のマスを示すクラス
    ''' </summary>
    ''' <remarks></remarks>
    Class HpPoint
        Public Property file As Integer     ' 左を0とした横方向
        Public Property rank As Integer     ' 下を0とした縦方向

        ''' <summary>
        ''' コンストラクタ
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()
            file = -1
            rank = -1
        End Sub

        ''' <summary>
        ''' コンストラクタ
        ''' </summary>
        ''' <param name="f">ファイル（横）</param>
        ''' <param name="r">ランク（縦）</param>
        ''' <remarks></remarks>
        Public Sub New(f As Integer, r As Integer)
            file = f
            rank = r
        End Sub

        ''' <summary>
        ''' 左右反対のHpPointを取得する
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function Mirror() As HpPoint
            Dim PtMirror As New HpPoint(Me.file, Me.rank)

            If PtMirror.file = 0 Then
                PtMirror.file = 2
            ElseIf PtMirror.file = 2 Then
                PtMirror.file = 0
            End If

            Return PtMirror
        End Function

        ''' <summary>
        ''' HpPointを文字列にする
        ''' </summary>
        ''' <returns>"a1","b3"のような文字列</returns>
        ''' <remarks></remarks>
        Public Overrides Function ToString() As String
            Dim s As String = ""

            s += ChrW(Asc("a"c) + Me.file)  ' 左から a,b,c
            s += ChrW(Asc("1"c) + Me.rank)  ' 下から 1,2,3
            Return s
        End Function
    End Class

    ''' <summary>
    ''' 盤の状態を表すクラス
    ''' </summary>
    ''' <remarks></remarks>
    Class HpBoard
        Protected Shared BOARD_SIZE As Integer = 3  ' 盤の大きさ
        Protected Squares As HexPawnDefs(,) = New HexPawnDefs(BOARD_SIZE - 1, BOARD_SIZE - 1) {}    ' 盤のマス

        ''' <summary>
        ''' コンストラクタ
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()
            ' 盤の初期状態を作成する
            For file As Integer = 0 To BOARD_SIZE - 1
                SetSquare(New HpPoint(file, 2), HexPawnDefs.Black)  ' 黒のポーン
                SetSquare(New HpPoint(file, 1), HexPawnDefs.Empty)  ' 空き
                SetSquare(New HpPoint(file, 0), HexPawnDefs.White)  ' 白のポーン
            Next
        End Sub

        ''' <summary>
        ''' すべてのマスの位置を取得する
        ''' </summary>
        ''' <returns>HpPointの配列</returns>
        ''' <remarks></remarks>
        Public Shared Function GetAllPoints() As HpPoint()
            Dim list As New List(Of HpPoint)()

            For rank As Integer = 0 To BOARD_SIZE - 1
                For file As Integer = 0 To BOARD_SIZE - 1
                    list.Add(New HpPoint(file, rank))
                Next
            Next

            Return list.ToArray()
        End Function

        ''' <summary>
        ''' 指定されたマスの状態を取得する
        ''' </summary>
        ''' <param name="pt">マスの位置</param>
        ''' <returns>マスの状態</returns>
        ''' <remarks></remarks>
        Public Function GetSquare(pt As HpPoint) As HexPawnDefs
            Return GetSquare(pt.file, pt.rank)
        End Function

        ''' <summary>
        ''' 指定されたマスの状態を取得する
        ''' </summary>
        ''' <param name="file">横方向の位置</param>
        ''' <param name="rank">縦方向の位置</param>
        ''' <returns>マスの状態</returns>
        ''' <remarks></remarks>
        Public Function GetSquare(file As Integer, rank As Integer) As HexPawnDefs
            If 0 <= file AndAlso file < BOARD_SIZE AndAlso 0 <= rank AndAlso rank < BOARD_SIZE Then
                Return Squares(file, rank)
            Else
                Return HexPawnDefs.None
            End If
        End Function

        ''' <summary>
        ''' 指定されたマスの状態を設定する
        ''' </summary>
        ''' <param name="pt">マスの位置</param>
        ''' <param name="pawn">マスの状態</param>
        ''' <remarks></remarks>
        Public Sub SetSquare(pt As HpPoint, pawn As HexPawnDefs)
            SetSquare(pt.file, pt.rank, pawn)
        End Sub

        ''' <summary>
        ''' 指定されたマスの状態を設定する
        ''' </summary>
        ''' <param name="file">横方向の位置</param>
        ''' <param name="rank">縦方向の位置</param>
        ''' <param name="pawn">マスの状態</param>
        ''' <remarks></remarks>
        Public Sub SetSquare(file As Integer, rank As Integer, pawn As HexPawnDefs)
            If 0 <= file AndAlso file < BOARD_SIZE AndAlso 0 <= rank AndAlso rank < BOARD_SIZE Then
                Squares(file, rank) = pawn
            End If
        End Sub

        ''' <summary>
        ''' 盤の状態を表示する
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Show()
            Console.WriteLine("")

            For rank As Integer = BOARD_SIZE - 1 To 0 Step -1
                Console.Write(vbLf & "   +---+---+---+")
                Console.Write(vbLf & " " & (rank + 1) & " |")

                For file As Integer = 0 To BOARD_SIZE - 1
                    If GetSquare(New HpPoint(file, rank)) = HexPawnDefs.Black Then
                        Console.Write(" ○|")
                    ElseIf GetSquare(New HpPoint(file, rank)) = HexPawnDefs.White Then
                        Console.Write(" ●|")
                    ElseIf (rank Mod 2) = (file Mod 2) Then
                        Console.Write(":::|")
                    Else
                        Console.Write("   |")
                    End If
                Next

                If rank = 2 Then
                    Console.Write("      7  8  9")
                ElseIf rank = 1 Then
                    Console.Write("      4  5  6")
                ElseIf rank = 0 Then
                    Console.Write("      1  2  3")
                End If
            Next

            Console.Write(vbLf & "   +---+---+---+")
            Console.Write(vbLf & "     a   b   c" & vbLf)
        End Sub

        ''' <summary>
        ''' 指定された位置のポーンが動けるかどうか
        ''' </summary>
        ''' <param name="pt">調べるマス</param>
        ''' <returns>true:動ける、false:動けない</returns>
        ''' <remarks></remarks>
        Public Function IsMoveablePawn(pt As HpPoint) As Boolean
            Dim dir As Integer
            ' 進む方向
            Dim opp As HexPawnDefs
            ' 対戦相手の駒
            If GetSquare(pt) = HexPawnDefs.White Then
                dir = 1
                opp = HexPawnDefs.Black
            ElseIf GetSquare(pt) = HexPawnDefs.Black Then
                dir = -1
                opp = HexPawnDefs.White
            Else
                Return False
            End If

            If GetSquare(pt.file, pt.rank + dir) = HexPawnDefs.Empty Then
                Return True
                ' １マス前が空
            ElseIf GetSquare(pt.file - 1, pt.rank + dir) = opp Then
                Return True
                ' 斜め前に相手の駒がある
            ElseIf GetSquare(pt.file + 1, pt.rank + dir) = opp Then
                Return True
            Else
                ' 反対の斜め前に相手の駒がある
                Return False
            End If
        End Function

        ''' <summary>
        ''' 勝敗を確認する
        ''' </summary>
        ''' <param name="NextTurn">次が白番か、黒番か</param>
        ''' <returns>勝った方の色、または、未定</returns>
        ''' <remarks></remarks>
        Public Function CheckFinish(NextTurn As HexPawnDefs) As HexPawnDefs
            ' ３列目に駒があるか /////////////////////////
            For file As Integer = 0 To BOARD_SIZE - 1
                If GetSquare(file, BOARD_SIZE - 1) = HexPawnDefs.White Then
                    Return HexPawnDefs.White
                ElseIf GetSquare(file, 0) = HexPawnDefs.Black Then
                    Return HexPawnDefs.Black
                End If
            Next

            ' 動ける駒の数 ///////////////////////////////
            Dim all As HpPoint() = HpBoard.GetAllPoints()
            Dim cntWhite As Integer = 0
            Dim cntBlack As Integer = 0

            For Each pt As HpPoint In all
                If IsMoveablePawn(pt) Then
                    If HexPawnDefs.White = GetSquare(pt) Then
                        cntWhite += 1
                    ElseIf HexPawnDefs.Black = GetSquare(pt) Then
                        cntBlack += 1
                    End If
                End If
            Next

            If NextTurn = HexPawnDefs.White AndAlso cntWhite = 0 Then
                Return HexPawnDefs.Black    ' 次が白番で動かせる駒が無い
            ElseIf NextTurn = HexPawnDefs.Black AndAlso cntBlack = 0 Then
                Return HexPawnDefs.White    ' 次が黒番で動かせる駒が無い
            End If

            Return HexPawnDefs.Empty    ' 勝敗未定
        End Function
    End Class

    ''' <summary>
    ''' 盤の状態と駒の移動を表すクラス
    ''' </summary>
    ''' <remarks></remarks>
    Class HpBoardMove
        Inherits HpBoard

        Protected PtFrom As HpPoint = Nothing   ' 駒の移動元
        Protected PtTo As HpPoint = Nothing     ' 駒の移動先

        ''' <summary>
        ''' コンストラクタ
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()
        End Sub

        ''' <summary>
        ''' コンストラクタ（コピー）
        ''' </summary>
        ''' <param name="bdmove">コピー元</param>
        ''' <remarks></remarks>
        Public Sub New(bdmove As HpBoardMove)
            Dim all As HpPoint() = HpBoard.GetAllPoints()

            For Each pt As HpPoint In all
                SetSquare(pt, bdmove.GetSquare(pt))
            Next

            PtFrom = bdmove.PtFrom
            PtTo = bdmove.PtTo
        End Sub

        ''' <summary>
        ''' 移動を設定する
        ''' </summary>
        ''' <param name="f">移動元</param>
        ''' <param name="t">移動先</param>
        ''' <remarks></remarks>
        Public Sub SetMove(f As HpPoint, t As HpPoint)
            PtFrom = f
            PtTo = t
        End Sub

        ''' <summary>
        ''' 駒の移動が有効であるかどうかを調べる
        ''' </summary>
        ''' <returns>true:有効、false:無効</returns>
        ''' <remarks></remarks>
        Public Function IsValidMove() As Boolean
            Dim df As Integer = PtTo.file - PtFrom.file
            ' 横方向移動量
            Dim dr As Integer = PtTo.rank - PtFrom.rank
            ' 縦方向移動量
            If GetSquare(PtFrom) = HexPawnDefs.White Then
                ' 動かす駒が白

                If GetSquare(PtTo) = HexPawnDefs.Empty AndAlso df = 0 AndAlso dr = 1 Then
                    Return True
                    ' １マス前に動ける
                ElseIf GetSquare(PtTo) = HexPawnDefs.Black AndAlso (df = 1 OrElse df = -1) AndAlso dr = 1 Then
                    Return True
                    ' 斜め前に動ける
                End If
            ElseIf GetSquare(PtFrom) = HexPawnDefs.Black Then
                ' 動かす駒が黒

                If GetSquare(PtTo) = HexPawnDefs.Empty AndAlso df = 0 AndAlso dr = -1 Then
                    Return True
                    ' １マス前に動ける
                ElseIf GetSquare(PtTo) = HexPawnDefs.White AndAlso (df = 1 OrElse df = -1) AndAlso dr = -1 Then
                    Return True
                    ' 斜め前に動ける
                End If
            End If

            Return False
        End Function

        ''' <summary>
        ''' 同じかどうか比較する
        ''' </summary>
        ''' <param name="bdmove">比較先</param>
        ''' <returns>true:同じ</returns>
        ''' <remarks></remarks>
        Public Function TestEqual(bdmove As HpBoardMove) As Boolean
            Dim all As HpPoint() = HpBoard.GetAllPoints()

            For Each pt As HpPoint In all
                If Me.GetSquare(pt) <> bdmove.GetSquare(pt) Then
                    Return False
                End If
            Next

            If PtFrom.file <> bdmove.PtFrom.file OrElse PtFrom.rank <> bdmove.PtFrom.rank OrElse PtTo.file <> bdmove.PtTo.file OrElse PtTo.rank <> bdmove.PtTo.rank Then
                Return False
            End If

            Return True
        End Function

        ''' <summary>
        ''' 駒を移動する
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub MovePawn()
            SetSquare(PtTo, GetSquare(PtFrom))
            SetSquare(PtFrom, HexPawnDefs.Empty)
        End Sub

        ''' <summary>
        ''' 左右反対の状態を作成する
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Function MakeMirror() As HpBoardMove
            Dim mirror As New HpBoardMove()

            mirror.SetMove(PtFrom.Mirror(), PtTo.Mirror())

            Dim all As HpPoint() = HpBoard.GetAllPoints()

            For Each pt As HpPoint In all
                mirror.SetSquare(pt, GetSquare(pt.Mirror()))
            Next

            Return mirror
        End Function
    End Class

    ''' <summary>
    ''' ゲームを実現するクラス
    ''' </summary>
    ''' <remarks></remarks>
    Class Game
        Private DefeatList As New List(Of HpBoardMove)()            ' 負けの状態リスト
        Private RandObj As New Random()                             ' 乱数オブジェクト
        Private PlayerColor As HexPawnDefs = HexPawnDefs.White      ' プレイヤーの色
        Private MatchBoxColor As HexPawnDefs = HexPawnDefs.Black    ' マッチ箱の色

        ''' <summary>
        ''' 負けの状態リストに存在するかどうか
        ''' </summary>
        ''' <param name="bdmove">盤の状態と駒の移動</param>
        ''' <returns>true:存在する</returns>
        ''' <remarks></remarks>
        Public Function ExistDefeatList(bdmove As HpBoardMove) As Boolean
            Dim mirror As HpBoardMove = bdmove.MakeMirror()

            For Each defeat As HpBoardMove In DefeatList
                If defeat.TestEqual(bdmove) Then
                    Return True
                End If

                If defeat.TestEqual(mirror) Then
                    Return True
                End If
            Next

            Return False
        End Function

        ''' <summary>
        ''' マッチ箱の番
        ''' </summary>
        ''' <param name="bdmove">現在の盤の状態</param>
        ''' <returns>true 打った false リザイン</returns>
        ''' <remarks></remarks>
        Public Function MatchBoxTurn(bdmove As HpBoardMove) As Boolean
            ' すべてのマスの位置を取得する
            Dim allsq As HpPoint() = HpBoard.GetAllPoints()

            ' ランダムに打つよう、配列の順番を変更する
            For i As Integer = 0 To 19
                ' 任意の２つのマスの配列内の順番を入れ替える
                Dim p As Integer = RandObj.Next(allsq.Length)
                Dim q As Integer = RandObj.Next(allsq.Length)

                If p <> q Then
                    Dim t As HpPoint = allsq(p)
                    allsq(p) = allsq(q)
                    allsq(q) = t
                End If
            Next

            ' 有効な手を探索する
            For Each f As HpPoint In allsq
                If bdmove.GetSquare(f) <> MatchBoxColor Then
                    Continue For    ' 手番の駒が無ければ次へ
                End If

                For Each t As HpPoint In allsq
                    bdmove.SetMove(f, t)

                    ' 有効な手であり、負けの手に含まれていなければOK!
                    If bdmove.IsValidMove() AndAlso Not ExistDefeatList(bdmove) Then
                        Console.Write(vbLf & "マッチ箱： " & f.ToString() & " を " & t.ToString() & " へ")
                        Return True
                    End If
                Next
            Next

            Console.Write(vbLf & "リザインします。")

            Return False    ' リザイン
        End Function

        ''' <summary>
        ''' キーボードから入力し、駒の位置に変換する
        ''' </summary>
        ''' <param name="strGuide">入力ガイド文字列</param>
        ''' <returns>駒の位置</returns>
        ''' <remarks></remarks>
        Private Function InputSquarePoint(strGuide As String) As HpPoint
            While True
                Console.Write(strGuide) ' 入力ガイドの表示

                Dim kinfo As ConsoleKeyInfo = Console.ReadKey() ' 一文字入力

                Select Case kinfo.KeyChar
                    Case "7"c
                        Return New HpPoint(0, 2)
                    Case "8"c
                        Return New HpPoint(1, 2)
                    Case "9"c
                        Return New HpPoint(2, 2)
                    Case "4"c
                        Return New HpPoint(0, 1)
                    Case "5"c
                        Return New HpPoint(1, 1)
                    Case "6"c
                        Return New HpPoint(2, 1)
                    Case "1"c
                        Return New HpPoint(0, 0)
                    Case "2"c
                        Return New HpPoint(1, 0)
                    Case "3"c
                        Return New HpPoint(2, 0)
                End Select
            End While

            Return New HpPoint(-1, -1)
        End Function

        ''' <summary>
        ''' プレイヤーの番
        ''' </summary>
        ''' <param name="bdmove">現在の盤の状態</param>
        ''' <remarks></remarks>
        Public Sub PlayerTurn(bdmove As HpBoardMove)
            Dim PtFrom As New HpPoint(-1, -1)
            Dim PtTo As New HpPoint(-1, -1)

            While True
                PtFrom = InputSquarePoint(vbLf & "駒を選んでください(1～9)：")

                If PlayerColor = bdmove.GetSquare(PtFrom) AndAlso bdmove.IsMoveablePawn(PtFrom) Then
                    Exit While
                Else
                    Console.Write(vbLf & "動かせる駒がありません")
                End If
            End While

            While True
                PtTo = InputSquarePoint(vbLf & "どこに動かしますか？(1～9)：")

                bdmove.SetMove(PtFrom, PtTo)

                If bdmove.IsValidMove() Then
                    Exit While
                Else
                    Console.Write(vbLf & "そこには動かせません")
                End If
            End While
        End Sub

        ''' <summary>
        ''' １ゲーム、プレイする
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub Play()
            Dim board As New HpBoardMove()                  ' 現在の盤の状態
            Dim lastMatchBoxMove As HpBoardMove = Nothing   ' マッチ箱の最後の手
            Dim winner As HexPawnDefs = HexPawnDefs.None    ' 勝者
            Dim turn As HexPawnDefs = HexPawnDefs.White     ' 現在の番（白番から始める）

            ' 盤面を表示
            board.Show()

            While winner <> HexPawnDefs.White AndAlso winner <> HexPawnDefs.Black
                If turn = PlayerColor Then
                    ' プレイヤーのターン

                    PlayerTurn(board)
                Else
                    ' マッチ箱のターン

                    If MatchBoxTurn(board) Then
                        lastMatchBoxMove = New HpBoardMove(board)
                    Else
                        ' リザインした場合
                        winner = PlayerColor
                        Exit While
                    End If
                End If

                ' 駒を移動
                board.MovePawn()

                ' 盤面を表示
                board.Show()

                ' 次のターンへ
                If turn = HexPawnDefs.Black Then
                    turn = HexPawnDefs.White
                Else
                    turn = HexPawnDefs.Black
                End If

                ' 勝敗の確認
                winner = board.CheckFinish(turn)
            End While

            If winner = HexPawnDefs.White Then
                Console.Write(vbLf & "白の勝ちです。" & vbLf)
            ElseIf winner = HexPawnDefs.Black Then
                Console.Write(vbLf & "黒の勝ちです。" & vbLf)
            End If

            If winner <> MatchBoxColor AndAlso lastMatchBoxMove IsNot Nothing Then
                DefeatList.Add(lastMatchBoxMove)
            End If
        End Sub
    End Class

    Sub Main()
        Dim reply As ConsoleKeyInfo
        ' ユーザー入力を受け取る変数
        Dim game As New Game()

        Do
            game.Play()
            ' １ゲーム、プレイする
            Console.Write("終了する場合は'Q'、続ける場合は他のキーを押してください")
            reply = Console.ReadKey()
        Loop While reply.Key <> ConsoleKey.Q
    End Sub

End Module