2048Game and AI Code

Advanced game related topics
MiLoo
User
User
Posts: 47
Joined: Fri Jan 28, 2011 12:26 pm

2048Game and AI Code

Post 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


I came to the ancient oriental country - China
I will PureBasic called B++
zefiro_flashparty
User
User
Posts: 74
Joined: Fri Mar 04, 2005 7:46 pm
Location: argentina

Re: 2048Game and AI Code

Post 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.
Amd Vishera fx8350 ,16Gbram, Gtx650 ti, 2gb,Win 10pro. 13tbs. 8)
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: 2048Game and AI Code

Post 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)
ImageThe happiness is a road...
Not a destination
User avatar
Olliv
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Sep 22, 2009 10:41 pm

Re: 2048Game and AI Code

Post 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 ?
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: 2048Game and AI Code

Post by Psychophanta »

Thank you MiLoo, fantastic code. :o
PureBasic is in the path to be the real Esperanto for programmers in the world. :wink:
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
Post Reply