dungeon-master/generators/town.scm

   1 ;;; Dungeon Master --- RPG Adventure Generator
   2 ;;; Copyright © 2019 Javier Sancho <jsf@jsancho.org>
   3 ;;;
   4 ;;; Dungeon Master is free software; you can redistribute it and/or modify it
   5 ;;; under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 3 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; Dungeon Master is distributed in the hope that it will be useful, but
  10 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;; General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License
  15 ;;; along with Dungeon Master. If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 (define-module (dungeon-master generators town)
  19   #:use-module (dungeon-master geom voronoi)
  20   #:use-module (dungeon-master geom point)
  21   #:export (generate))
  22
  23 (define (random-bool)
  24   (= (random 2) 1))
  25
  26 (define pi 3.141592654)
  27 (define relax-steps 3)
  28
  29 (define (generate patches)
  30   "City generator from https://github.com/watabou/TownGeneratorOS/blob/master/Source/com/watabou/towngenerator/building/Model.hx"
  31   (set! *random-state* (random-state-from-platform))
  32   (when (= patches -1) (set! patches 15))
  33   (build-patches patches))
  34
  35 (define (build-patches n-patches)
  36   (define* (get-points n seed #:optional (l '()))
  37     (cond ((>= n 0)
  38            (let* ((a (+ seed (* (sqrt n) 5)))
  39                   (r (if (= n 0)
  40                          0
  41                          (+ 10 (* n (+ 2 (random:exp))))))
  42                   (point (make-point
  43                           (* (cos a) r)
  44                           (* (sin a) r))))
  45              (get-points (- n 1) seed (cons point l))))
  46           (else
  47            l)))
  48
  49   (define (relax voronoi n step)
  50     "Relaxing central wards"
  51     (cond ((> step 0)
  52            (let* ((voronoi-points (voronoi-mesh-points voronoi))
  53                   (n-points (length voronoi-points))
  54                   (to-relax (cons (list-ref voronoi-points (- n-points n-patches))
  55                                   (list-tail voronoi-points (- n-points 3)))))
  56              (relax (voronoi-mesh-relax voronoi to-relax) n (- step 1))))
  57           (else
  58            voronoi)))
  59
  60   (let* ((sa (* (random:exp) 2 pi))
  61          (points (get-points (* 8 n-patches) sa))
  62          (voronoi (relax (make-voronoi-mesh points) n-patches relax-steps)))
  63     "end"))