不思議なダンジョン自動生成

(追記)javascriptで書き直しました -> id:Gemma:20070816
Gaucheで書いた、ダンジョン自動生成プログラム。http://racanhack.sourceforge.jp/rhdoc/index.html と同じアルゴリズム
解説を書こうと思いつつも、すでに2週間放置しているので、先にコードだけ公開しておきます。

(use srfi-1)
(use srfi-43)
(use util.combinations)
(use util.list)
(use util.match)

(define-constant dng-width 80)
(define-constant dng-height 40)

(define (random-range a b)
  (cond 
   ((> a b) (error "error" a b))
   ((= a b) a)
   (else (+ (modulo (sys-random) (abs (- b a))) (min a b)))))

(define (x0 rect) (first rect))
(define (y0 rect) (second rect))
(define (x1 rect) (third rect))
(define (y1 rect) (fourth rect))
(define (width rect) (- (x1 rect) (x0 rect)))
(define (height rect) (- (y1 rect) (y0 rect)))
(define (half a) (quotient a 2))
(define (center-x rect) (half (+ (x1 rect) (x0 rect))))
(define (center-y rect) (half (+ (y1 rect) (y0 rect))))

(define (range2d rect) 
  (match rect
    ((x0 y0 x1 y1)
     (cartesian-product (list (iota (+ 1 (abs (- x1 x0))) (min x0 x1)) (iota (+ 1 (abs (- y1 y0))) (min y0 y1)))))))

(define (dungeon-print mat)
  (for-each (lambda (li)
	      (for-each (lambda (c)
			  (display (if c
				       #\#
				       #\space)))
			li)
	      (newline))
	    (slices (vector->list mat) dng-width))
  (newline))

(define (split rect)
  (define margin 6)
  (if (or (< (width rect) (* margin 2))
	  (< (height rect) (* margin 2))
	  (= (random-range 0 5) 0))
      (list rect)
      (match rect
	((x0 y0 x1 y1)
	 (concatenate (map split (cond 
				  ((= (random-range 0 2) 0)
				   (let1 a (random-range (+ y0 margin) (- y1 margin))
				     (list (list x0 y0 x1 a) (list x0 a x1 y1))))
				  (else
				   (let1 a (random-range (+ x0 margin) (- x1 margin))
				     (list (list x0 y0 a y1) (list a y0 x1 y1)))))))))))

(define (coord->index coord)
  (match coord
    ((x y)
     (+ (* y dng-width) x))))
  
(define (draw-area! mat rect)
  (for-each (lambda (coord)
	      (vector-set! mat (coord->index coord) #t))
	    (range2d rect)))

(define (corrider! mat partitions rooms)
  (for-each (lambda (p0 r0 p1 r1)
	      (cond 
	       ((= (y1 p0) (y0 p1))
		(let ((a (random-range (x0 r0) (x1 r0)))
		      (b (random-range (x0 r1) (x1 r1))))
		  (draw-area! mat (list a (center-y p0)
					a (y1 p0)))
		  (draw-area! mat (list b (center-y p1)
					b (y0 p1)))
		  (draw-area! mat (list a (y1 p0)
					b (y0 p1)))))
	       ((= (x1 p0) (x0 p1))
		(let ((a (random-range (y0 r0) (y1 r0)))
		      (b (random-range (y0 r1) (y1 r1))))
		  (draw-area! mat (list (center-x r0) a
					(x1 p0) a))
		  (draw-area! mat (list (center-x r1) b
					(x0 p1) b))
		  (draw-area! mat (list (x1 p0) a
					(x0 p1) b))))))
	    partitions rooms (cdr partitions) (cdr rooms)))

(define (test)
  (define mat (make-vector (* dng-width dng-height) #f))
  (sys-srandom (sys-time))
  (let1 partitions (split (list 0 0 (- dng-width 1) (- dng-height 1)))
    (let1 rooms (map (lambda (p)
		       (match p
			 ((x0 y0 x1 y1)
			  (list (+ x0 (random-range 2 (- (half (width p)) 1)))
				(+ y0 (random-range 2 (- (half (height p)) 1)))
				(- x1 (random-range 2 (- (half (width p)) 1)))
				(- y1 (random-range 2 (- (half (height p)) 1)))))))
		     partitions)
      (for-each (lambda (r)
		  (draw-area! mat r))
		rooms)
      (corrider! mat partitions rooms)))
  (dungeon-print mat))

(test)

出力はこうなります。

                                               #########                        
                                          ##############    #####               
                                          #    #########    #####   ###   ####  
                                      ### #    #########    #####   ###   ####  
     #############################    ### #        #        ####### ###   ####  
     #############################    ### #      ###        ##### # ###   ####  
     #############################    ### #      #          ##### #####   ####  
     #############################    ### #      #        #######   ###   ####  
     #############################    ### #      #        # #####   ##########  
     #############################    ### #      #        # #####   ###   ####  
     #############################    ### #      #        #               ####  
     #############################  ##### # ############  #                 #   
                              #     # ### # ############  #                 #   
                              #     # ### # ############  #    ##############   
      #########################     # ##### ############  #    #                
      #                             # ###   ############  #    #                
    ##########                      # ###   ############  #    #                
    ##########                      # ###   ############  #    #                
    ##########                      # ###   ############  #    #                
    ##########                      # ###   ############  #    #                
          #     ##################  # ###   ############  #   ################  
   ########     #   ################# ###           #     #   ################  
   #            #   ##############    ###           #     #   ################  
   #       ######   ##############                  #     #   ################  
   #       ####     ##############                  #     #   ################  
   #       ####     ##############                  #     #   ################  
   #     ######     ##############                  #     #   ################  
  ###### # ####     ##############                  #     #   ################  
  ######## ####     ##############                  #     #   ################  
  ######   ####                                   ###     #   ################  
  ######   ####                                   #       #   ################  
  ######   ####                               #########   #   ################  
  ######                                      #############   ################  
                                              #########       ################  
                                              #########       ################  
                                              #########                         
            #############                                                       
            #############                                                       
            #############                                                       
            #############                                                       
            #############                                                       
            #############                                                       
            #############                                                       
            #############                                                       
             #                                                                  
   ###########                                                                  
   #                                              #######################       
  ###########################                     #######################       
  ###########################                     #######################       
  ###########################                     #######################       
  ###########################                     #######################       
  ###########################          ##################################       
  ###########################          #          #######################       
  ###########################          #          #######################       
  ###########################          #          #######################       
                    #                  #          #######################       
                    ################   #          #######################       
                                   #   #          #######################       
                 #######################          #######################       
                 ####################             #######################       
                 ####################                  #                        
                 ####################                  #                        
                 ####################                  #                        
                 ####################                  #                        
                                                       #                        
                                                ########                        
                                                #                               
          ###############################################                       
          ###############################################                       
          ###############################################                       
          ###############################################                       
          ###############################################