1 files changed, 222 insertions, 0 deletions
diff --git a/ipl/gprogs/vqueens.icn b/ipl/gprogs/vqueens.icn
new file mode 100644
index 0000000..585a682
--- /dev/null
+++ b/ipl/gprogs/vqueens.icn
@@ -0,0 +1,222 @@
+############################################################################
+#
+#	File:     vqueens.icn
+#
+#	Subject:  Program to display solutions to the n-queens problem
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 5, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Adapted from a text-display version by Steve Wampler.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+global solution
+global black_queen, white_queen
+
+$define Edge	 4
+$define Offset  40
+$define Size	44
+
+global queens
+
+procedure main(args)
+   local i, opts, wsize, bqueen, wqueen
+
+   opts := options(args,"n+")
+   queens := \opts["n"] | 8
+   if queens <= 0 then stop("-n needs a positive numeric parameter")
+   wsize := queens * Size + 2 * Offset
+
+
+   WOpen("size=" || wsize || "," || wsize, "label=" || queens ||
+      "-queens") | stop("*** cannot open window")
+   black_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for black queen")
+   white_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for white queen")
+
+   DrawImage(black_queen, 0, 0,
+      "41,c1,_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666664003666666663004666666666666_
+      66666666666650000466666640000566666666666_
+      66666666666640000366666630000466666666666_
+      66666666666660000566666650000666666666666_
+      66666666666665224666666664225666666666666_
+      66663346666666644666666664466666666433666_
+      66620004666666631666666661366666664000266_
+      66600002666666640666666660466666662000066_
+      66600003666666650466666640566666663000066_
+      66640026666666660166666610666666666200466_
+      66666651666666660046666400666666661566666_
+      66666662266666660026666200666666622666666_
+      66666666036666660004663000666666306666666_
+      66666666403666640000220000466663046666666_
+      66666666620266620000000000266620266666666_
+      66666666650002100000000000012000566666666_
+      66666666663000000000000000000003666666666_
+      66666666666000000000000000000006666666666_
+      66666666666300000000000000000036666666666_
+      66666666666500000000000000000056666666666_
+      66666666666610000000000000000166666666666_
+      66666666666630000000000000000366666666666_
+      66666666666652222222222222222566666666666_
+      66666666666664444444444444444666666666666_
+      66666666666640000000000000000466666666666_
+      66666666666651000000000000001566666666666_
+      66666666666664000000000000004666666666666_
+      66666666666651000000000000001566666666666_
+      66666666666640000000000000000466666666666_
+      66666666666664444444444444444666666666666_
+      66666666653222222222222222222223566666666_
+      66666666600000000000000000000000066666666_
+      66666666400000000000000000000000046666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666666666666666666666666666666666666_
+      ")
+
+   DrawImage(white_queen, 0, 0,
+      "41,c1,_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      00000000000026630000000036620000000000000_
+      00000000000166662000000266661000000000000_
+      00000000000266663000000366662000000000000_
+      00000000000066661000000166660000000000000_
+      00000000000014420000000024410000000000000_
+      00033200000000220000000022000000002330000_
+      00466620000000350000000053000000026664000_
+      00666640000000260000000062000000046666000_
+      00666630000000162000000261000000036666000_
+      00266400000000065000000560000000004662000_
+      00000150000000066200002660000000051000000_
+      00000044000000066400004660000000440000000_
+      00000006300000066620036660000003600000000_
+      00000002630000266664466662000036200000000_
+      00000000464000466666666664000464000000000_
+      00000000166645666666666666546661000000000_
+      00000000036666666666666666666630000000000_
+      00000000006666666666666666666600000000000_
+      00000000003666666666666666666300000000000_
+      00000000001666666666666666666100000000000_
+      00000000000566666666666666665000000000000_
+      00000000000366666666666666663000000000000_
+      00000000000144444444444444441000000000000_
+      00000000000022222222222222220000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000026666666666666620000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000022222222222222220000000000000_
+      00000000134444444444444444444431000000000_
+      00000000666666666666666666666666000000000_
+      00000002666666666666666666666666200000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      ")
+
+   DrawBoard()
+
+   solution := list(queens)	# ... and a list of column solutions
+
+   every q(1)			# start by placing queen in first column
+
+   until WQuit()
+
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2 * queens - 1, 0)
+      down := list(2 * queens - 1, 0)
+      rows := list(queens, 0)
+      }
+   every 0 = rows[r := 1 to queens] = up[queens+r-c] = down[r+c-1] &
+      rows[r] <- up[queens+r-c] <- down[r+c-1] <- 1        do {
+         solution[c] := r	# record placement.
+         if c = queens then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   local i, j, queen
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      queen := if (i + j) % 2 = 0 then black_queen else white_queen
+      CopyArea(queen, &window, , , , , Offset + (i - 1) * Size + 1,
+         Offset + (j - 1) * Size + 1)
+      }
+
+   WDelay(500)
+
+   while *Pending() > 0 do {
+      case Event() of {
+         "q":  exit()
+         "p":  until Event() === "c"
+         }
+      }
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      if (i + j) % 2 = 1 then Fg("black") else Fg("white")
+      FillRectangle(Offset + (i - 1) * Size, Offset + (j - 1) * Size,
+         Size, Size)
+      }
+
+   return
+
+end
+
+procedure DrawBoard()
+   local i, j
+
+   every i := 0 to queens - 1 do
+      every j := 0 to queens - 1 do
+         if (i + j) % 2 = 1 then
+            FillRectangle(Offset + i * Size, Offset + j * Size,
+               Size, Size)
+   DrawRectangle(Offset - 1, Offset - 1, queens * Size + 1,
+      queens * Size + 1)
+   DrawRectangle(Offset - Edge - 1, Offset - Edge - 1,
+      queens * Size + 2 * Edge + 1, queens * Size + 2 * Edge + 1)
+
+   return
+
+end