############################################################################
#
#	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