home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROGS.ZIP / VNQ.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  3.8 KB  |  158 lines
  1. ############################################################################
  2. #
  3. #    File:     vnq.icn
  4. #
  5. #    Subject:  Program to display solutions to n-queens problem
  6. #
  7. #    Author:   Stephen B. Wampler
  8. #
  9. #    Date:     December 12, 1989
  10. #
  11. ###########################################################################
  12. #
  13. #  Links: options
  14. #
  15. ############################################################################
  16.  
  17. link options
  18.  
  19. global n, nthq, solution, goslow, showall, line, border
  20.  
  21. procedure main(args)
  22. local i, opts
  23.  
  24.    opts := options(args, "sah")  
  25.    n := integer(get(args)) | 8    # default is 8 queens
  26.    if \opts["s"] then goslow := "yes"
  27.    if \opts["a"] then showall := "yes"
  28.    if \opts["h"] then helpmesg()
  29.  
  30.    line := repl("|   ", n) || "|"
  31.    border := repl("----", n) || "-"
  32.    clearscreen()
  33.    movexy(1, 1)
  34.    write()
  35.    write("  ", border)
  36.    every 1 to n do {
  37.       write("  ", line)
  38.       write("  ", border)
  39.       }
  40.  
  41.    nthq := list(n+2)    # need list of queen placement routines
  42.    solution := list(n)    # ... and a list of column solutions
  43.  
  44.    nthq[1] := &main    # 1st queen is main routine.
  45.    every i := 1 to n do    # 2 to n+1 are real queen placement
  46.       nthq[i+1] := create q(i)    #    routines, one per column.
  47.    nthq[n+2] := create show()    # n+2nd queen is display routine.
  48.  
  49.    write(n, "-Queens:")
  50.    @nthq[2]    # start by placing queen in first colm.
  51.  
  52.    movexy(1, 2 * n + 5)
  53. end
  54.  
  55. # q(c) - place a queen in column c (this is c+1st routine).
  56. procedure q(c)
  57. local r 
  58. static up, down, rows
  59.  
  60.    initial {
  61.       up := list(2 * n -1, 0)
  62.       down := list(2 * n -1, 0)
  63.       rows := list(n, 0)
  64.       }
  65.  
  66.    repeat {
  67.       every (0 = rows[r := 1 to n] = up[n + r - c] = down[r + c -1] &
  68.             rows[r] <- up[n + r - c] <- down[r + c -1] <- 1) do {
  69.          solution[c] := r    # record placement.
  70.          if \showall then {
  71.             movexy(4 * (r - 1) + 5, 2 * c + 1)
  72.             writes("@")
  73.             }
  74.          @nthq[c + 2]    # try to place next queen.
  75.          if \showall then {
  76.             movexy(4  * (r - 1) + 5, 2 * c + 1)
  77.             writes(" ")
  78.             }
  79.          }
  80.       @nthq[c]    # tell last queen placer 'try again'
  81.       }
  82.  
  83. end
  84.  
  85. # show the solution on a chess board.
  86.  
  87. procedure show()
  88.    local c
  89.    static count, lastsol
  90.  
  91.    initial {
  92.       count := 0
  93.       }
  94.  
  95.    repeat {
  96.       if /showall & \lastsol then {
  97.          every c := 1 to n do {
  98.             movexy(4 * (lastsol[c] - 1) + 5, 2 * c + 1)
  99.             writes(" ")
  100.             }
  101.          }
  102.       movexy(1, 1)
  103.       write("solution: ", right(count +:= 1, 10))
  104.       if /showall then {
  105.          every c := 1 to n do {
  106.             movexy(4 * (solution[c] - 1) + 5, 2 * c + 1)
  107.             writes("Q")
  108.             }
  109.          lastsol := copy(solution)
  110.          }
  111.       if \goslow then {
  112.          movexy(1, 2 * n + 4)
  113.          writes("Press return to see next solution:")
  114.          read() | {
  115.             movexy(1, 2 * n + 5)
  116.             stop("Aborted.")
  117.          }
  118.          movexy(1, 2 * n + 4)
  119.          clearline()
  120.          }
  121.  
  122.       @nthq[n+1]                          # tell last queen placer to try again
  123.       }
  124.  
  125. end
  126.  
  127. procedure helpmesg()
  128.    write(&errout, "Usage: vnq [-s] [-a] [n]")
  129.    write(&errout, "    where -s means to stop after each solution, ")
  130.    write(&errout, "          -a means to show placement of every queen")
  131.    write(&errout, "              while trying to find a solution")
  132.    write(&errout, "      and  n is the size of the board (defaults to 8)")
  133.    stop()
  134. end
  135.  
  136. # Move cursor to x, y
  137. #
  138. procedure movexy (x, y)
  139.    writes("\^[[", y, ";", x, "H")
  140.    return
  141. end
  142.  
  143. #
  144. # Clear the text screen
  145. #
  146. procedure clearscreen()
  147.    writes("\^[[2J")
  148.    return
  149. end
  150.  
  151. #
  152. # Clear the rest of the line
  153. #
  154. procedure clearline()
  155.    writes("\^[[2K")
  156.    return
  157. end
  158.