【VB.NET】打造一个象棋魔法学校的老师——谨以此文献给象棋爱好者——协议包装和棋子识别
如果你详细阅读了http://www.elephantbase.net/关于UCCI和UCI引擎协议的部分，相信对引擎的包装已经很有信心了。确实如此，这个引擎包装的代码没有什么！只是一些字符游戏：我们根据UCCI和UCI引擎协议编写一个工作于在ReIntOutStream的ReadLine事件的解码过程即可，一般来讲用Select Case语句，但是这里我们使用If ElseIF语句：
Public Class Engine
Public Name As String
Public GoFen As String
Public Structure EngineIDInfo
Dim idName As String
Dim idCopyright As String
Dim idAuthor As String
Dim idUser As String
Dim idType As String
Public Overrides Function ToString() As String '重载它，以返回我们需要的字符串表示
Return "类型: " & idType & vbCrLf & _
"版本: " & idName & vbCrLf & _
"版权: " & idCopyright & vbCrLf & _
"作者: " & idAuthor & vbCrLf & _
"授权: " & idUser
End Function
End Structure
Public Enum SetInfo
usemillisec '计时单位为毫秒 'true,false
batch '批处理模式 'true,false
debug '调试模式 'true,false
ponder '是否使用后台思考时间策略 'true,false
usebook '是否使用开局库 'true,false
useegtb '是否使用残局库 'true,false
hashsize '哈希表大小 'number
threads '线程数 'number 0 is auto
idle '优先级 'none(满负荷)、small(高负荷)、medium(中负荷)、large(低符合)
promotion '象士升变 'true,false
pruning '剪裁程度 'none(无)、small(小)、medium(中)、large(大)
knowledge '知识库大小 'none(无)、small(小)、medium(中)、large(大)
randomness '随机系数 'none(无)、small(小)、medium(中)、large(大)
style '风格 'solid(保守)、normal(均衡)和risky(冒进)
ownbook '用于UCI协议引擎指定使用开局库
End Enum
Private WithEvents EngPipe As ReIntOutStream
Public EngIDInfo As EngineIDInfo
Private EngOption As Hashtable
Event EngineLoadOver(ByVal Name As String, ByVal IDInfo As EngineIDInfo) '加载完成
Event EngineResign(ByVal Name As String) '引擎认输
Event EngineBestmove(ByVal move As String, ByVal usermove As String) '引擎招法
Event EngineSetCmdOver(ByVal cmd As String) '向引擎发送招法完毕
Event EngineExit(ByVal Name As String) '引擎退出
Sub New(ByVal EngineName As String, ByVal FileName As String)
Name = EngineName
EngPipe = New ReIntOutStream(String.Empty, FileName)
'===============================================
EngPipe.SendCommand("ucci")
EngPipe.SendCommand("uci") '兼容UCI协议引擎
'=============================================
EngOption = New Hashtable
InsOption()
EngPipe.SendCommand("newgame")
'====================================
EngPipe.SendCommand("ucinewgame") '兼容UCI协议引擎
'====================================
EngPipe.SendCommand("isready")
End Sub
Private Sub InsOption()
EngOption.Add("usemillisec", "true")
EngOption.Add("batch", "false")
EngOption.Add("debug", "false")
EngOption.Add("ponder", "false")
EngOption.Add("usebook", "true")
EngOption.Add("useegtb", "true")
EngOption.Add("hashsize", "0")
EngOption.Add("threads", "0")
EngOption.Add("idle", "none")
EngOption.Add("promotion", "false")
EngOption.Add("pruning", "none")
EngOption.Add("knowledge", "medium")
EngOption.Add("randomness", "small")
EngOption.Add("style", "risky")
EngOption.Add("ownbook", "true")
End Sub
Public Sub SetOptions()
For Each key In EngOption.Keys
EngPipe.SendCommand("setoption " & key.ToString & " " & EngOption(key).ToString)
Next
End Sub
Private Sub SetOption(ByVal Key As SetInfo, ByVal Value As String)
EngOption(Key) = Value
EngPipe.SendCommand("setoption " & Key & " " & Value)
End Sub
Sub [stop]()
EngPipe.SendCommand("stop")
End Sub
Sub Go(ByVal Fen As String, ByVal [Step] As Integer, Optional ByVal TimeMode As Boolean = False)
GoFen = Fen
[stop]()
My.Application.DoEvents()
EngPipe.SendCommand(Fen)
My.Application.DoEvents()
If TimeMode Then
EngPipe.SendCommand("go time 60000 movestogo 6 opptime 60000 oppmovestogo 6")
Else
EngPipe.SendCommand("go depth " & [Step])
End If
End Sub
Private Sub EngPipe_ReadOver(ByVal mInfo As String) Handles EngPipe.ReadLine
Dim Info As String = mInfo.ToLower
If InStr(Info, "id name") > 0 Then
EngIDInfo.idName = Info.Replace("id name", String.Empty).Trim
ElseIf InStr(Info, "id copyright") > 0 Then
EngIDInfo.idCopyright = Info.Replace("id copyright", String.Empty).Trim
ElseIf InStr(Info, "id author") > 0 Then
EngIDInfo.idAuthor = Info.Replace("id author", String.Empty).Trim
ElseIf InStr(Info, "id user") > 0 Then
EngIDInfo.idUser = Info.Replace("id user", String.Empty).Trim
ElseIf InStr(Info, "ciok") > 0 Then '兼容UCI协议引擎
If InStr(Info, "ucci") > 0 Then
EngIDInfo.idType = "ucci"
ElseIf InStr(Info, "uci") > 0 Then
EngIDInfo.idType = "uci"
Else
EngIDInfo.idType = "未知"
End If
RaiseEvent EngineLoadOver(Name, EngIDInfo)
ElseIf InStr(Info, "readyok") > 0 Then
Me.SetOptions()
ElseIf InStr(Info, "bye") > 0 Then
RaiseEvent EngineExit(Name)
ElseIf InStr(Info, "bestmove") > 0 Then
If InStr(Info, "resign") > 0 Then '这个，不同的引擎输出可能不一样，并不是很统一
RaiseEvent EngineResign(Name)
Else
Dim us As String = String.Empty
If InStr(Info, "ponder") > 0 Then
us = Mid(Info, InStr(Info, "ponder") + 7, 4).Trim
Else
us = String.Empty
End If
Dim bestmove As String = Mid(Info, 9, 5).Trim
If bestmove.Length = 4 Then RaiseEvent EngineBestmove(bestmove, us)
End If
End If
End Sub
Sub close()
[stop]()
EngPipe.SendCommand("quit") '这个是一定要调用的。。。。否则引擎窗口一直处于等待输入命令状态。。
End Sub
End Class
在这个包装中，我们兼容了UCCI协议和UCI协议，以使得我们的程序既可以运行象眼一样的引擎也可以运行象棋旋风一样的引擎。
而对于代码中的SetInfo枚举，似乎只是放在那里供我们观看……实际上你可以更好的把它运用在EngOption这个用于引擎设置的哈希表里——InsOption函数当中。对于Go函数，你可以根据UCCI协议或UCI协议来进行修改，使得你的程序可更详细的划分电脑玩家的等级——就像象棋巫师那样，所以，我的GO函数只是给你一个示例或者启迪吧。
接下来我们面临的问题也是我们一开始规划这个辅助工具时就面临的最大问题：
象棋魔法学校是一款非开源的程序（至少我没有找到源码的下载地址），而即使获得了源码，我们也需要用相应的语言（很可能是VB6）来重新写我们上面的代码，这是非常令人沮丧的，或者你可以修改它的源码~~让象眼这个引擎即帮助电脑玩家想也帮助你想~~~当然，这也失去了象棋的乐趣，也不是我开发这款“插件”所愿意看到的结果。
那么，如何解决这个问题呢？当然你可能“诡计多端”有很多办法可以帮你，例如HOOK，例如内存扫描和读取，但是我想再把图像识别这个技术介绍给你：
我们取得一个“标准图像”——它需要有全部或绝大多数棋子（至少14个）在棋盘上，然后，用这个“标准图像”来取得我们的“标准棋子表示”，当我们有一个标准（“标准棋子表示”）来衡量每个棋子或空白区域时，我们就能够知道这个位置上有没有棋子这个棋子是什么。这就像我们知道“车”怎么写之后，再去看一个字，就能辨认出他是不是“车”。
于是，在这里我实现了一个基类：
Public Class EyeBase
Public Name As String
Public Table As ArrayList
'将图像隔行隔列扫描到ArrayList
Shared Function Look(ByVal bmp As Bitmap) As ArrayList
Return Look(bmp, bmp.Size - New Size(1, 1))
End Function
'只是把BMP按Step数值隔行隔列取颜色值并依次保存在ArrayList里
Protected Shared Function Look(ByVal bmp As Bitmap, ByVal Size As Size, Optional ByVal [Step] As Integer = 2) As ArrayList
Dim ret As New ArrayList
Dim mStep As Integer = IIf([Step] > 0, [Step], 1)
For x As Integer = 0 To Size.Width Step [Step]
For y As Integer = 0 To Size.Height Step [Step]
ret.Add(bmp.GetPixel(x, y).ToArgb)
Next
Next
Return ret
End Function
End Class
这个基类非常的简单：它只有两个非共享成员，名字和特征；而另外两个共享成员实际上是被重载的同一个函数——Look，这个函数也简单至极，它只能够“看到”这个图片的特征——把它存储在一个ArrarList中。
接下来，我们在这个类的基础上写出一个不仅可以拾取特征还可以对号入座的类：（虽然我称上面的类为基类，但实际上我的程序中并没有继承它）
在这之前，我还想复习一下，在象棋中，只有14个不同的子，而其他的子都是它们的重复，这14个子分别属于红方和黑方——红黑各7个，它们分别是：
r,n,b,a,k,c,p（车，马，像，士，将，炮，兵——当然，我的汉字表示方式可能并不规范，但这不影响我们编写这个程序，因为程序中都是以UCCI或UCI引擎规范表示的——用字母）
'一共有14类棋子
Dim myEyes(13) As EyeBase
'它们分别是黑色的车、马、象、士、帅、炮、兵
' 以及红色的车、马、象、士、帅、炮、兵
Dim Names As String() = New String() {"r", "n", "b", "a", "k", "c", "p", _
"R", "N", "B", "A", "K", "C", "P"}
'它们对应的位置分别是（这里假定本方一直执红）
Dim Points As Point() = New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(3, 0), New Point(4, 0), New Point(1, 2), New Point(0, 3), _
New Point(0, 9), New Point(1, 9), New Point(2, 9), New Point(3, 9), New Point(4, 9), New Point(1, 7), New Point(0, 6)}
那么，这个类要想实现他的功能：识别特征并对号入座，需要哪些信息呢？
如果我们传入一个截获来的整张图片，那么我们需要:棋盘上左上角第一个放子位的坐标（对方的右车的中心位置），棋盘上放子的间隔，我们要的信息量（决定了我们识别的准确度、可控阀值（本程序未使用）和识别速度）这三个参数
规划完这些以后，我们只要回顾一下，这个类的功能：识别特征并对号入座，就知道我们只需要实现一个LookAll方法就完成了类的设计，其完整代码如下：
Public Class EyeBase
Public Name As String
Public Table As ArrayList
'将图像隔行隔列扫描到ArrayList
Shared Function Look(ByVal bmp As Bitmap) As ArrayList
Return Look(bmp, bmp.Size - New Size(1, 1))
End Function
'只是把BMP按Step数值隔行隔列取颜色值并依次保存在ArrayList里
Protected Shared Function Look(ByVal bmp As Bitmap, ByVal Size As Size, Optional ByVal [Step] As Integer = 2) As ArrayList
Dim ret As New ArrayList
Dim mStep As Integer = IIf([Step] > 0, [Step], 1)
For x As Integer = 0 To Size.Width Step [Step]
For y As Integer = 0 To Size.Height Step [Step]
ret.Add(bmp.GetPixel(x, y).ToArgb)
Next
Next
Return ret
End Function
End Class
Public Class Eyes
'一共有14类棋子
Dim myEyes(13) As EyeBase
'它们分别是黑色的车、马、象、士、帅、炮、兵
' 以及红色的车、马、象、士、帅、炮、兵
Dim Names As String() = New String() {"r", "n", "b", "a", "k", "c", "p", _
"R", "N", "B", "A", "K", "C", "P"}
'它们对应的位置分别是（这里假定本方一直执红）
Dim Points As Point() = New Point() {New Point(0, 0), New Point(1, 0), New Point(2, 0), New Point(3, 0), New Point(4, 0), New Point(1, 2), New Point(0, 3), _
New Point(0, 9), New Point(1, 9), New Point(2, 9), New Point(3, 9), New Point(4, 9), New Point(1, 7), New Point(0, 6)}
Dim _SPoint As Point
Dim _BSize As Size
Dim _TSize As Size
''' <summary>
''' 初始化并获得棋子的标准数据
''' </summary>
''' <param name="SBMP">初始图像，即摆好所有棋子后的图像</param>
''' <param name="SPoint">棋盘第一个放子点（左上角车）坐标</param>
''' <param name="BSize">棋盘的每个格子的宽度</param>
''' <param name="TSize">要在棋子内部测试的矩形的半边长</param>
''' <remarks></remarks>
Sub New(ByVal SBMP As Bitmap, ByVal SPoint As Point, ByVal BSize As Size, ByVal TSize As Size)
_SPoint = SPoint
_BSize = BSize
_TSize = TSize
'从棋盘上取我们需要的棋子图像
For i As Integer = 0 To 13
myEyes(i) = New EyeBase
myEyes(i).Name = Names(i)
Dim TestRect As Rectangle = New Rectangle(Points(i).X * BSize.Width + SPoint.X - TSize.Width, Points(i).Y * BSize.Height + SPoint.Y - TSize.Height, TSize.Width * 2, TSize.Height * 2)
myEyes(i).Table = EyeBase.Look(SBMP.Clone(TestRect, SBMP.PixelFormat))
Next
End Sub
Function LookAll(ByVal bmp As Bitmap) As String
Dim Table(8, 9) As String '棋盘表
'遍历棋盘上每个测试范围以确定是否有棋子并记录到棋盘表
For x As Integer = 0 To 8
For y As Integer = 0 To 9
Dim TestPoint As Point = New Point(x, y)
Dim TestRect As Rectangle = New Rectangle(TestPoint.X * _BSize.Width + _SPoint.X - _TSize.Width, TestPoint.Y * _BSize.Height + _SPoint.Y - _TSize.Height, _TSize.Width * 2, _TSize.Height * 2)
Dim TestBmp As Bitmap = bmp.Clone(TestRect, bmp.PixelFormat)
'Dim gr As Graphics = Graphics.FromImage(bmp)
'gr.DrawRectangle(Pens.White, TestRect)
Table(x, y) = Look(TestBmp)
Next
Next
'将棋盘表转化为FEN——你应该仔细考虑一下，为什么这个代码里我们一直在执红，而程序输出的结果无论我们执红还是执黑都是正确的。
'这是一个非常重要的事情，如果你阅读了“旋转的位棋盘”并体会到了他的精妙却头疼于旋转一个表。
Dim ret As String = String.Empty
For y As Integer = 0 To 9
Dim SpaceNum As Integer = 0, LineSituation As String = String.Empty
For x As Integer = 0 To 8
If Table(x, y) = Space(1) Then
SpaceNum += 1
Else
LineSituation &= IIf(SpaceNum = 0, String.Empty, SpaceNum) & Table(x, y)
SpaceNum = 0
End If
Next
ret &= LineSituation & IIf(SpaceNum = 0, String.Empty, SpaceNum) & IIf(y = 9, String.Empty, "/")
Next
Return ret & " w - - 0 3"
End Function
'看一个块图像是否与某个棋子一样，一样时输出棋子名（UCCI协议表示法）否则输出一个空
Private Function Look(ByVal bmp As Bitmap) As String
Dim test As ArrayList = EyeBase.Look(bmp)
For Each eye As EyeBase In myEyes
If TooArray(eye.Table, test) Then Return eye.Name
Next
Return Space(1)
End Function
'比较两个数组是否完全一致
Private Function TooArray(ByVal arr1 As ArrayList, ByVal arr2 As ArrayList) As Boolean
Dim [to] As Integer = IIf(arr1.Count < arr2.Count, arr1.Count - 1, arr2.Count - 1)
For i As Integer = 0 To [to]
If CInt(arr1(i)) <> CInt(arr2(i)) Then Return False
Next
Return True
End Function
End Class
希望你能在复制代码之后，详细阅读其注释并发现我在LookAll函数中留给你的一个问题：
'将棋盘表转化为FEN——你应该仔细考虑一下，为什么这个代码里我们一直在执红，而程序输出的结果无论我们执红还是执黑都是正确的。
'这是一个非常重要的事情，如果你阅读了“旋转的位棋盘”并体会到了他的精妙却头疼于旋转一个表。
相信聪明的你很快能够找出“奥妙”所在。
好了，这一篇就到这里，实际上，你已经能够利用我的代码来编写一个识别棋子并让你所加载的UCCI或UCI协议引擎来做出决策的程序了。当然，这还需要一些WIN32 API的相关知识。在下一节里面我将详细介绍它们，并贴出全部代码和提供成品程序下载，而这个程序我不会进一步更新它——用你的思维去创造你的乐趣吧，不用在意我。
