不思議なダンジョン自動生成
(追記)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)
出力はこうなります。
######### ############## ##### # ######### ##### ### #### ### # ######### ##### ### #### ############################# ### # # ####### ### #### ############################# ### # ### ##### # ### #### ############################# ### # # ##### ##### #### ############################# ### # # ####### ### #### ############################# ### # # # ##### ########## ############################# ### # # # ##### ### #### ############################# ### # # # #### ############################# ##### # ############ # # # # ### # ############ # # # # ### # ############ # ############## ######################### # ##### ############ # # # # ### ############ # # ########## # ### ############ # # ########## # ### ############ # # ########## # ### ############ # # ########## # ### ############ # # # ################## # ### ############ # ################ ######## # ################# ### # # ################ # # ############## ### # # ################ # ###### ############## # # ################ # #### ############## # # ################ # #### ############## # # ################ # ###### ############## # # ################ ###### # #### ############## # # ################ ######## #### ############## # # ################ ###### #### ### # ################ ###### #### # # ################ ###### #### ######### # ################ ###### ############# ################ ######### ################ ######### ################ #########
############# ############# ############# ############# ############# ############# ############# ############# # ########### # ####################### ########################### ####################### ########################### ####################### ########################### ####################### ########################### ####################### ########################### ################################## ########################### # ####################### ########################### # ####################### ########################### # ####################### # # ####################### ################ # ####################### # # ####################### ####################### ####################### #################### ####################### #################### # #################### # #################### # #################### # # ######## # ############################################### ############################################### ############################################### ############################################### ###############################################