68 lines
1.9 KiB
Text
68 lines
1.9 KiB
Text
Sub SP_ID(PosicPiezas As String)
|
|
Dim As String pieza
|
|
Dim As Integer pQ(), pK(), pB(), pN(), pR(), i, j
|
|
Dim As Integer Q, K, B, N, R, L, D
|
|
|
|
For i = 1 To 8
|
|
pieza = Mid(PosicPiezas, i, 1)
|
|
Select Case pieza
|
|
Case "Q"
|
|
Redim Preserve pQ(Q) : pQ(Q) = i: Q += 1
|
|
Case "K"
|
|
Redim Preserve pK(K) : pK(K) = i: K += 1
|
|
Case "B"
|
|
Redim Preserve pB(B) : pB(B) = i: B += 1
|
|
Case "N"
|
|
Redim Preserve pN(N) : pN(N) = i: N += 1
|
|
Case "R"
|
|
Redim Preserve pR(R) : pR(R) = i: R += 1
|
|
Case Else
|
|
Print "ILLEGAL PIECE '"; pieza; "'.": Exit Sub
|
|
End Select
|
|
Next i
|
|
|
|
If K <> 1 Then Print "THERE MUST BE EXACTLY ONE KING."
|
|
If Q <> 1 Then Print "THERE MUST BE EXACTLY ONE QUEEN."
|
|
If B <> 2 Then Print "THERE MUST BE EXACTLY TWO BISHOPS."
|
|
If N <> 2 Then Print "THERE MUST BE EXACTLY TWO KNIGHTS."
|
|
If R <> 2 Then Print "THERE MUST BE EXACTLY TWO ROOKS."
|
|
If Not (pK(0) > pR(0)) And (pK(0) < pR(1)) Then Print "KING MUST BE BETWEEN THE ROOKS."
|
|
If Not (pB(0) And 1) <> (pB(1) And 1) Then Print "BISHOPS MUST BE ON OPPOSITE COLORS."
|
|
|
|
For i = 0 To 1
|
|
N = pN(i)
|
|
If pN(i) > pQ(0) Then N -= 1
|
|
For j = 0 To 1
|
|
If pN(i) > pB(j) Then N -= 1
|
|
Next j
|
|
pN(i) = N
|
|
Next i
|
|
|
|
Dim As Integer N0 = 1, N1 = 2
|
|
For N = 0 To 9
|
|
If N0 = pN(0) And N1 = pN(1) Then Exit For
|
|
N1 += 1
|
|
If N1 > 5 Then N0 += 1: N1 = N0 + 1
|
|
Next N
|
|
|
|
Q = pQ(0) - 1
|
|
For i = 0 To 1
|
|
If pQ(0) > pB(i) Then Q -= 1
|
|
Next i
|
|
For i = 0 To 1
|
|
B = pB(i) - 1
|
|
If B And 1 Then L = Int(B / 2)
|
|
If (B And 1) = 0 Then D = B / 2
|
|
Next i
|
|
|
|
Print PosicPiezas; " has SP_ID of"; 96 * N + 16 * Q + 4 * D + L
|
|
End Sub
|
|
|
|
SP_ID("QNRBBNKR")
|
|
Print
|
|
SP_ID("RNBQKBNR")
|
|
Print
|
|
SP_ID("RQNBBKRN")
|
|
Print
|
|
SP_ID("RNQBBKRN")
|
|
Sleep
|