Attribute VB_Name = "Module1"
'****************************************************************
'*               THE PROBLEM OF CHESS KNIGHT                    *
'* A question, in chess game, is to know wether a knight can    *
'* go through all the board squares passing only once on each   *
'* square. The answer is yes for a 8 x 8 board, as this small   *
'* program shows. We use here the law givan by Warnsdorff in    *
'* 1823 that almost always allows finding a solution:           *
'* "In each strike, you must play the knight to the square from *
'* which there are the less exits towards the squares not yet   *
'* full."                                                       *
'* ------------------------------------------------------------ *
'*  After "Graphisme dans le plan et dans l'espace avec Turbo   *
'*  Pascal 4.0 de R. Dony - MASSON 1990 page 227".              *
'*                                                              *
'*                   Visual Basic Release By J-P Moreau, Paris. *
'****************************************************************
Const M = 7100    'size of chessboard
Const N = 750

Dim Board(-1 To 10, -1 To 10) As Integer
Dim XEscapeSqr(8) As Integer
Dim YEscapeSqr(8) As Integer
Dim NberEscapeSqr(8) As Integer
Dim EscapeSqr As Boolean
Dim lig As Integer
Dim col As Integer
Dim ct As Integer
Dim duree As Long
Dim compteur As Integer
Dim cpt2 As Integer
Dim ordre As Integer
Dim ligne As Integer
Dim colonne As Integer

Sub ReadOrder()
  ordre = Val(Form1.Text1.Text)
  If ordre < 4 Then ordre = 4
  If ordre > 8 Then ordre = 8
End Sub

Sub ReadStart()
  ligne = Val(Form1.Text3.Text)
  colonne = Val(Form1.Text2.Text)
  If ligne < 1 Then ligne = 1
  If ligne > ordre Then ligne = ordre
  If colonne < 1 Then colonne = 1
  If colonne > ordre Then colonne = ordre
End Sub

Sub DisplaySolution()
  Dim ch As String
  Dim s1 As String
  Dim s2 As String
  s1 = Str$(ligne)
  s2 = Str$(colonne)
  ch = "(" + s2 + "," + s1 + ")"
  ct = ct + 1
  col = ct Mod 3
  If col = 0 Then
    Display col * 550 + 6800, lig, ch
  ElseIf col = 1 Then
    Display col * 550 + 6800, lig, ch
  ElseIf col = 2 Then
    Display col * 550 + 6800, lig, ch
    lig = lig + 225
  End If
End Sub

'print string S at location (x,y)
Sub Display(x As Integer, y As Integer, S As String)
  Form1.CurrentX = x
  Form1.CurrentY = y
  Form1.Print S
End Sub

Sub Init()
Dim i, j, l, c As Integer
  For i = -1 To 10
    For j = -1 To 10
      Board(i, j) = 1
    Next j
  Next i
  For l = 1 To ordre
    For c = 1 To ordre
      Board(l, c) = 0
    Next c
  Next l
  compteur = 0
  EscapeSqr = True: ct = -1
  lig = 250 + N * (9 - ordre): col = 0
  duree = 800000
End Sub

Sub DrawKnight(x As Integer, y As Integer)
Dim xc, yc, xp, yp As Integer
  xp = x + 135: yp = y
  xc = x + 360: yc = y + 495: xp = xc: yp = yc
  xc = xc + 375: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc + 75: yc = yc - 195: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 75: yc = yc - 150: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 150: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  yc = yc - 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 75: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 30: yc = yc - 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 45: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 75: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 150: yc = yc + 105: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc + 105: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 75: yc = yc + 60: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc + 120: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc + 150: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  xc = xc - 150: yc = yc + 135: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc
  Form1.Circle (x + 495, y + 195), 45  'circular eye
End Sub

Sub PutKnight()
  Dim ch As String
  Dim x As Integer
  Dim y As Integer
  Dim i As Long
  z = 1
  x = 350 + N * (colonne - 1): y = M - N * ligne
  Form1.ForeColor = RGB(0, 0, 255) 'blue pen
  DrawKnight x, y
  Beep
  For i = 1 To duree
    z = z * z * z  'temporisation
  Next i
  compteur = compteur + 1
  ch = Str$(compteur)
  Display x + 500, y + 220, ch
  Board(ordre - ligne + 1, colonne) = compteur
  Call DisplaySolution
End Sub


Sub DrawBoard()
  M1 = 7000: N1 = 750
  Form1.ForeColor = RGB(0, 0, 255)
  For ii = 0 To ordre
    Form1.Line (500, M1 - ii * N1)-(500 + N1 * ordre, M1 - ii * N1)
  Next ii
  For ii = 0 To ordre
    Form1.Line (500 + ii * N1, M1)-(500 + ii * N1, M1 - N1 * ordre)
  Next ii
End Sub

Sub Test(c As Integer, l As Integer, cpt As Integer, ind As Integer)
  If Board(ordre - l + 1, c) = 0 Then
    cpt = cpt + 1
    If ind = 1 Then
      XEscapeSqr(cpt) = c
      YEscapeSqr(cpt) = l
    End If
  End If
End Sub
      
Sub TurnAround(lg As Integer, cl As Integer, cpt As Integer, ind As Integer)
  Dim l As Integer
  Dim c As Integer
  cpt = 0
  EscapeSqr = True
  l = lg + 2: c = cl - 1: Test c, l, cpt, ind
  l = lg + 2: c = cl + 1: Test c, l, cpt, ind
  l = lg + 1: c = cl + 2: Test c, l, cpt, ind
  l = lg - 1: c = cl + 2: Test c, l, cpt, ind
  l = lg - 2: c = cl + 1: Test c, l, cpt, ind
  l = lg - 2: c = cl - 1: Test c, l, cpt, ind
  l = lg - 1: c = cl - 2: Test c, l, cpt, ind
  l = lg + 1: c = cl - 2: Test c, l, cpt, ind
End Sub

Sub FreeSquares()
  Dim cpt As Integer
  Dim i As Integer
  Dim ii As Integer
  Dim ll As Integer
  Dim cc As Integer
  For ii = 1 To 8
    XEscapeSqr(ii) = 0
    YEscapeSqr(ii) = 0
  Next ii
  TurnAround ligne, colonne, cpt, 1
  If cpt <> 0 Then
    cpt2 = cpt
    For i = 1 To cpt2
      cc = XEscapeSqr(i)
      ll = YEscapeSqr(i)
      TurnAround ll, cc, cpt, 2
      NberEscapeSqr(i) = cpt
    Next i
  Else
    EscapeSqr = False
  End If
End Sub

Sub NextChoice()
Dim min, pos, i As Integer
  min = 255: pos = 0
  For i = 1 To cpt2
    If NberEscapeSqr(i) < min Then
      min = NberEscapeSqr(i)
      pos = i
    End If
  Next i
  ligne = YEscapeSqr(pos)
  colonne = XEscapeSqr(pos)
End Sub

Sub SeekSolution()
  While (compteur < ordre * ordre) And (EscapeSqr)
    Call PutKnight
    Call FreeSquares
    If EscapeSqr Then NextChoice
  Wend
End Sub

Sub Exec_Knights()
  Form1.Cls
  Call ReadOrder
  Call ReadStart
  Call Init
  Call DrawBoard
  Display 600, 650, "PROBLEM of CHESS KNIGHT"
  Call SeekSolution
End Sub