The game code
AI代码在第二部分
The AI code is in part 2
最高记录突破35K分
The record broke through 35K
Code: Select all
;Author:Miloo QQ:714095563
;V001:实现功能+优化
;-[Constant]
Enumeration
#winScreen
#lblCount
#txtCount
#cvsScreen
#cvsCreate
#btnStart
EndEnumeration
;-[Structure]
Structure __BlockInfo
Color.l
FontID.l
EndStructure
;- [Global]
Global Dim _DimColor.__BlockInfo(11) ;0-2048(1<<11)的颜色值
Global Dim _DimBox.b(3,3) ;4x4表格
Global _GameScore ;游戏得分
;- ==========================
;- [Inital]
;初始化字体和颜色值
Procedure Game2048_Inital()
LoadFont(16, "微软雅黑", 16, #PB_Font_Bold)
LoadFont(24, "微软雅黑", 24, #PB_Font_Bold)
LoadFont(28, "微软雅黑", 28, #PB_Font_Bold)
LoadFont(36, "微软雅黑", 36, #PB_Font_Bold)
LoadFont(48, "微软雅黑", 48, #PB_Font_Bold)
CopyMemory_(_DimColor(), ?_Bin_Color, 12*8)
EndProcedure
;- ==========================
;- [Redraw]
;重新绘制游戏主界面
Procedure Game2048_Redraw()
If StartDrawing(CanvasOutput(#cvsScreen))
Box(0,0,410,410, $181818)
DrawingMode(#PB_2DDrawing_Transparent)
For Y = 0 To 3
For X = 0 To 3
Index = _DimBox(X,Y)
;绘制方块背景
RoundBox(10+X*100, 10+Y*100, 90, 90, 5, 5, _DimColor(Index)\Color)
If Index : Text$ = Str(1<<Index)
If IsFont(_DimColor(Index)\FontID) : DrawingFont(FontID(_DimColor(Index)\FontID)) : EndIf
;绘制方块数字字符
DrawText(10+X*100+(90-TextWidth(Text$))/2, 10+Y*100+(90-TextHeight(Text$))/2, Text$, $181818)
EndIf
Next
Next
StopDrawing()
EndIf
EndProcedure
;随机产生一个新的块
Procedure Game2048_RandomBlock()
;统计空格数
*pBlock.byte = _DimBox()
For k = 1 To 16
If *pBlock\b = 0 : NullCount+1 : EndIf
*pBlock+1
Next
If NullCount = 0: ProcedureReturn : EndIf
;产生一个随机数,1/10的几率是4(即02),9/10的几率是2(即01),用1 <<(Random(9,0)/9)表示
Index = Random(NullCount, 1)
*pBlock.byte = _DimBox()
For k = 1 To 16
If *pBlock\b = 0 : Index-1 : EndIf
If Index = 0 : *pBlock\b = 1 <<(Random(9,0)/9) : Break : EndIf
*pBlock+1
Next
Game2048_Redraw()
EndProcedure
;判断游戏是否结束
Procedure Game2048_GameOver()
For i = 0 To 3
For j = 0 To 2
;有相邻方块相同或有空格的情况下,游戏可以继续
If _DimBox(i, j) = _DimBox(i, j + 1) Or _DimBox(j, i) = _DimBox(j+1, i) Or
_DimBox(i, j) = 0 Or _DimBox(i, j + 1) = 0 Or _DimBox(j, i) = 0 Or _DimBox(j+1, i) = 0
ProcedureReturn #False
EndIf
Next
Next
MessageRequester("迷路提示", "游戏结束!")
ProcedureReturn #True
EndProcedure
;开始游戏
Procedure Game2048_GameStart()
_GameScore = 0
FillMemory(_DimBox(), 16)
Game2048_RandomBlock()
Game2048_RandomBlock()
ProcedureReturn #True
EndProcedure
;- ==========================
;- [Operate]
;操作:左移
Procedure Game2048_MoveToLeft()
For y = 0 To 3
k = 0
For x = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(k, y)
SetGadgetText(#txtCount, Str(_GameScore)) : k+1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k+1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:上移
Procedure Game2048_MoveToUp()
For x = 0 To 3
k=0
For y = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(x, k)
SetGadgetText(#txtCount, Str(_GameScore)) : k+1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k+1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:右移
Procedure Game2048_MoveToRight()
For y = 0 To 3
k = 3
For x = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(k, y)
SetGadgetText(#txtCount, Str(_GameScore)) : k-1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k-1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:下移
Procedure Game2048_MoveToDown()
For x = 0 To 3
k = 3
For y = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(x, k)
SetGadgetText(#txtCount, Str(_GameScore)) : k-1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k-1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;游戏操作
Procedure Game2048_Operating(Direction)
;判断游戏是否结束
If Game2048_GameOver() : ProcedureReturn : EndIf
Select Direction
Case #PB_Shortcut_Left : IsRefresh = Game2048_MoveToLeft ()
Case #PB_Shortcut_Up : IsRefresh = Game2048_MoveToUp ()
Case #PB_Shortcut_Right : IsRefresh = Game2048_MoveToRight()
Case #PB_Shortcut_Down : IsRefresh = Game2048_MoveToDown ()
EndSelect
If IsRefresh = #True : Game2048_RandomBlock() : EndIf
EndProcedure
;- ##########################
;- [Main]
Game2048_Inital() ;初始化
WindowFlags = #PB_Window_SystemMenu |#PB_Window_MinimizeGadget |#PB_Window_ScreenCentered
hWindow = OpenWindow(#winScreen, 0, 0, 530,410, "2048经典", WindowFlags)
SetGadgetFont(#PB_Default, FontID(16))
;定义四个控件
CanvasGadget(#cvsScreen, 000, 000, 410, 410)
TextGadget (#lblCount, 420, 020, 100, 025, "分数: ")
TextGadget (#txtCount, 430, 050, 100, 025, "000")
ButtonGadget(#btnStart, 420, 090, 100, 035, "重来一局")
;定义四个操作键(→←↑↓)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Left, #PB_Shortcut_Left)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Right, #PB_Shortcut_Right)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Up, #PB_Shortcut_Up)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Down, #PB_Shortcut_Down)
Game2048_GameStart()
Repeat
Select WindowEvent()
Case #PB_Event_CloseWindow : IsExitWindow = #True
Case #PB_Event_Gadget
If EventGadget() = #btnStart : Game2048_GameStart() : EndIf
Case #PB_Event_Menu
Direction = EventMenu()
Game2048_Operating(Direction)
Default
EndSelect
Delay(1)
Until IsExitWindow = #True
DataSection
_Bin_Color:
Data.l $443333,$00,$20dffa,$30,$3bf49e,$30,$2497ff,$30,$5858fe,$24,$8a3bf6,$24
Data.l $a2e12d,$24,$fec14b,$1C,$f3915b,$1C,$e36cf1,$1C,$f15ea8,$18,$ED3BD0,$18
EndDataSection
带AI功能的代码:
Ai-enabled code:
Code: Select all
;Author:Miloo QQ:714095563
;V001:实现功能+优化
;预测的思路,能腾出的空间越多,就获胜
;-[Constant]
Enumeration
#winScreen
#lblCount
#txtCount
#cvsScreen
#cvsRecord
#lstTrains
#lstRecord
#btnStart
#lblOption1
#lblOption2
#ptnOption1
#ptnOption2
#lblTraining
#txtTraining
#imgTraining
EndEnumeration
;-[Structure]
Structure __BlockInfo
Color.l
FontID.l
EndStructure
;- [Global]
;游戏部分
Global Dim _DimColor.__BlockInfo(11) ;0-2048(1<<11)的颜色值
Global Dim _DimBox.b(3,3) ;4x4表格
Global _GameScore ;游戏得分
Global _CountChess ;着棋数
;- ==========================
;AI部分
Global _IsStopTraining ;用于处理训练中断事件
Global _GameTiming ;游戏计时
Global _StartTiming ;游戏计时
Global _IsGameOver ;游戏结束标志
Global _MaxGameScore ;当前最高游戏得分
Global _CountTrain ;累计训练次数
Global _Cumulative ;累计得分
Global _AverageScore.f ;平均得分
Declare Oracle_RedrawResult(CurrScore, Color)
Declare Game2048_GameStart()
Declare Game2048_GameOver()
;- [Inital]
;初始化字体和颜色值
Procedure Game2048_Inital()
LoadFont(11, "宋体", 11, #PB_Font_Bold)
LoadFont(15, "宋体", 15, #PB_Font_Bold)
LoadFont(16, "微软雅黑", 16, #PB_Font_Bold)
LoadFont(24, "微软雅黑", 24, #PB_Font_Bold)
LoadFont(28, "微软雅黑", 28, #PB_Font_Bold)
LoadFont(36, "微软雅黑", 36, #PB_Font_Bold)
LoadFont(48, "微软雅黑", 48, #PB_Font_Bold)
CopyMemory_(_DimColor(), ?_Bin_Color, 12*8)
EndProcedure
;- ==========================
;- [Redraw]
;重新绘制游戏主界面
Procedure Game2048_Redraw()
If StartDrawing(CanvasOutput(#cvsScreen))
Box(0,0,410,410, $181818)
DrawingMode(#PB_2DDrawing_Transparent)
For Y = 0 To 3
For X = 0 To 3
Index = _DimBox(X,Y)
;绘制方块背景
RoundBox(10+X*100, 10+Y*100, 90, 90, 5, 5, _DimColor(Index)\Color)
If Index : Text$ = Str(1<<Index)
If IsFont(_DimColor(Index)\FontID) : DrawingFont(FontID(_DimColor(Index)\FontID)) : EndIf
;绘制方块数字字符
DrawText(10+X*100+(90-TextWidth(Text$))/2, 10+Y*100+(90-TextHeight(Text$))/2, Text$, $181818)
EndIf
Next
Next
StopDrawing()
EndIf
EndProcedure
;统计空格数
Procedure Game2048_CountNull()
*pBlock.byte = _DimBox()
For k = 1 To 16
If *pBlock\b = 0 : NullCount+1 : EndIf
*pBlock+1
Next
ProcedureReturn NullCount
EndProcedure
;随机产生一个新的块
Procedure Game2048_RandomBlock()
;统计空格数
NullCount = Game2048_CountNull()
If NullCount = 0: ProcedureReturn : EndIf
;产生一个随机数,1/10的几率是4(即02),9/10的几率是2(即01),用1 <<(Random(9,0)/9)表示
Index = Random(NullCount, 1)
*pBlock.byte = _DimBox()
For k = 1 To 16
If *pBlock\b = 0 : Index-1 : EndIf
If Index = 0 : *pBlock\b = 1 <<(Random(9,0)/9) : Break : EndIf
*pBlock+1
Next
Game2048_Redraw()
EndProcedure
;判断游戏是否结束
Procedure Game2048_GameOver()
For i = 0 To 3
For j = 0 To 2
;有相邻方块相同或有空格的情况下,游戏可以继续
If _DimBox(i, j) = _DimBox(i, j + 1) Or _DimBox(j, i) = _DimBox(j+1, i) Or
_DimBox(i, j) = 0 Or _DimBox(i, j + 1) = 0 Or _DimBox(j, i) = 0 Or _DimBox(j+1, i) = 0
_IsGameOver = #False
ProcedureReturn #False
EndIf
Next
Next
If GetGadgetState(#ptnOption1)
MessageRequester("迷路提示", "游戏结束!")
ElseIf GetGadgetState(#ptnOption2)
Text$ = RSet(Str(_CountTrain+1), 4, "0") + ": "
Text$ + RSet(Str(GetTickCount_()-_GameTiming), 5, " ")+" ms "
Text$ + RSet(Str(_GameScore), 5, " ")+" 分 "
AddGadgetItem(#lstTrains, 0, Text$)
If _MaxGameScore < _GameScore
_MaxGameScore = _GameScore
AddGadgetItem(#lstRecord, 0, RSet(Str(_MaxGameScore), 5, " ")+" 分 ")
EndIf
_CountTrain + 1
_Cumulative + _GameScore
_AverageScore = _Cumulative / _CountTrain ;计算平均分
;大于等平均分的显绿线,小于侧显红色
If _GameScore >= _AverageScore
Oracle_RedrawResult(_GameScore, $00C000)
Else
Oracle_RedrawResult(_GameScore, $0000C0)
EndIf
If _CountTrain < Val(GetGadgetText(#txtTraining))
Game2048_GameStart()
Else
_IsGameOver = #True
_IsStopTraining = #True
SetGadgetText(#btnStart, "开 始")
Text$ = "游戏结束!"
Text$ + #LF$ + "最高得分: " + Str(_MaxGameScore)
Text$ + #LF$ + "平均得分: " + Str(_AverageScore)
Text$ + #LF$ + "平均耗时: " + Str((GetTickCount_()-_StartTiming)/_CountTrain)+" ms "
Text$ + #LF$ + "总耗时: " + Str(GetTickCount_()-_StartTiming)+" ms "
MessageRequester("迷路提示", Text$)
EndIf
EndIf
ProcedureReturn #True
EndProcedure
;开始游戏
Procedure Game2048_GameStart()
_GameScore = 0
_IsGameOver = 0
FillMemory(_DimBox(), 16)
Game2048_RandomBlock()
Game2048_RandomBlock()
_GameTiming = GetTickCount_() ;开始计时
ProcedureReturn #True
EndProcedure
;- ==========================
;- [Operate]
;操作:左移
Procedure Game2048_MoveToLeft()
For y = 0 To 3
k = 0
For x = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(k, y)
SetGadgetText(#txtCount, Str(_GameScore)) : k+1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k+1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:上移
Procedure Game2048_MoveToUp()
For x = 0 To 3
k=0
For y = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(x, k)
SetGadgetText(#txtCount, Str(_GameScore)) : k+1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k+1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:右移
Procedure Game2048_MoveToRight()
For y = 0 To 3
k = 3
For x = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(k, y)
SetGadgetText(#txtCount, Str(_GameScore)) : k-1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k-1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;操作:下移
Procedure Game2048_MoveToDown()
For x = 0 To 3
k = 3
For y = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : _GameScore + 1 << _DimBox(x, k)
SetGadgetText(#txtCount, Str(_GameScore)) : k-1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k-1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;游戏操作
Procedure Game2048_Operating(Direction)
;判断游戏是否结束
If Game2048_GameOver() : ProcedureReturn : EndIf
Select Direction
Case #PB_Shortcut_Left : IsRefresh = Game2048_MoveToLeft () :
Case #PB_Shortcut_Up : IsRefresh = Game2048_MoveToUp ()
Case #PB_Shortcut_Right : IsRefresh = Game2048_MoveToRight()
Case #PB_Shortcut_Down : IsRefresh = Game2048_MoveToDown ()
EndSelect
If IsRefresh = #True
_CountChess+1
SetGadgetText(#txtTraining, Str(_CountChess))
Game2048_RandomBlock()
EndIf
EndProcedure
;- ==========================
;-[Oracle]
Procedure Oracle_RedrawResult(CurrScore, Color)
If StartDrawing(CanvasOutput(#cvsRecord))
Line(0, 20, 410, 1, $C0C0C0)
Line(0, 40, 410, 1, $808080)
Line(0, 60, 410, 1, $C0C0C0)
Line(0, 80, 410, 1, $C0C0C0)
If _CountTrain > 76
DrawImage(ImageID(#imgTraining),5,0)
X = 380
Else
X = _CountTrain * 5
EndIf
Box(X, 100, 4, - CurrScore * 100/50000, Color)
If _CountTrain >= 76
If IsImage(#imgTraining) : FreeImage(#imgTraining) : EndIf
GrabDrawingImage(#imgTraining, 10, 0, 380, 100)
EndIf
StopDrawing()
EndIf
EndProcedure
;[预测用]模拟操作:左移
Procedure Oracle_MoveToLeft()
For y = 0 To 3
k = 0
For x = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : k+1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k+1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;[预测用]模拟操作:上移
Procedure Oracle_MoveToUp()
For x = 0 To 3
k=0
For y = 1 To 3
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : k+1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k+1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k+1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k+1
Else ;其它情况
k+1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;[预测用]模拟操作:右移
Procedure Oracle_MoveToRight()
For y = 0 To 3
k = 3
For x = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(k, y) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(k, y) + 1 : _DimBox(x, y) = 0 : k-1
ElseIf _DimBox(k, y) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(k, y) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> x ;两数相间的情况
IsRefresh = #True : _DimBox(k-1, y) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;[预测用]模拟操作:下移
Procedure Oracle_MoveToDown()
For x = 0 To 3
k = 3
For y = 2 To 0 Step -1
If _DimBox(x, y) > 0 ;找出K后面不为空的项
If _DimBox(x, k) = _DimBox(x, y) ;相同则合并
IsRefresh = #True : _DimBox(x, k) + 1 : _DimBox(x, y) = 0 : k-1
ElseIf _DimBox(x, k) = 0 ;K为空时,移动
IsRefresh = #True : _DimBox(x, k) = _DimBox(x, y) : _DimBox(x, y) = 0 :
ElseIf k-1 <> y ;两数相间的情况
IsRefresh = #True : _DimBox(x, k-1) = _DimBox(x, y) : _DimBox(x, y) = 0 : k-1
Else ;其它情况
k-1
EndIf
EndIf
Next
Next
ProcedureReturn IsRefresh
EndProcedure
;估算函数
Procedure Oracle_Forecasting(Index, Result.q, MaxFloor, CurFloor)
;模拟操作进行预测估算: 0表示左移,1表示上移,2表示右移,3表示下移
If MaxFloor < CurFloor : ProcedureReturn Result : EndIf
*pMemDimBox = AllocateMemory(16)
Select Index
Case 0 : IsRefresh = Oracle_MoveToLeft()
Case 1 : IsRefresh = Oracle_MoveToUp()
Case 2 : IsRefresh = Oracle_MoveToRight()
Case 3 : IsRefresh = Oracle_MoveToDown()
EndSelect
If IsRefresh = 0 : ProcedureReturn Result : EndIf
CopyMemory_(*pMemDimBox, _DimBox(), 16) ;记录当前块的详情
NullCount = Game2048_CountNull()
Result = Result + NullCount * CurFloor
If NullCount
*pBlock.byte = _DimBox()
For i = 1 To 16
If *pBlock\b = 0
For k = 0 To 3
*pBlock\b = 1
CurrOracle = Oracle_Forecasting(k, Result, MaxFloor, CurFloor+1)
If MaxOracle < CurrOracle
MaxOracle = CurrOracle
EndIf
CopyMemory_(_DimBox(), *pMemDimBox, 16) ;还原当前块的详情
Next
EndIf
*pBlock+1
Next
If MaxOracle : Result = MaxOracle : EndIf
EndIf
FreeMemory(*pMemDimBox)
ProcedureReturn Result
EndProcedure
Procedure Oracle_SimulInital()
;初始化权重表
If StartDrawing(CanvasOutput(#cvsRecord))
Box(0,0,400,100, $FFFFFF)
StopDrawing()
EndIf
_StartTiming = GetTickCount_() ;开始计时
_GameScore = 0 ;得分清零
ClearGadgetItems(#lstRecord) ;列表清零
ClearGadgetItems(#lstTrains) ;列表清零
Game2048_GameStart() ;开始游戏
EndProcedure
Procedure Oracle_Simulation(Index)
*pMemDimBox = AllocateMemory(16)
Repeat
MaxOracle.q = 0 ;最大预测值
IdxOracle.q = -1 ;最大预测值
CopyMemory_(*pMemDimBox, _DimBox(), 16) ;记录当前块的详情
NullCount = Game2048_CountNull()
If NullCount >= 12
OracleLevel = 1
ElseIf NullCount >= 8
OracleLevel = 2
ElseIf NullCount >= 4
OracleLevel = 3
Else
OracleLevel = 4
EndIf
For r = 0 To 3
CurrOracle.q = Oracle_Forecasting(r, 0, OracleLevel, 1)
CopyMemory_(_DimBox(), *pMemDimBox, 16) ;还原当前块的详情
;判断
If MaxOracle < CurrOracle
MaxOracle = CurrOracle
IdxOracle = R
EndIf
Next
If Game2048_GameOver() : Continue : EndIf
IsRefresh = #False
If IdxOracle = -1
Repeat
Operating = Random(3)
Select Operating
Case 0 : IsRefresh = Game2048_MoveToLeft()
Case 1 : IsRefresh = Game2048_MoveToUp()
Case 2 : IsRefresh = Game2048_MoveToRight()
Case 3 : IsRefresh = Game2048_MoveToDown()
EndSelect
Until IsRefresh = #True
Else
Select IdxOracle
Case 0 : IsRefresh = Game2048_MoveToLeft()
Case 1 : IsRefresh = Game2048_MoveToUp()
Case 2 : IsRefresh = Game2048_MoveToRight()
Case 3 : IsRefresh = Game2048_MoveToDown()
EndSelect
EndIf
Game2048_RandomBlock()
Until _IsStopTraining = #True
FreeMemory(*pMemDimBox)
EndProcedure
;- ==========================
;- [Event]
;按键事件
Procedure Game2048_Event_btnStart()
If GetGadgetState(#ptnOption1)
If MessageRequester("迷路提示", "确定要重新来一局么?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
_CountChess = 0
SetGadgetText(#txtTraining, "0")
Game2048_GameStart()
EndIf
ElseIf GetGadgetState(#ptnOption2)
If _IsStopTraining = #True
SetGadgetText(#btnStart, "停 止")
_IsStopTraining = #False
_CountTrain = 0 ;累积训练次数
_AverageScore = 0 ;平均得分
_MaxGameScore = 0
_Cumulative = 0
Oracle_SimulInital()
CreateThread(@Oracle_Simulation(), 0)
Else
_IsStopTraining = #True
SetGadgetText(#btnStart, "开 始")
EndIf
EndIf
EndProcedure
;选项事件
Procedure Game2048_Event_ptnOption(GadgetID)
Select GadgetID
Case #ptnOption1 : SetGadgetText(#btnStart, "重 来") : SetGadgetText(#lblTraining, "次数")
Case #ptnOption2 : SetGadgetText(#btnStart, "开 始") : SetGadgetText(#lblTraining, "自动")
EndSelect
EndProcedure
;- ##########################
;- [Main]
Game2048_Inital() ;初始化
WindowFlags = #PB_Window_SystemMenu |#PB_Window_MinimizeGadget |#PB_Window_ScreenCentered
hWindow = OpenWindow(#winScreen, 0, 0, 820,410, "2048经典[AI版]-2", WindowFlags)
;定义控件
SetGadgetFont(#PB_Default, FontID(11))
CanvasGadget (#cvsScreen, 000, 000, 410, 410)
CanvasGadget (#cvsRecord, 420, 070, 390, 100)
EditorGadget (#lstTrains, 420, 180, 250, 220)
EditorGadget (#lstRecord, 680, 180, 130, 220)
TextGadget (#lblOption1, 420, 015, 090, 020, "游戏模式:")
OptionGadget (#ptnOption1, 420+080, 010, 080, 025, "玩家模式")
OptionGadget (#ptnOption2, 520+080, 010, 080, 025, "自动模式")
TextGadget (#lblTraining, 585, 042, 045, 025, "自动:")
StringGadget (#txtTraining, 630, 037, 060, 025, "50")
SetGadgetFont(#PB_Default, FontID(15))
TextGadget (#lblCount, 420, 040, 060, 025, "分数: ")
TextGadget (#txtCount, 480, 040, 100, 025, "000")
ButtonGadget (#btnStart, 720, 015, 090, 045, "开 始")
SetGadgetState(#ptnOption2, #True)
;定义四个操作键(→←↑↓)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Left, #PB_Shortcut_Left)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Right, #PB_Shortcut_Right)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Up, #PB_Shortcut_Up)
AddKeyboardShortcut(#winScreen, #PB_Shortcut_Down, #PB_Shortcut_Down)
_IsStopTraining = #True
Game2048_GameStart()
Repeat
Select WindowEvent()
Case #PB_Event_CloseWindow : IsExitWindow = #True
Case #PB_Event_Gadget
GadgetID = EventGadget()
Select GadgetID
Case #btnStart : Game2048_Event_btnStart()
Case #ptnOption1 : Game2048_Event_ptnOption(GadgetID)
Case #ptnOption2 : Game2048_Event_ptnOption(GadgetID)
EndSelect
Case #PB_Event_Menu
Direction = EventMenu()
Game2048_Operating(Direction)
Default
EndSelect
Delay(1)
Until IsExitWindow = #True
DataSection
_Bin_Color:
Data.l $443333,$00,$20dffa,$30,$3bf49e,$30,$2497ff,$30,$5858fe,$24,$8a3bf6,$24
Data.l $a2e12d,$24,$fec14b,$1C,$f3915b,$1C,$e36cf1,$1C,$f15ea8,$18,$ED3BD0,$18
EndDataSection