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