home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / EXAMPLES / QUEENS.LF < prev    next >
Text File  |  1996-06-04  |  7KB  |  287 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. % Copyright 1992 Digital Equipment Corporation
  4. % All Rights Reserved
  5. %
  6. % A self-contained LIFE program for solving the N-queens problem,
  7. %    including an X interface for showing solutions.
  8. %
  9. %
  10. % The N-queens problem:
  11. %    place N queens on an NxN chessboard so that no two queens
  12. %    are in the same row, or same column, or same diagonal.
  13. %
  14. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  15.  
  16.  
  17. %
  18. % Notes:
  19. %
  20. % 1. Type "queens?" to start the program.
  21. %
  22. % 2. By default, the program finds solutions for the 8-queens problem.
  23. %    To find solutions for a different number of queens, for example
  24. %    4 queens, type "queens(4)?".
  25. %
  26. % 3. The program will stop after drawing the X-window and the chessboard
  27. %    before finding the first solution. Use backtracking thereafter to
  28. %    get each solution.
  29. %
  30. % 4. Backtracking may be done either in the usual manner by typing ";"
  31. %    at the Wild_LIFE prompt, or else by clicking any mouse button or
  32. %    typing any key while the pointer is in the X-window.
  33. %
  34. % 5. The program employs a "generate-then-test" strategy, that is,
  35. %    a position for each queen is generated then tested against the
  36. %    positions of already placed queens. Therefore, this program does
  37. %    not differ logically from its straight Prolog counterpart.
  38. %
  39. % 6. On an 8x8 board, the program draws a capital Greek letter Psi for
  40. %    a queen. On any other size board, the program draws a solid oval.
  41. %    If your system has the MIT chess font "chs-s50", you can obtain a
  42. %    real queen on an 8x8 board by making the following two changes:
  43. %    a) change the string
  44. %    "-*-symbol-*-*-*-*-*-240-*-*-*-*-*-*"
  45. %    to be "chs-s50" in the call: setq_font (chessfont, "...")
  46. %    b) change the string "Y" to be "b"
  47. %    in the call: setq (queensymbol, "Y")
  48. %
  49.  
  50. module("queens") ?
  51. public(queens) ?
  52.  
  53. import("xtools") ?
  54.  
  55. queens :-
  56.     (
  57.         C1 = get_choice,
  58.         same_size(L:[push_button(text => "quit",
  59.                          action => (set_choice(C1),fail)),
  60.              text_field_button(offset => -5,text => N:"8",
  61.                                action => t_act(Choice))]),
  62.             create_box(Panel:panel(title => "Queens") containing
  63.                                                   vl_list L),
  64.         play_queens(Choice,N,Panel)
  65.     ;
  66.         succeed
  67.     ).
  68.  
  69. t_act(Choice) :- 
  70.     set_choice(Choice),
  71.     fail.
  72.  
  73. play_queens(Choice,N,Panel) :-
  74.     (
  75.         Choice <- get_choice,
  76.         parse(N) = M,
  77.         draw_window (M,Panel,QueensWindow), 
  78.         (
  79.         succeed    %% stop before finding the first solution
  80.         ;
  81.             place_queens ([], interval(1,M), interval(1,M), QueensWindow)
  82.         )
  83.     ;
  84.         play_queens(Choice,N,Panel,QueensWindow)
  85.     ).
  86.  
  87.  
  88. %
  89. %    Draw the board
  90. %    
  91.  
  92. draw_board(Window) :-
  93. xFillRectangle(Window,X:scale(0),X,L,L,color => q_white),
  94.     draw_squares (0,Window),
  95.     xDrawRectangle (Window,
  96.             U : unit, U,
  97.             L : scale(n-1), L,
  98.             linewidth => 8),
  99.     xDrawRectangle (Window,
  100.             U, U,
  101.             L, L,
  102.             linewidth => 1,
  103.             color => q_white).
  104.  
  105. draw_squares (n) :- !.
  106. draw_squares (Y,Window)    :-
  107.     (
  108.         draw_row ((Y+1) mod 2,Y,Window),fail
  109.     ;
  110.         draw_squares (Y+1,Window)
  111.     ).
  112.  
  113. draw_row ({N:n;N+1}) :- !.
  114. draw_row (X,Y,Window) :-
  115.     xFillRectangle (Window,
  116.             scale(X), scale(Y),
  117.             U:unit, U,
  118.             color => q_black),
  119.     draw_row (X+2,Y,Window).
  120.  
  121.  
  122.  
  123.  
  124. %
  125. %    Place a queen: take an empty row X and choose an empty column Y.
  126. %    Check whether this X and Y clashes on a diagonal with any of the
  127. %    already placed queens. If no clash, draw a queen at X,Y and repeat the
  128. %    procedure with the other empty rows and columns. If there is a clash,
  129. %    then backtrack first through the values for Y then through the values
  130. %    for X.
  131. %
  132.  
  133. place_queens (Queens, [], []).
  134. place_queens (Queens, [X|Rows], Cols, Window) :-
  135.     choose_one (Y, from => Cols, rest => RestCols),
  136.     check_diagonals (X, Y, Queens),
  137.     draw_queen (X,Y,Window),
  138.     place_queens ([(X,Y)|Queens], Rows, RestCols,Window).
  139.  
  140.  
  141.  
  142.  
  143. check_diagonals (X, Y, []) :- !.
  144. check_diagonals (X, Y, [(X1,Y1)|Queens]) :-
  145.         X+Y =\= X1+Y1,
  146.         X-Y =\= X1-Y1,
  147.     check_diagonals (X, Y, Queens).
  148.  
  149.  
  150.  
  151.  
  152. %
  153. %    Draw a queen: the first disjunction draws a queen at row X, column Y;
  154. %    the second disjunction erases her.
  155. %    
  156.  
  157. draw_queen (X,Y,Window) :-
  158.     (
  159.       cond (N:n =:= 8,
  160.         xDrawString (Window,
  161.                  X1 : (scale(A:(X-1)) + 0.22 * U:unit),
  162.                  Y1 : (scale(B:(Y-1)) + 0.65 * U),
  163.                  queensymbol,
  164.                  font  => ChessFont:chessfont,
  165.                  color => QueenColor:queencolor),
  166.         xFillOval   (Window,
  167.                  X2 : (scale(A) + O:offset),
  168.                  Y2 : (scale(B) + O),
  169.                  H  : (unit - 2*O),
  170.                  H,
  171.                  color => QueenColor))
  172.     ;
  173.       cond (N =:= 8,
  174.         xDrawString (Window,
  175.                  X1,
  176.                  Y1,
  177.                  queensymbol,
  178.                  font  => ChessFont,
  179.                  color => BoardColor:boardcolor(A,B)),
  180.         xFillOval   (Window,
  181.                  X2,
  182.                  Y2,
  183.                  H,
  184.                  H,
  185.                  color => BoardColor)),
  186.       fail
  187.     ).
  188.  
  189.  
  190.  
  191.  
  192.  
  193. %
  194. %    Global variables and auxiliary routines:
  195. %    - various parameters for the size of the board and queens
  196. %         depending on the number of queens (n)
  197. %       - the color of the board at row X, column Y.
  198. %    - a distribution of integers in a given interval
  199. %      biased towards the center of the interval.
  200. %    - a nondeterministic routine for choosing an element from a list.
  201. %
  202.  
  203. persistent(n) ?
  204.  
  205. global(offset <- 5) ?
  206. unit      -> floor(2 * (100 / S:n * log(1+S))).
  207. scale (N) -> unit * (N+1).
  208.  
  209.  
  210. boardcolor (X,Y) ->
  211.     cond (((X+Y) mod 2) =:= 0, q_white, q_black).
  212.  
  213.  
  214. interval (From, To) ->
  215.     cond (From < To,
  216.           append (interval(From+1,To-1), [From,To]),
  217.           cond (From =:= To, [From], [])).
  218.     
  219.  
  220. choose_one (from => []) :- !, fail.
  221. choose_one (H, from => [H|T], rest => T).
  222. choose_one (X, from => [H|T], rest => [H|L]) :- 
  223.     choose_one (X, from => T, rest => L).
  224.  
  225.  
  226.  
  227.  
  228. %
  229. %    The X interface:
  230. %    - draw the window
  231. %       - get the colors of the board and queens, and the chess font
  232. %    - the event handler
  233. %
  234.  
  235. global(event_mask <- xExposureMask \/ xButtonPressMask \/ xKeyPressMask) ?
  236.  
  237. resize_window(Window,NW,NH) :-
  238.     xResizeWindowPixmap(Window,NW,NH),
  239.     xSetWindowWidth(Window,NW),
  240.     xSetWindowHeight(Window,NH).
  241.  
  242.  
  243. draw_window (N,Panel,QueensWindow) :-
  244.     n <<- N,
  245.     xCreateWindow (default_display,
  246.                X0:(Panel.width + 10),5,
  247.                W:scale(N + 1),W,
  248.                QueensWindow,
  249.                color => xWhite,
  250.                border => 0,
  251.                parent => Window:(Panel.window),
  252.                eventmask => event_mask),
  253.     resize_window(Window, X0 + W, max(W,Panel.height)),
  254.     draw_board(QueensWindow),        
  255.     event_handler(QueensWindow).
  256.  
  257. %
  258. %    If a keyboard or mouse event arrives, the event_handler fails,
  259. %    making the program backtrack.
  260. %
  261.  
  262. event_handler(Window) -> 
  263.     handle_event (xGetEvent (Window,
  264.                      eventmask => event_mask),
  265.               Window).
  266.  
  267. handle_event (expose_event,Window) -> true |
  268.     xRefreshWindow (Window), event_handler(Window).
  269.  
  270.  
  271.  
  272.  
  273. %
  274. %    Actions executed when the file is loaded
  275. %
  276.  
  277. n <<- 8 ?
  278.  
  279. global(q_white <- new_color(180, 224, 201)),
  280. global(q_black <- new_color(19, 123, 103) ),
  281. global(queencolor <- new_color(204, 125, 50)),
  282. global(chessfont <- new_font("-*-symbol-*-*-*-*-*-240-*-*-*-*-*-*")),
  283. global(queensymbol <- "Y") ?
  284.             %% If your system has the MIT chess font "chs-s50"
  285.             %% installed, change the previous two lines to
  286.             %%    load_font(Chessfont, "chs-s50"),
  287.             %%    global(queensymbol <- "b").