2007-06-17 不思議なダンジョン自動生成 
(追記)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)
出力はこうなります。
#########
############## #####
# ######### ##### ### ####
### # ######### ##### ### ####
############################# ### # # ####### ### ####
############################# ### # ### ##### # ### ####
############################# ### # # ##### ##### ####
############################# ### # # ####### ### ####
############################# ### # # # ##### ##########
############################# ### # # # ##### ### ####
############################# ### # # # ####
############################# ##### # ############ # #
# # ### # ############ # #
# # ### # ############ # ##############
######################### # ##### ############ # #
# # ### ############ # #
########## # ### ############ # #
########## # ### ############ # #
########## # ### ############ # #
########## # ### ############ # #
# ################## # ### ############ # ################
######## # ################# ### # # ################
# # ############## ### # # ################
# ###### ############## # # ################
# #### ############## # # ################
# #### ############## # # ################
# ###### ############## # # ################
###### # #### ############## # # ################
######## #### ############## # # ################
###### #### ### # ################
###### #### # # ################
###### #### ######### # ################
###### ############# ################
######### ################
######### ################
#########
#############
#############
#############
#############
#############
#############
#############
#############
#
###########
# #######################
########################### #######################
########################### #######################
########################### #######################
########################### #######################
########################### ##################################
########################### # #######################
########################### # #######################
########################### # #######################
# # #######################
################ # #######################
# # #######################
####################### #######################
#################### #######################
#################### #
#################### #
#################### #
#################### #
#
########
#
###############################################
###############################################
###############################################
###############################################
###############################################
コメントを書く