home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / prolog68 / queens.pl < prev    next >
Encoding:
Text File  |  1993-10-23  |  1.3 KB  |  58 lines
  1. %         Demonstrationsprogramm für Prolog-68
  2. %
  3. %         Copyright © 1990,91,92 Jens Kilian.
  4.  
  5. test :- queens(5).
  6.  
  7. queens(N) :-
  8.    queens(N, N, Solution),
  9.    show_solution(N, 0, Solution),
  10.    fail.
  11.  
  12. queens(0, N, []).
  13. queens(M, N, [Pos | Board]) :-
  14.    M > 0, M1 is M - 1,
  15.    queens(M1, N, Board),
  16.    range(1, Pos, N),
  17.    check_solution(Board, 0, Pos).
  18.  
  19. range(I, I, I) :- !.
  20. range(I, J, K) :-
  21.    L is (I+K) / 2,
  22.    range(I, J, L).
  23. range(I, J, K) :-
  24.    L is 1 + (I+K) / 2,
  25.    range(L, J, K).
  26.  
  27. check_solution([], _, _).
  28. check_solution([Place | Board], Distance, Pos) :-
  29.    Dist1 is Distance + 1,
  30.    check_place(Place, Dist1, Pos),
  31.    check_solution(Board, Dist1, Pos).
  32.  
  33. check_place(Place, Distance, Pos) :-
  34.    Place =\= Pos - Distance,
  35.    Place =\= Pos,
  36.    Place =\= Pos + Distance.
  37.  
  38. show_solution(N, N, _) :- !, nl.
  39. show_solution(N, M, Solution) :-
  40.    F is M and 1,
  41.    M1 is M + 1,
  42.    show_line(Solution, M1, F),
  43.    show_solution(N, M1, Solution).
  44.  
  45. show_line([], _, _) :- nl.
  46. show_line([P | S], P, F) :- !,
  47.    F1 is 1 - F,
  48.    field(F, 42),
  49.    show_line(S, P, F1).
  50. show_line([_ | S], P, F) :-
  51.    F1 is 1 - F,
  52.    field(F, 32),
  53.    show_line(S, P, F1).
  54.  
  55. field(0, C) :- put(C), put(C).
  56. field(1, C) :- put(27), put(112), put(C), put(C), put(27), put(113).
  57.  
  58.