1 /*
   2  * My solution to the n-queens puzzle, one of the classical problems of the
   3  * structural programming. It asks in how many ways you can arrange n chess
   4  * queens on an n-times-n chessboard without breaking the rules that no two 
   5  * chess queens can be in the same row, column or diagonal.
   6  */
   7 
   8 // Import some functions we need to communicate with the outside world from
   9 // JavaScript...
  10 Function printString(CharacterPointer str)
  11   Which Returns Nothing Is External;
  12 Function clearScreen() Which Returns Nothing Is External;
  13 Function shouldWePrintChessBoards() Which Returns Integer32 Is External;
  14 
  15 // Declare the "Queen" structure and write relevant functions.
  16 Structure Queen Consists Of
  17   Integer32 row, column;
  18 EndStructure
  19 
  20 Function areQueensInTheSameColumn(QueenPointer first, QueenPointer second)
  21   Which Returns Integer32 Does
  22     Return first->column = second->column;
  23 EndFunction
  24 
  25 Function areQueensInTheSameRow(QueenPointer first, QueenPointer second)
  26   Which Returns Integer32 Does
  27     Return first->row = second->row;
  28 EndFunction
  29 
  30 Function areQueensOnTheSameDiagonal(QueenPointer first,
  31                                     QueenPointer second)
  32   Which Returns Integer32 Does
  33     Return first->row + first->column = second->row + second->column or
  34            first->row - first->column = second->row - second->column;
  35 EndFunction
  36 
  37 Function areQueensAttackingEachOther(QueenPointer first,
  38                                      QueenPointer second)
  39   Which Returns Integer32 Does
  40     Return areQueensInTheSameRow(first, second) or
  41            areQueensInTheSameColumn(first, second) or
  42            areQueensOnTheSameDiagonal(first, second);
  43 EndFunction
  44 
  45 // Let's write a structure representing an array of queens...
  46 Structure ChessBoard Consists Of
  47   Integer32 length;
  48   Queen queens[12]; // There are too many solutions for over 12 queens.
  49 EndStructure
  50 
  51 Function chessBoardContainsThatQueen(ChessBoardPointer chessBoard,
  52                                       QueenPointer queen)
  53                                       Which Returns Integer32 Does
  54   Integer32 i := 0;
  55   While i < chessBoard->length Loop
  56     If chessBoard->queens[i].column = queen->column and
  57        chessBoard->queens[i].row    = queen->row    Then
  58       Return 1;
  59     EndIf
  60     i += 1;
  61   EndWhile
  62   Return 0;
  63 EndFunction
  64 
  65 // Now, let's forward-declare the functions we will write later.
  66 // Putting them here would make the code less legible.
  67 Function recursiveFunction(ChessBoardPointer chessBoard,
  68                            Integer32 n) Which Returns Integer32 Is Declared;
  69 
  70 Function convertIntegerToString(CharacterPointer str,
  71                                 Integer32 n)
  72   Which Returns Nothing Is Declared;
  73 
  74 Function strcat(CharacterPointer dest,
  75                 CharacterPointer src) Which Returns Nothing Is Declared;
  76 
  77 Function strlen(CharacterPointer str) Which Returns Integer32 Is Declared;
  78 
  79 // Let's write the function that JavaScript is supposed to call...
  80 Function nQueensPuzzle(Integer32 n) Which Returns Integer32 Does
  81   clearScreen();
  82   If n < 1 or n > 12 Then
  83     printString("Please enter a number between 1 and 12!");
  84     Return -1;
  85   EndIf
  86   InstantiateStructure ChessBoard chessBoard;
  87   Character stringToBePrinted[64] := {0};
  88   CharacterPointer stringToBePrinted := AddressOf(stringToBePrinted[0]);
  89   strcat(stringToBePrinted, "Solving the n-queens puzzle for ");
  90   convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted),
  91                          n);
  92   strcat(stringToBePrinted,":\n");
  93   printString(stringToBePrinted);
  94   Integer32 result := recursiveFunction(AddressOf(chessBoard), n);
  95   stringToBePrinted[0] := 0;
  96   strcat(stringToBePrinted, "Found ");
  97   convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted),
  98                          result);
  99   strcat(stringToBePrinted, " solutions!");
 100   printString(stringToBePrinted);
 101   Return result;
 102 EndFunction
 103 
 104 // I guess moving this code out of "recursiveFunction" makes the
 105 // code more legible.
 106 Function printAsASolution(ChessBoardPointer chessBoard)
 107   Which Returns Nothing Does
 108     Character stringToBePrinted[64] := {0};
 109     Character stringToBeAdded[8];
 110     Integer32 i := 0;
 111     While i < chessBoard->length Loop
 112       stringToBeAdded[0] := 'A' + chessBoard->queens[i].column;
 113       convertIntegerToString(AddressOf(stringToBeAdded[1]),
 114                              chessBoard->queens[i].row + 1);
 115       strcat(AddressOf(stringToBeAdded[0]), " ");
 116       strcat(AddressOf(stringToBePrinted[0]),
 117              AddressOf(stringToBeAdded[0]));
 118       i += 1;
 119     EndWhile
 120     strcat(AddressOf(stringToBePrinted[0]), "\n");
 121     printString(AddressOf(stringToBePrinted[0]));
 122     If shouldWePrintChessBoards() Then
 123         stringToBePrinted[0] := 0;
 124         CharacterPointer stringToBePrinted := AddressOf(stringToBePrinted[0]);
 125         strcat(stringToBePrinted, "  +");
 126         i := 0;
 127         While i < chessBoard->length Loop
 128           strcat(stringToBePrinted, "-+");
 129           i += 1;
 130         EndWhile
 131         strcat(stringToBePrinted, "\n");
 132         printString(stringToBePrinted);
 133         i := chessBoard->length;
 134         While i > 0 Loop
 135           stringToBePrinted[0] := 0;
 136           // Align the row numbers to the right.
 137           If i < 10 Then
 138             strcat(stringToBePrinted, " ");
 139           EndIf
 140           convertIntegerToString(stringToBePrinted + strlen(stringToBePrinted), i);
 141           strcat(stringToBePrinted, "|");
 142           Integer32 j := 0;
 143           While j < chessBoard->length Loop
 144             InstantiateStructure Queen newQueen;
 145             newQueen.column :=     j;
 146             newQueen.row    := i - 1;
 147             strcat(stringToBePrinted,
 148                    chessBoardContainsThatQueen(chessBoard, AddressOf(newQueen))?
 149                    "Q|":
 150                    mod(i + j - 1, 2)?
 151                    " |": // White field.
 152                    "*|"  // Black field.
 153             );
 154             j += 1;
 155           EndWhile
 156           strcat(stringToBePrinted, "\n");
 157           printString(stringToBePrinted);
 158           stringToBePrinted[0] := 0;
 159           strcat(stringToBePrinted, "  +");
 160           j := 0;
 161           While j < chessBoard->length Loop
 162             strcat(stringToBePrinted, "-+");
 163             j += 1;
 164           EndWhile
 165           strcat(stringToBePrinted, "\n");
 166           printString(stringToBePrinted);
 167           i -= 1;
 168         EndWhile
 169         stringToBePrinted[0] := 0;
 170         CharacterPointer stringToBeAdded := AddressOf(stringToBeAdded[0]);
 171         stringToBeAdded[2] := 0;
 172         stringToBeAdded[0] := ' ';
 173         strcat(stringToBePrinted, "  ");
 174         i := 0;
 175         While i < chessBoard->length Loop
 176           stringToBeAdded[1] := 'A' + i;
 177           strcat(stringToBePrinted, stringToBeAdded);
 178           i += 1;
 179         EndWhile
 180         strcat(stringToBePrinted, "\n");
 181         printString(stringToBePrinted);
 182     EndIf
 183 EndFunction
 184 
 185 // Now, let's implement the brute-force algorithm.
 186 Function recursiveFunction(ChessBoardPointer chessBoard,
 187                            Integer32 n) Which Returns Integer32 Does
 188   // First, do some sanity checks useful for debugging...
 189   If chessBoard->length > n Then
 190     printString("Bug: Chessboard length too large!");
 191     Return 0;
 192   EndIf
 193   Integer32 i := 0, j := 0;
 194   While i < chessBoard->length Loop
 195     If chessBoard->queens[i].column < 0 or
 196        chessBoard->queens[i].row    < 0 or
 197        chessBoard->queens[i].column > n or
 198        chessBoard->queens[i].row    > n Then
 199       printString("Bug: Corrupt chessboard!");
 200       Return 0;
 201     EndIf
 202     i += 1;
 203   EndWhile
 204   // Check if there is a contradiction (queens attacking
 205   // each other) in what we have thus far...
 206   i := j := 0;
 207   While i < chessBoard->length Loop
 208     j := i + 1;
 209     While j < chessBoard->length Loop
 210       If not(i = j) and areQueensAttackingEachOther(
 211                           AddressOf(chessBoard->queens[i]),
 212                           AddressOf(chessBoard->queens[j])
 213                         ) Then
 214         Return 0;
 215       EndIf
 216       j += 1;
 217     EndWhile
 218     i += 1;
 219   EndWhile
 220   // Check if this is a solution...
 221   If chessBoard->length = n Then
 222     printAsASolution(chessBoard);
 223     Return 1;
 224   EndIf
 225   // If this is not a complete solution, but there are no contradictions
 226   // in it, branch the recursion into searching for complete solutions
 227   // based on this one.
 228   Integer32 result := 0;
 229   i := 0;
 230   While i<n Loop
 231     InstantiateStructure ChessBoard newChessBoard := ValueAt(chessBoard);
 232     newChessBoard.length += 1;
 233     newChessBoard.queens[chessBoard->length].column := chessBoard->length;
 234     newChessBoard.queens[chessBoard->length].row := i;
 235     result += recursiveFunction(AddressOf(newChessBoard), n);
 236     i += 1;
 237   EndWhile
 238   Return result;
 239 EndFunction
 240 
 241 // Now go the helper functions related to string manipulation,
 242 // copied from the Dragon Curve program. They are named the same
 243 // as the corresponding functions in the standard C library.
 244 Function strlen(CharacterPointer str) Which Returns Integer32 Does
 245      Integer32 length := 0;
 246      While ValueAt(str + length) Loop
 247          length := length + 1;
 248      EndWhile
 249      Return length;
 250 EndFunction
 251 
 252 Function strcpy(CharacterPointer dest,
 253                 CharacterPointer src) Which Returns Nothing Does
 254     While ValueAt(src) Loop
 255         ValueAt(dest) := ValueAt(src);
 256         dest          :=     dest + 1;
 257         src           :=      src + 1;
 258      EndWhile
 259     ValueAt(dest) := 0;
 260 EndFunction
 261 
 262 Function strcat(CharacterPointer dest,
 263                 CharacterPointer src) Which Returns Nothing Does
 264     strcpy(dest + strlen(dest), src);
 265 EndFunction
 266 
 267 Function reverseString(CharacterPointer string) Which Returns Nothing Does
 268     CharacterPointer pointerToLastCharacter := string + strlen(string) - 1;
 269     While pointerToLastCharacter - string > 0 Loop
 270         Character tmp                   := ValueAt(string);
 271         ValueAt(string)                 := ValueAt(pointerToLastCharacter);
 272         ValueAt(pointerToLastCharacter) := tmp;
 273         string                          := string + 1;
 274         pointerToLastCharacter          := pointerToLastCharacter - 1;
 275     EndWhile
 276 EndFunction
 277 
 278 Function convertIntegerToString(CharacterPointer string,
 279                                 Integer32 number)
 280     Which Returns Nothing Does
 281     Integer32 isNumberNegative := 0;
 282     If number < 0 Then
 283         number           := -number;
 284         isNumberNegative :=       1;
 285     EndIf
 286     Integer32 i := 0;
 287     While number > 9 Loop
 288         ValueAt(string + i) := '0' + mod(number, 10);
 289         number              :=           number / 10;
 290         i                   :=                 i + 1;
 291     EndWhile
 292     ValueAt(string + i) := '0' + number;
 293     i                   :=        i + 1;
 294     If isNumberNegative Then
 295         ValueAt(string + i) :=   '-';
 296         i                   := i + 1;
 297     EndIf
 298     ValueAt(string + i) := 0;
 299     reverseString(string);
 300 EndFunction
 301