(define allqueens
  (lambda (n doneproc)
    (letrec
        ((diag1
          (lambda (board col)
            (if (null? board) '()
                (cons (+ col (car board)) 
                      (diag1 (cdr board) (+ col 1))))))
         (diag2
          (lambda (board col)
            (if (null? board) '()
                (cons (- col (car board)) 
                      (diag2 (cdr board) (+ col 1))))))
         (consistent?
          (lambda (board col new)
            (not
             (or (member new board)
                 (member (+ col new) 
                         (diag1 board 1))
                 (member (- col new)
                         (diag2 board 1))))))
         (check
          (lambda (board col)
            (if (> col n) (doneproc board)
                (for-each 
                 (lambda (row)
                   (if (consistent? board col row)
                       (check (append board (list row))
                              (+ 1 col))))
                 (list-n n))))))
      (check '() 1))))

(define queens
  (lambda (n)
    (letrec
	((y-reflect reverse)
	 (rotate
	  (lambda (board)
	    (map
	     (lambda (row)
	       (- (+ 1 n) (length (member row board))))
	     (list-n n))))
	 (symmetries
	  (lambda (board)
	    (list
	     board 
	     (rotate board)
	     (rotate (rotate board))
	     (rotate (rotate (rotate board)))
	     (y-reflect board)
	     (rotate (y-reflect board))
	     (rotate (rotate (y-reflect board)))
	     (rotate (rotate (rotate (y-reflect board)))))))
	 (result '())
	 (new?
	  (lambda (rlist sol)
	    (if (null? rlist) #t
		(if (member sol (car rlist)) #f
		    (new? (cdr rlist) sol))))))
      (allqueens 
       n
       (lambda (sol)
         (if (new? result sol)
             (set! result (cons (symmetries sol) result)))))
      (map car result))))

(define queenspic
  (lambda (n)
    (let* ((scale 30) (radius (/ scale 3)))
      (for-each
       (lambda (sol)
	 (letrec
	     ((drawqueens
	       (lambda (pos sol)
		 (if (not (null? sol))
		     (begin
		       (draw-move pos (- (* (car sol) scale) (/ scale 2)))
		       (fill-circle radius)
		       (drawqueens (+ pos scale) (cdr sol))))))
	      (drawlines
	       (lambda (m)
		 (draw-move 0 (* m scale))
		 (draw-line (* n scale) (* m scale))
		 (draw-move (* m scale) 0)
		 (draw-line (* m scale) (* n scale))
		 (if (not (zero? m))
		     (drawlines (- m 1))))))
	   (draw-color 255 0 0)
	   (drawqueens 15 sol)
	   (draw-color 0 0 0)
	   (drawlines n)
	   (draw-show)))
       (queens n)))))

(queenspic 5)