It is currently Fri Dec 06, 2019 7:50 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: 2048Game and AI Code
PostPosted: Thu Aug 30, 2018 2:46 pm 
Offline
User
User

Joined: Fri Jan 28, 2011 12:26 pm
Posts: 29
游戏代码
The game code

AI代码在第二部分
The AI code is in part 2
最高记录突破35K分
The record broke through 35K

Code:

;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:
;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++


Top
 Profile  
Reply with quote  
 Post subject: Re: 2048Game and AI Code
PostPosted: Fri Sep 07, 2018 6:41 pm 
Offline
User
User
User avatar

Joined: Fri Mar 04, 2005 7:46 pm
Posts: 73
Location: argentina
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)


Top
 Profile  
Reply with quote  
 Post subject: Re: 2048Game and AI Code
PostPosted: Sat Sep 08, 2018 7:14 am 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4542
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: 2048Game and AI Code
PostPosted: Sun Dec 30, 2018 11:56 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Tue Sep 22, 2009 10:41 pm
Posts: 456
Hello MiLoo,

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


Top
 Profile  
Reply with quote  
 Post subject: Re: 2048Game and AI Code
PostPosted: Sun Jan 06, 2019 10:53 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4580
Location: Spa, relaxing and thinking, and learning...
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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye