Informática Educativa Carlosfmur@gmail.com: El problema de las 8 reinas (código en Small Basic)

El problema 8-Queens en el ajedrez es colocar 8 reinas en un tablero de ajedrez de tal manera que ninguna de las reinas es una amenaza cualquiera de las otras. El problema es que a la entrada de las 8 columnas de las reinas en las filas de un tablero de ajedrez, donde 1 es la primera columna y 8 la última, por ejemplo, 1 2 3 4 5 6 7 8 significa que las reinas están a lo largo de la diagonal, lo cual no sería una solución válida.
http://blogs.msdn.com/b/smallbasic/archive/2013/01/11/queens-chess-challenge-small-basic.aspx
Más información http://en.wikipedia.org/wiki/Eight_queens_puzzle
Program Listing: QDX521 http://smallbasic.com/program/?QDX521

1.Principio del formulario

‘ 8-Queens 0.2
‘ Copyright (c) 2012 Nonki Takahashi
‘
‘ History :
‘ 0.2 2013/01/03 Rewrote for 8-Queens probrem. ()
‘ 0.1 2012/08/04 Code for chessmen written in hexadecimal.
‘ 0.0 2012/08/04 25-line version created. (CLP327)
‘
GraphicsWindow.Title = ”8-Queens 0.2″
GraphicsWindow.BackgroundColor = ”#004C00″
GraphicsWindow.BrushColor = ”Black”
oNum = Controls.AddTextBox(440, 30)
num = 12345678
Controls.SetTextBoxText(oNum, num)
InitBoard()
CheckValid()
DrawBoard()
Controls.TextTyped = OnTextTyped
Sub OnTextTyped
num = Controls.GetTextBoxText(oNum)
len = Text.GetLength(num)
correct = ”False”
If len = 8 Then
correct = ”True”
For i = 1 To 8
If Text.IsSubText(num, Text.GetSubText(“12345678″, i, 1)) = ”False” Then
correct = ”False”
EndIf
EndFor
EndIf
If correct Then
board = ”"
For c = 1 To 8
board[Text.GetSubText(num, c, 1)][Text.GetSubText("abcdefgh", c, 1)] = ”BQ”
EndFor
CheckValid()
DrawBoard()
EndIf
EndSub
Sub CheckValid
valid = ”True”
For c1 = 1 To 8
For c2 = c1 + 1 To 8
r1 = Text.GetSubText(num, c1, 1)
r2 = Text.GetSubText(num, c2, 1)
dc = Math.Abs(c2 - c1)
dr = Math.Abs(r2 - r1)
If dc = dr Then
valid = ”False”
board[r1][Text.GetSubText("abcdefgh", c1, 1)] = ”RQ”
board[r2][Text.GetSubText("abcdefgh", c2, 1)] = ”RQ”
EndIf
EndFor
EndFor
EndSub
Sub DrawBoard
For r = 8 To 1 Step - 1
y = pos["y0"] + (8 - r) * size
For c = 1 To 8
x = pos["x0"] + (c - 1) * size
GraphicsWindow.BrushColor = color[Math.Remainder((c + r), 2)]
GraphicsWindow.FillRectangle(x, y, size, size)
p = board[r][Text.GetSubText("abcdefgh", c, 1)]
If p <> ”" Then
GraphicsWindow.BrushColor = color[Text.GetSubText(p, 1, 1)]
sHex = pieces[Text.GetSubText(p, 2, 1)]
Math_Hex2Dec()
GraphicsWindow.DrawText(x, y - size * 0.12, Text.GetCharacter(iDec))
EndIF
EndFor
EndFor
EndSub
Sub InitChessmen
size = 48 ‘ font height and square size
GraphicsWindow.FontSize = size
pieces = ”P=265F;N=265E;B=265D;R=265C;Q=265B;K=265A;”
EndSub
Sub InitBoard
pos = ”x0=30;y0=30;” ‘ left, top
For c = 1 To 8
board[c][Text.GetSubText("abcdefgh", c, 1)] = ”BQ”
EndFor
color = ”W=White;B=Black;R=Red;0=SaddleBrown;1=BurlyWood;”
InitChessmen()
EndSub
Sub Math_Hex2Dec
‘ Math | Convert sHex to iDec
iDec = 0
iLen = Text.GetLength(sHex)
For iPtr = 1 To iLen
iDec = iDec * 16 + Text.GetIndexOf(“0123456789ABCDEF”, Text.GetSubText(sHex, iPtr, 1)) - 1
EndFor
EndSub
Sub DumpBoard
For r = 8 To 1 Step -1
For c = 1 To 8
If board[r][Text.GetSubText("abcdefgh", c, 1)] <> ”" Then
TextWindow.Write(board[r][Text.GetSubText("abcdefgh", c, 1)] + ” “)
Else
TextWindow.Write(” “)
EndIf
EndFor
TextWindow.WriteLine(“”)
EndFor
EndSub