Игра в Уголки на Bisual Basic 6

 

 Игра в уголки играется шашками. Надо занять поле противника ходя на одну клетку или перепрыгивая через. Все просто. Перебор ведется на 3 полухода. Хд противника можно не учитывать. Вводится некоторая случайность в оценке каждой клетки - случайность в пределах разумного.

Скачать исходники и исполняемый файл 

Для запуска программы могут потребоваться DLL Visual Basic 6. Придется его установить. Он очень небольшой по объему. 

Пример кода главного модуля:

Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Corners 2012.02.11
'Wrote Nifont I.,

Const black_pawn = 1
Const white_pawn = 2
Const empty_square = 0

Dim init_pos ' 0..63
Dim click_sq(0 To 1) As Integer

Dim pos(0 To 63) As Integer
Const MaxPly = 10
Dim tree(0 To 1000) As move_type
Dim tree_cnt(0 To MaxPly) As Integer
Dim ply As Integer

Dim exist(0 To 63) As Integer

Const Max_Pieces = 9

Dim black_score_tbl ' (0 to 63)
Dim black_score_tbl_init
Dim target_tbl '      (0 to 63)
Dim static_score(1 To 2) As Integer
Dim end_piece_cnt(1 To 2) As Integer
Dim start_piece_cnt(1 To 2) As Integer
Dim xside(1 To 2) As Integer
Const INF = 30000
Dim find_best(0 To MaxPly) As move_type


Sub mix(ByVal min As Integer, ByVal max As Integer)
 Dim a%, b%, j%
 Dim mv As move_type
 
 If min < max Then
  Randomize
  For j = 0 To 20
    a = Int((max - min) * Rnd + min)
    b = Int((max - min) * Rnd + min)
    mv = tree(a)
    tree(a) = tree(b)
    tree(b) = mv
  Next j
 End If
End Sub



Function search(ByVal d As Integer, _
                ByVal side As Integer _
                ) As Integer
  Dim j%, score%
 
  find_best(ply).a = 0
  find_best(ply).b = 0
 
  If is_end_game > 0 Then
     search = (INF - ply)
  ElseIf (d <= 0) Or (ply >= MaxPly - 1) Then
     search = evaluate(side)
  Else
     search = -INF
     generate (side)
     If ply = 0 Then mix 0, tree_cnt(1) - 1
     
     For j = tree_cnt(ply) To tree_cnt(ply + 1) - 1
            
       make_move tree(j).a, tree(j).b
       ply = ply + 1
            
       score = search(d - 1, side)
       ply = ply - 1
       un_make_move tree(j).a, tree(j).b
       If score > search Then
         search = score
         find_best(ply) = tree(j)
       End If
     Next j
  End If
End Function



Function search_best(ByVal side) As Boolean
  Dim score%, d%, j%
  
   d = 3
   If end_piece_cnt(black_pawn) >= Max_Pieces - 1 Then
     d = 4
   End If
   
   score = search(3, side)
   
  search_best = find_best(0).a <> find_best(0).b
End Function


Function is_end_game() As Integer
  If (end_piece_cnt(white_pawn) >= Max_Pieces) Then
     is_end_game = white_pawn
  ElseIf (end_piece_cnt(black_pawn) >= Max_Pieces) Then
     is_end_game = black_pawn
  Else
     is_end_game = 0
  End If
End Function

Function evaluate(ByVal side As Integer) As Integer
 Dim score%
 
 score = static_score(white_pawn) - _
         static_score(black_pawn)
         
 If frmMain.optMaster.Value = True Then
   If start_piece_cnt(white_pawn) = 0 Then
     score = score + 70
   End If
 
   If start_piece_cnt(black_pawn) = 0 Then
     score = score - 70
   End If
 End If
 
 
 If side = white_pawn Then
  evaluate = score
 Else
  evaluate = -score
 End If
End Function


Sub insert_piece(ByVal p As Integer, _
                 ByVal sq As Integer)
                 
                 

                 
  pos(sq) = p
  If p = black_pawn Then
    static_score(p) = _
      static_score(p) + black_score_tbl(sq) + _
      target_tbl(sq)
    
  Else 'white_pawn
    static_score(p) = _
      static_score(p) + black_score_tbl(63 - sq) + _
      target_tbl(63 - sq)
  End If
  
  If init_pos(sq) = xside(p) Then
    end_piece_cnt(p) = end_piece_cnt(p) + 1
  ElseIf init_pos(sq) = p Then
    start_piece_cnt(p) = start_piece_cnt(p) + 1
  End If
End Sub



Sub remove_piece(ByVal p As Integer, _
                 ByVal sq As Integer)
  pos(sq) = 0
  If p = black_pawn Then
    static_score(p) = _
      static_score(p) - black_score_tbl(sq) - _
      target_tbl(sq)

  Else 'white_pawn
    static_score(p) = _
      static_score(p) - black_score_tbl(63 - sq) - _
      target_tbl(63 - sq)
  End If
  
  If init_pos(sq) = xside(p) Then
    end_piece_cnt(p) = end_piece_cnt(p) - 1
  ElseIf init_pos(sq) = p Then
    start_piece_cnt(p) = start_piece_cnt(p) - 1
  End If
End Sub

                 
Sub make_move(a As Integer, b As Integer)
   Debug.Assert (pos(a) > 0) And (pos(b) = 0)
   
   p = pos(a)
   remove_piece p, a
   insert_piece p, b
End Sub

Sub un_make_move(a As Integer, b As Integer)

   Debug.Assert (pos(b) > 0) And (pos(a) = 0)
   
   p = pos(b)
   remove_piece p, b
   insert_piece p, a
End Sub



Sub link_move(a As Integer, b As Integer)

  Debug.Assert (pos(a) > 0) And (pos(b) = 0)

  With tree(tree_cnt(ply + 1))
    .a = a
    .b = b
  End With
  tree_cnt(ply + 1) = tree_cnt(ply + 1) + 1
End Sub

 

Sub jamp_piece(ByVal start_sq As Integer, _
               ByVal sq As Integer)
  
 If exist(sq) = 0 Then
  
  exist(sq) = 1
  If sq <> start_sq Then
    link_move start_sq, sq
  End If
 
  If sq + 16 <= 63 Then _
   If pos(sq + 8) > 0 Then _
    If pos(sq + 16) = 0 Then _
      jamp_piece start_sq, sq + 16
  
  If sq - 16 >= 0 Then _
   If pos(sq - 8) > 0 Then _
    If pos(sq - 16) = 0 Then _
      jamp_piece start_sq, sq - 16
    
  If (sq And 7) > 1 Then _
   If pos(sq - 1) > 0 Then _
    If pos(sq - 2) = 0 Then _
      jamp_piece start_sq, sq - 2
  
  If (sq And 7) < 6 Then _
   If pos(sq + 1) > 0 Then _
    If pos(sq + 2) = 0 Then _
      jamp_piece start_sq, sq + 2
   
  exist(sq) = 0
 End If
End Sub


Sub move_piece(sq As Integer)
  If sq + 8 <= 63 Then
   If pos(sq + 8) = 0 Then
    link_move sq, (sq + 8)
   End If
  End If
  If sq - 8 >= 0 Then
   If pos(sq - 8) = 0 Then
    link_move sq, (sq - 8)
   End If
  End If
  If (sq And 7) < 7 Then
   If pos(sq + 1) = 0 Then
    link_move sq, (sq + 1)
   End If
  End If
  If (sq And 7) > 0 Then
   If pos(sq - 1) = 0 Then
    link_move sq, (sq - 1)
   End If
  End If
End Sub

Sub generate(ByVal side As Integer)
  tree_cnt(ply + 1) = tree_cnt(ply)
  For j = 0 To 63
    If pos(j) = side Then
       move_piece (j)
       jamp_piece j, j
    End If
  Next j
End Sub




       
Private Sub show_pos()
  For j = 0 To 63
   If pos(j) = black_pawn Then
     frmMain.Image1(j).Picture = _
     frmMain.img_black_ch.Picture
   ElseIf pos(j) = white_pawn Then
     frmMain.Image1(j).Picture = _
     frmMain.img_white_ch.Picture
   Else
     frmMain.Image1(j).Picture = _
     frmMain.img_empty_sq.Picture
   End If
  Next j
End Sub



Private Sub cmdAbout_Click()
  frmAbout.Show (modal)
End Sub

Private Sub cmd3_Click()
  img_shape.Visible = False
  
  
  'play_file "d:\src\corners_vb\Eingebne.wav"
 
  
  end_piece_cnt(1) = 0
  end_piece_cnt(2) = 0
  
  start_piece_cnt(1) = 0
  start_piece_cnt(2) = 0
  
  static_score(1) = 0
  static_score(2) = 0
  
  For j = 0 To 63
   pos(j) = 0
   If init_pos(j) <> 0 Then
     insert_piece init_pos(j), j
   End If
  Next j
  show_pos
  
End Sub

Private Sub cmdNew_Click()
  Randomize
  img_shape.Visible = False
  
  end_piece_cnt(1) = 0
  end_piece_cnt(2) = 0
  
  start_piece_cnt(1) = 0
  start_piece_cnt(2) = 0
  
  static_score(1) = 0
  static_score(2) = 0
  
  For j = 0 To 63
   pos(j) = 0
   If init_pos(j) <> 0 Then
     insert_piece init_pos(j), j
   End If
   black_score_tbl(j) = Int(black_score_tbl_init(j) * Rnd)
  Next j
  show_pos
  'play_file "burg.wav"
End Sub

Private Sub Form_Load()
  init_pos = Array _
      (1, 1, 1, 0, 0, 0, 0, 0, _
       1, 1, 1, 0, 0, 0, 0, 0, _
       1, 1, 1, 0, 0, 0, 0, 0, _
       0, 0, 0, 0, 0, 0, 0, 0, _
       0, 0, 0, 0, 0, 0, 0, 0, _
       0, 0, 0, 0, 0, 2, 2, 2, _
       0, 0, 0, 0, 0, 2, 2, 2, _
       0, 0, 0, 0, 0, 2, 2, 2)
  click_sq(0) = 0
  click_sq(1) = 0
  
  black_score_tbl = Array _
      (1, 2, 3, 4, 5, 6, 7, 8, _
       2, 9, 10, 11, 12, 13, 14, 15, _
       3, 10, 16, 17, 18, 19, 20, 21, _
       4, 11, 17, 22, 23, 24, 25, 26, _
       5, 12, 18, 23, 27, 28, 29, 30, _
       6, 13, 19, 24, 28, 31, 32, 33, _
       7, 14, 20, 25, 29, 32, 34, 35, _
       8, 15, 21, 26, 30, 33, 35, 36)
 black_score_tbl_init = Array _
      (1, 2, 3, 4, 5, 6, 7, 8, _
       2, 9, 10, 11, 12, 13, 14, 15, _
       3, 10, 16, 17, 18, 19, 20, 21, _
       4, 11, 17, 22, 23, 24, 25, 26, _
       5, 12, 18, 23, 27, 28, 29, 30, _
       6, 13, 19, 24, 28, 31, 32, 33, _
       7, 14, 20, 25, 29, 32, 34, 35, _
       8, 15, 21, 26, 30, 33, 35, 36)
  
  target_tbl = Array _
  (-2, -2, -2, 0, 0, 0, 0, 0, _
   -2, -2, -2, 0, 0, 0, 0, 0, _
   -2, -2, -2, 2, 2, 2, 0, 0, _
    0, 0, 2, 2, 2, 2, 0, 0, _
    0, 0, 2, 2, 2, 2, 0, 0, _
    0, 0, 2, 2, 2, 60, 60, 60, _
    0, 0, 0, 0, 0, 60, 60, 60, _
    0, 0, 0, 0, 0, 60, 60, 60)
    
 xside(1) = 2
 xside(2) = 1
    
 cmdNew_Click
 
    
End Sub

Private Sub Image1_Click(Index As Integer)
 Dim L%, T%
 Dim find As Boolean
 
 
 If is_end_game > 0 Then
   MsgBox ("Game Over! Click 'New' or EXit")
   Exit Sub
 End If
 
 
 'frmMain.img_shape.Move(left,top)
 L = frmMain.Image1(Index).Left
 T = frmMain.Image1(Index).Top
 frmMain.img_shape.Left = L
 frmMain.img_shape.Top = T
 frmMain.img_shape.Visible = True
' frmMain.img_shape.Top = True
 click_sq(0) = click_sq(1)
 click_sq(1) = Index
 
 'user move ?
 If pos(click_sq(0)) = white_pawn Then
  If pos(click_sq(1)) = 0 Then
     
     generate white_pawn
     find = False
     For j = 0 To tree_cnt(1) - 1
       If tree(j).a = click_sq(0) Then
        If tree(j).b = click_sq(1) Then
         find = True
        End If
       End If
     Next j
     
     If find Then
       make_move click_sq(0), click_sq(1)
       
      ' un_make_move click_sq(0), click_sq(1)
              
       
       click_sq(0) = click_sq(1)
       show_pos
       DoEvents
              
       If is_end_game > 0 Then
          play_file "Eingebne.wav"
          MsgBox ("Congratulate! Game Over!")
       Else
       
         Screen.MousePointer = vbHourglass
         find_move = search_best(black_pawn)
         Screen.MousePointer = vbDefault
         
         If find_move Then
          make_move find_best(0).a, _
                    find_best(0).b
          show_pos
          DoEvents
          If is_end_game > 0 Then
            MsgBox ("Sorry! Game Over")
          End If
         Else
           MsgBox ("?! No moves found!")
         End If
         
       End If
       
     End If
  End If
 End If
End Sub