DouKaku?

;; -*- coding: euc-jp -*-
(use srfi-27)
(use srfi-42)
(use util.combinations)

(random-source-randomize! default-random-source)

(define-constant N -1)
(define-constant S  1)
(define-constant W -2)
(define-constant E  2)

(define (dir->mask d) (ash 1 (+ d 2)))

(define-constant NMASK (dir->mask N))
(define-constant SMASK (dir->mask S))
(define-constant WMASK (dir->mask W))
(define-constant EMASK (dir->mask E))

(define-macro (trials from)
  (define (gen-combs src)
    (list->vector (permutations src)))
  `(vector-ref (case ,from
                 ((,N) ',(gen-combs `(,S ,W ,E)))
                 ((,S) ',(gen-combs `(,N ,W ,E)))
                 ((,W) ',(gen-combs `(,N ,S ,E)))
                 ((,E) ',(gen-combs `(,N ,S ,W))))
               (random-integer 6)))

(define (maze n m)
  (let1 tab (make-vector (* n m) 0)
    (let-syntax [(maze-ref
                  (syntax-rules ()
                    [(_ x y) (vector-ref tab (+ x (* y n)))]))
                 (maze-flag-ior!
                  (syntax-rules ()
                    [(_ x y d)
                     (let1 i (+ x (* y n))
                       (vector-set! tab i (logior (vector-ref tab i)
                                                  (dir->mask d))))]))]
      (define (dig x y d)
        (receive (dx dy) (quotient&remainder d 2)
          (let ((nx (+ x dx)) (ny (+ y dy)))
            (cond [(and (<= 0 nx) (< nx n) (<= 0 ny) (< ny m)
                        (= 0 (maze-ref nx ny)))
                   (maze-flag-ior! x y d)
                   (maze-flag-ior! nx ny (- d))
                   (rec nx ny (- d))]
                  [else #f]))))
      (define (rec x y from)
        (let loop ((ds (trials from)))
          (unless (null? ds)
            (dig x y (car ds))
            (loop (cdr ds)))))
      (rec 0 0 N)
      tab)))

(define (show-maze n m)
  (let1 tab (maze n m)
    (do-ec (: y 0 (* n m) n)
           (begin
             (dotimes (x n)
               (display (if (= 0 (logand NMASK (vector-ref tab (+ x y))))
                          "■■" "■\u3000")))
             (display "■\n")
             (dotimes (x n)
               (display (if (= 0 (logand WMASK (vector-ref tab (+ x y))))
                          "■\u3000" "\u3000\u3000")))
             (display "■\n")))
    (dotimes (x n) (display "■■"))
    (display "■\n")))