Page 1 of 1

2048Game and AI Code

Posted: Thu Aug 30, 2018 2:46 pm
by MiLoo
游戏代码
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



Re: 2048Game and AI Code

Posted: Fri Sep 07, 2018 6:41 pm
by zefiro_flashparty
8) nice!! very good haha, I had thought about making an answer to that game,
although even moving at random, good scores can be achieved.

Re: 2048Game and AI Code

Posted: Sat Sep 08, 2018 7:14 am
by Kwai chang caine
Waoooouuuuh !!!! I love this game !!! :shock:
I discover it justly in this forum with DADIDO3 thread 8)
viewtopic.php?p=445750#p445750
Since this time, i have downloading it on my phone, and it help me to wait long time in waiting room doctor for exampler
Normally i not really like games, but as soon as i have few minutes, i open it and play :D

But after millions of try...never i win more than 2048 :|
Sometime i want to throw my phone through the window :?
But, the next day, i start again, with a new hope :mrgreen:

Thanks a lot to have create also the automatic part, see the PB code of my favorite game is a real pleasure
And see it, resolve with so much rapidity :shock: it's a dream...
Perhaps i learn something, a method for go far away, of my fateful 2048 case 8)

Thanks for sharing all this nices codes 8)

Re: 2048Game and AI Code

Posted: Sun Dec 30, 2018 11:56 pm
by Olliv
Hello MiLoo,

your code could be translated in order to be published here :
https://rosettacode.org/wiki/2048.
Do you know this site ?

Re: 2048Game and AI Code

Posted: Sun Jan 06, 2019 10:53 pm
by Psychophanta
Thank you MiLoo, fantastic code. :o
PureBasic is in the path to be the real Esperanto for programmers in the world. :wink: