Merge the previous island generator with the new ideas explored so far.
This commit is contained in:
parent
1660f991a7
commit
6bb1217ef7
|
@ -27,4 +27,4 @@
|
||||||
; Create the directory
|
; Create the directory
|
||||||
(make-directory* directory-name)
|
(make-directory* directory-name)
|
||||||
; Save the island
|
; Save the island
|
||||||
(island-render (island-cells island) directory-name))
|
(island-render island directory-name))
|
||||||
|
|
|
@ -5,8 +5,9 @@
|
||||||
(require
|
(require
|
||||||
racket/math
|
racket/math
|
||||||
racket/list
|
racket/list
|
||||||
|
racket/function
|
||||||
data/queue
|
data/queue
|
||||||
"island/cell.rkt"
|
"island/island.rkt"
|
||||||
"island/biome.rkt"
|
"island/biome.rkt"
|
||||||
"../collection/2d-array.rkt"
|
"../collection/2d-array.rkt"
|
||||||
"../base-generation/noise.rkt"
|
"../base-generation/noise.rkt"
|
||||||
|
@ -15,60 +16,39 @@
|
||||||
(provide
|
(provide
|
||||||
; Constructor
|
; Constructor
|
||||||
island-generate
|
island-generate
|
||||||
; Accessors to the array of cells, for rendering
|
|
||||||
island-cells
|
|
||||||
)
|
)
|
||||||
|
|
||||||
; Island structure
|
; Island generation, step 1: generate altitude
|
||||||
(struct s-island
|
|
||||||
(cells ; 2d-array of cells
|
|
||||||
))
|
|
||||||
|
|
||||||
; Accessor
|
|
||||||
(define (island-cells island)
|
|
||||||
(s-island-cells island))
|
|
||||||
; get altitude
|
|
||||||
(define (island-altitude island i j)
|
|
||||||
(cell-altitude
|
|
||||||
(2d-array-ref (s-island-cells island) i j)))
|
|
||||||
; set altitude
|
|
||||||
(define (set-island-altitude! island i j alt)
|
|
||||||
(2d-array-set!
|
|
||||||
(s-island-cells island) i j
|
|
||||||
(set-cell-altitude cell alt)))
|
|
||||||
; get biome
|
|
||||||
(define (island-biome island i j)
|
|
||||||
(cell-biome
|
|
||||||
(2d-array-ref (s-island-cells island) i j)))
|
|
||||||
|
|
||||||
; Altitude function
|
|
||||||
(define (island-set-altitude! island)
|
(define (island-set-altitude! island)
|
||||||
(define size (2d-array-width (s-island-cells island)))
|
(define cells (island-cells island))
|
||||||
|
(define size (min (2d-array-width cells) (2d-array-height cells)))
|
||||||
(define half-size (/ size 2))
|
(define half-size (/ size 2))
|
||||||
(define noise-size (floor (/ size 10)))
|
(define noise-size (floor (/ size 12)))
|
||||||
(define ns (make-noise 2 noise-size))
|
(define ns (make-noise 2 noise-size))
|
||||||
(define (block i n) (* n (quotient i n)))
|
(define (block i n) (* n (quotient i n)))
|
||||||
(2d-array-map!/indexes
|
(2d-array-for-each/indexes
|
||||||
(s-island-cells island)
|
(island-cells island)
|
||||||
(lambda (cell i j)
|
(lambda (cell i j)
|
||||||
(set-cell-altitude
|
(set-cell-altitude!
|
||||||
cell
|
cell
|
||||||
(* 7
|
(* 7
|
||||||
(+ -200 (* 420 (* (sin (/ (* pi i) size)) (sin (/ (* pi j) size))))
|
(+ -200
|
||||||
(* -150 (+ (expt (- i half-size) 2) (expt (- j half-size) 2)) (/ 2 (* size size)))
|
(* 400 (* (sin (/ (* pi i) size)) (sin (/ (* pi j) size))))
|
||||||
|
(* -100 (+ (expt (- i half-size) 2) (expt (- j half-size) 2)) (/ 2 (* size size)))
|
||||||
(* 200 (noise-gradient-value ns i j))
|
(* 200 (noise-gradient-value ns i j))
|
||||||
(* 25 (noise-value ns (block i 3) (block j 3)))
|
(* 25 (noise-value ns (block i 3) (block j 3)))
|
||||||
(* 25 (noise-value ns (block i 1) (block j 1)))
|
(* 25 (noise-value ns (block i 1) (block j 1)))
|
||||||
)))))
|
)))))
|
||||||
)
|
)
|
||||||
|
|
||||||
; Erosion pass
|
; Island generation, step 2: erosion pass
|
||||||
; The erosion pass redistributes the altitudes around the neighbour cells
|
; The erosion pass redistributes the altitudes around the neighbour cells
|
||||||
(define (island-erode! island)
|
(define (island-erode! island)
|
||||||
|
(define cells (island-cells island))
|
||||||
; 1st pass - sum the contribution from all neighbours
|
; 1st pass - sum the contribution from all neighbours
|
||||||
(define new-alt-1
|
(define new-alt-1
|
||||||
(2d-array-map/indexes
|
(2d-array-map/indexes
|
||||||
(s-island-cells island)
|
cells
|
||||||
(lambda (cell i j)
|
(lambda (cell i j)
|
||||||
(define alt (cell-altitude cell))
|
(define alt (cell-altitude cell))
|
||||||
(foldl
|
(foldl
|
||||||
|
@ -77,7 +57,7 @@
|
||||||
(define y (+ j (cdar v)))
|
(define y (+ j (cdar v)))
|
||||||
(define factor (cdr v))
|
(define factor (cdr v))
|
||||||
(cond
|
(cond
|
||||||
((2d-array-inside? (s-island-cells island) x y)
|
((2d-array-inside? cells x y)
|
||||||
(define alt-next (island-altitude island x y))
|
(define alt-next (island-altitude island x y))
|
||||||
(+ res (* (- alt-next alt) factor)))
|
(+ res (* (- alt-next alt) factor)))
|
||||||
(#t res)))
|
(#t res)))
|
||||||
|
@ -109,37 +89,39 @@
|
||||||
(+ alt (/ (car add-remove) 3) (/ (cdr add-remove) 3))
|
(+ alt (/ (car add-remove) 3) (/ (cdr add-remove) 3))
|
||||||
)))
|
)))
|
||||||
; Update the altitudes
|
; Update the altitudes
|
||||||
(2d-array-map!/indexes
|
(2d-array-for-each/indexes
|
||||||
(s-island-cells island)
|
cells
|
||||||
(lambda (cell i j)
|
(lambda (cell i j)
|
||||||
(set-cell-altitude
|
(set-cell-altitude!
|
||||||
cell
|
cell
|
||||||
(2d-array-ref new-alt-2 i j))))
|
(2d-array-ref new-alt-2 i j))))
|
||||||
)
|
)
|
||||||
|
|
||||||
; Put sea
|
; Island generation, step 3: Add the sea biome
|
||||||
(define (island-set-sea! island)
|
(define (island-set-sea! island)
|
||||||
(2d-array-flood-map!
|
(2d-array-flood-map!
|
||||||
(s-island-cells island)
|
(island-cells island)
|
||||||
0 0
|
0 0
|
||||||
(lambda (cell)
|
(lambda (cell)
|
||||||
(set-cell-biome cell 'sea))
|
(set-cell-biome! cell 'sea)
|
||||||
|
cell)
|
||||||
(lambda (init-cell visited-cell)
|
(lambda (init-cell visited-cell)
|
||||||
(and (not (cell-biome visited-cell))
|
(and (not (cell-biome visited-cell))
|
||||||
(<= (cell-altitude visited-cell) 0)))
|
(<= (cell-altitude visited-cell) 0)))
|
||||||
))
|
))
|
||||||
|
|
||||||
; Set temperatures
|
; Island generation, step 4: Temperatures
|
||||||
|
; Compute the temperature, depending on the altitude and latitude
|
||||||
(define (island-set-temperature! island)
|
(define (island-set-temperature! island)
|
||||||
(define lat (+ 20 (random 45))) ; latitude of the island
|
(define lat (+ 20 (random 45))) ; latitude of the island
|
||||||
(2d-array-map!
|
(2d-array-for-each
|
||||||
(s-island-cells island)
|
(island-cells island)
|
||||||
(lambda (cell)
|
(lambda (cell)
|
||||||
; Altitude is 0 for the sea
|
; Altitude is 0 for the sea
|
||||||
(define alt
|
(define alt
|
||||||
(or (and (eq? 'sea (cell-biome cell)) 0)
|
(or (and (eq? 'sea (cell-biome cell)) 0)
|
||||||
(cell-altitude cell)))
|
(cell-altitude cell)))
|
||||||
(set-cell-temperature
|
(set-cell-temperature!
|
||||||
cell
|
cell
|
||||||
(+ ; Approximative model:
|
(+ ; Approximative model:
|
||||||
; 28°C at equator, 0°C at 70° lat
|
; 28°C at equator, 0°C at 70° lat
|
||||||
|
@ -233,7 +215,7 @@
|
||||||
((E) (cons `(,(- width 1) . ,(floor (/ height 2))) (make-winds '(-1 . 0) M? A? P? AO? O?)))
|
((E) (cons `(,(- width 1) . ,(floor (/ height 2))) (make-winds '(-1 . 0) M? A? P? AO? O?)))
|
||||||
))
|
))
|
||||||
|
|
||||||
; Set rainfall
|
; Island generation, step 5: Set rainfall
|
||||||
; This is done by computing a distance to sea from a dominant wind
|
; This is done by computing a distance to sea from a dominant wind
|
||||||
(define (island-set-rainfall! island)
|
(define (island-set-rainfall! island)
|
||||||
(define is-cells (island-cells island))
|
(define is-cells (island-cells island))
|
||||||
|
@ -314,70 +296,779 @@
|
||||||
(+ ret (* weight (max 0 (/ (- max-dist dist) max-dist)))))
|
(+ ret (* weight (max 0 (/ (- max-dist dist) max-dist)))))
|
||||||
0
|
0
|
||||||
dists
|
dists
|
||||||
'(200 75 50)
|
'(175 75 50)
|
||||||
'(75 125 250))
|
'(75 125 250))
|
||||||
(* alt 1/60)
|
(* alt 1/60)
|
||||||
(* -50 temp 1/50)
|
(* -50 temp 1/50)
|
||||||
)))
|
)))
|
||||||
; Update island
|
; Update island
|
||||||
(2d-array-map!/indexes
|
(2d-array-for-each/indexes
|
||||||
is-cells
|
is-cells
|
||||||
(lambda (cell i j)
|
(lambda (cell i j)
|
||||||
(define alt (cell-altitude cell))
|
(define alt (cell-altitude cell))
|
||||||
(define temp (cell-temperature cell))
|
(define temp (cell-temperature cell))
|
||||||
(define dists (map (lambda (arr) (2d-array-ref arr i j)) distances-to-sea))
|
(define dists (map (lambda (arr) (2d-array-ref arr i j)) distances-to-sea))
|
||||||
(set-cell-rainfall cell (compute-rainfall dists (max alt 0) temp))))
|
(set-cell-rainfall! cell (compute-rainfall dists (max alt 0) temp))))
|
||||||
)
|
)
|
||||||
|
|
||||||
; Biome generation
|
; Island generation, step 6: Determine the river springs
|
||||||
|
; All places with a rainfall > 100 are candidates for river springs
|
||||||
|
; However, river springs cannot be placed on two adjacent cells
|
||||||
|
(define (add-river-springs! island)
|
||||||
|
; collect all the positions with rainfall > 100, with their rainfall (exclude sea)
|
||||||
|
(define candidates
|
||||||
|
(2d-array-fold/indexes
|
||||||
|
(island-cells island)
|
||||||
|
(list)
|
||||||
|
(lambda (cell i j res)
|
||||||
|
(if (and (> (cell-rainfall cell) 100)
|
||||||
|
(not (eq? 'sea (cell-biome cell))))
|
||||||
|
(cons
|
||||||
|
(list (cons i j) (cell-rainfall cell))
|
||||||
|
res)
|
||||||
|
res))))
|
||||||
|
; sort the candidates by decreasing rainfall,
|
||||||
|
; and set the springs
|
||||||
|
(for-each
|
||||||
|
(lambda (x)
|
||||||
|
(define i (caar x))
|
||||||
|
(define j (cdar x))
|
||||||
|
; check there is no spring on an adjacent tiles in a radius of 2
|
||||||
|
(when (null?
|
||||||
|
(filter
|
||||||
|
(lambda (pos)
|
||||||
|
(and
|
||||||
|
(island-is-inside? island (+ i (car pos)) (+ j (cdr pos)))
|
||||||
|
(island-river-spring? island (+ i (car pos)) (+ j (cdr pos)))
|
||||||
|
))
|
||||||
|
'(( 2 . 2) ( 2 . 1) ( 2 . 0) ( 2 . -1) ( 2 . -2)
|
||||||
|
( 1 . 2) ( 1 . 1) ( 1 . 0) ( 1 . -1) ( 1 . -2)
|
||||||
|
( 0 . 2) ( 0 . 1) ( 0 . -1) ( 0 . -2)
|
||||||
|
(-1 . 2) (-1 . 1) (-1 . 0) (-1 . -1) (-1 . -2)
|
||||||
|
(-2 . 2) (-2 . 1) (-2 . 0) (-2 . -1) (-2 . -2)
|
||||||
|
)))
|
||||||
|
; when a spring is found, add the info on the cell and add it to the list of springs of the island
|
||||||
|
(island-add-river-spring! island i j)))
|
||||||
|
(sort candidates (lambda (x y) (> (cadr x) (cadr y))))))
|
||||||
|
|
||||||
|
; Island generation, step 7: draw the rivers
|
||||||
|
; When drawing a river, we need to find the next point of the path
|
||||||
|
(define (draw-river-and-find-next-point island i j cell path river-count)
|
||||||
|
; Increase the river count of the cell
|
||||||
|
(set-cell-river-count! cell (+ river-count (cell-river-count cell)))
|
||||||
|
; find the next point: the surrounding cell with the lower altitude
|
||||||
|
(define next-position+altitude
|
||||||
|
(car
|
||||||
|
(sort
|
||||||
|
(map
|
||||||
|
(lambda (x)
|
||||||
|
(define ni (+ i (car x)))
|
||||||
|
(define nj (+ j (cdr x)))
|
||||||
|
(list (cons ni nj)
|
||||||
|
(cond
|
||||||
|
; Outside should be excluded
|
||||||
|
((not (island-is-inside? island ni nj))
|
||||||
|
+inf.0)
|
||||||
|
; if there is sea around, move to it in priority
|
||||||
|
((eq? 'sea (island-biome island ni nj))
|
||||||
|
(+ -10000 (island-altitude island ni nj)))
|
||||||
|
; if there is a river around at a lower altitude, but not yet in the path, move to it in priority
|
||||||
|
((and (< (island-altitude island ni nj) (cell-altitude cell))
|
||||||
|
(< 0 (island-river-count island ni nj))
|
||||||
|
(not (member (cons ni nj) path)))
|
||||||
|
(+ -1000 (island-altitude island ni nj)))
|
||||||
|
; Other cases
|
||||||
|
(#t
|
||||||
|
(island-altitude island ni nj))
|
||||||
|
)))
|
||||||
|
river-directions)
|
||||||
|
(lambda (x y) (< (cadr x) (cadr y))))))
|
||||||
|
; return the next position if it has lower altitude than the current position
|
||||||
|
; Also set the river count of the corresponding edge
|
||||||
|
; if there is no next position, return false
|
||||||
|
(if (< (cadr next-position+altitude) (cell-altitude cell))
|
||||||
|
(begin
|
||||||
|
(set-edge-river-count!
|
||||||
|
(island-edge-between island i j (caar next-position+altitude) (cdar next-position+altitude))
|
||||||
|
(cell-river-count cell))
|
||||||
|
(car next-position+altitude))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
; From the river spring, draw the river up to the sea or to sinkholes
|
||||||
|
; The sinkhole will be used later to draw lakes
|
||||||
|
(define (draw-river-from-spring island spring river-count)
|
||||||
|
(let loop ((i (car spring))
|
||||||
|
(j (cdr spring))
|
||||||
|
(cell (island-get-cell island (car spring) (cdr spring)))
|
||||||
|
(path (list)))
|
||||||
|
(define next (draw-river-and-find-next-point island i j cell path river-count))
|
||||||
|
(define next-cell (and next (island-get-cell island (car next) (cdr next))))
|
||||||
|
(cond
|
||||||
|
((not next-cell)
|
||||||
|
; sinkhole reached, stop for now
|
||||||
|
(set-island-sinkholes! island (append (island-sinkholes island) (list (cons i j)))))
|
||||||
|
((eq? (cell-biome next-cell) 'sea)
|
||||||
|
; sea reached, stop
|
||||||
|
#t)
|
||||||
|
(#t
|
||||||
|
; continue to draw the river
|
||||||
|
(loop (car next) (cdr next) next-cell (cons next path))))))
|
||||||
|
|
||||||
|
; Draw a lakes from a sinkhole
|
||||||
|
(define (draw-lake-from-sinkhole island sinkhole)
|
||||||
|
(define i (car sinkhole))
|
||||||
|
(define j (cdr sinkhole))
|
||||||
|
; If the sinkhole is already inside a lake, skip completely
|
||||||
|
(when (not (eq? 'lake (island-biome island i j)))
|
||||||
|
(define river-count (island-river-count island i j))
|
||||||
|
(define nb-iter (expt (+ river-count 2) 2)) ; number of iterations for the lake. The larger the river-count, the larger the lake.
|
||||||
|
; the goal is to find a new "spring" position from where the lake overflows
|
||||||
|
(let loop ( (iter nb-iter)
|
||||||
|
(ni i)
|
||||||
|
(nj j)
|
||||||
|
(next-points+altitude (list)))
|
||||||
|
(when (< 0 iter)
|
||||||
|
; set the lake biome on the cell
|
||||||
|
(set-cell-biome! (island-get-cell island ni nj) 'lake)
|
||||||
|
; Reset the river count of the cell
|
||||||
|
(set-cell-river-count! (island-get-cell island ni nj) 0)
|
||||||
|
; find the next points to check
|
||||||
|
; add the neighbours of the current cell that are not lake to the list of next points
|
||||||
|
; and order it by the lowest altitude
|
||||||
|
(define next+alt
|
||||||
|
(sort
|
||||||
|
(append
|
||||||
|
next-points+altitude
|
||||||
|
(filter
|
||||||
|
(lambda (x)
|
||||||
|
(and
|
||||||
|
(island-is-inside? island (caar x) (cdar x))
|
||||||
|
(not (eq? 'lake (island-biome island (caar x) (cdar x))))))
|
||||||
|
(map
|
||||||
|
(lambda (x)
|
||||||
|
(define nni (+ ni (car x)))
|
||||||
|
(define nnj (+ nj (cdr x)))
|
||||||
|
(cons (point nni nnj)
|
||||||
|
(island-altitude island nni nnj)))
|
||||||
|
river-directions)))
|
||||||
|
(lambda (x y)
|
||||||
|
(< (cdr x) (cdr y)))))
|
||||||
|
(when (not (null? next+alt))
|
||||||
|
(define next (car next+alt))
|
||||||
|
; if the next point has an altitude lower than the current cell, we continue into a river
|
||||||
|
; else, we continue to fill the lake from the new position
|
||||||
|
(if (< (cdr next) (island-altitude island ni nj))
|
||||||
|
(begin
|
||||||
|
; Change the river count of the edge too
|
||||||
|
(set-edge-river-count!
|
||||||
|
(island-edge-between island ni nj (caar next) (cdar next))
|
||||||
|
river-count)
|
||||||
|
; Start a new river
|
||||||
|
(draw-river-from-spring island (car next) river-count))
|
||||||
|
(loop (- iter 1) (caar next) (cdar next) (cdr next+alt))))
|
||||||
|
))))
|
||||||
|
|
||||||
|
; Add rivers
|
||||||
|
(define (add-rivers! island)
|
||||||
|
; Step 1: draw the river from the springs
|
||||||
|
(for-each
|
||||||
|
(lambda (spring)
|
||||||
|
(draw-river-from-spring island spring 1))
|
||||||
|
(island-river-springs island))
|
||||||
|
; step 2: draw the lake and river from the sinkholes
|
||||||
|
(let loop ((lst-sinkholes (island-sinkholes island)))
|
||||||
|
(when (not (null? lst-sinkholes))
|
||||||
|
; remove the sinkhole from the list
|
||||||
|
(set-island-sinkholes! island (cdr lst-sinkholes))
|
||||||
|
; draw a lake from the sinkhole
|
||||||
|
; this may end into new sinkhole added at the end of the list of sinkholes
|
||||||
|
(draw-lake-from-sinkhole island (car lst-sinkholes))
|
||||||
|
; loop
|
||||||
|
(loop (island-sinkholes island)))))
|
||||||
|
|
||||||
|
; Island generation, step 8: add biomes
|
||||||
(define (island-set-biome! island)
|
(define (island-set-biome! island)
|
||||||
(2d-array-map!
|
(2d-array-for-each
|
||||||
(island-cells island)
|
(island-cells island)
|
||||||
(lambda (cell)
|
(lambda (cell)
|
||||||
(set-cell-biome
|
(set-cell-biome!
|
||||||
cell
|
cell
|
||||||
(compute-biome
|
(compute-biome
|
||||||
(cell-biome cell)
|
(cell-biome cell)
|
||||||
(cell-temperature cell)
|
(cell-temperature cell)
|
||||||
(cell-rainfall cell))))))
|
(cell-rainfall cell))))))
|
||||||
|
|
||||||
; Generation function
|
; Island generation, step 9: generate voronoi cells for the island
|
||||||
; size is the width and height of the discrete map
|
; Distance between to points on the island
|
||||||
|
; Mean between the manhattan distance and the infinite norm
|
||||||
|
(define (distance-between pos1 pos2)
|
||||||
|
(define x (abs (- (car pos1) (car pos2))))
|
||||||
|
(define y (abs (- (cdr pos1) (cdr pos2))))
|
||||||
|
(/ (+ x y (max x y)) 2))
|
||||||
|
|
||||||
|
; Get the closest point of a list from another point
|
||||||
|
(define (closest-from pnt lst-points)
|
||||||
|
(car
|
||||||
|
(foldl
|
||||||
|
(lambda (x res)
|
||||||
|
(define dist (distance-between pnt x))
|
||||||
|
(if (< dist (cdr res))
|
||||||
|
(cons x dist)
|
||||||
|
res))
|
||||||
|
(cons #f +inf.0) ; Point + distance
|
||||||
|
lst-points)))
|
||||||
|
|
||||||
|
; Compute for each cell the closest voronoi center
|
||||||
|
(define (set-closest-voronoi-center! island)
|
||||||
|
(2d-array-for-each/indexes
|
||||||
|
(island-cells island)
|
||||||
|
(lambda (cell i j)
|
||||||
|
; reset the cell-voronoi-center of cell
|
||||||
|
(set-cell-voronoi-center! cell
|
||||||
|
(closest-from (point i j) (island-voronoi-centers island))))))
|
||||||
|
|
||||||
|
; compute the center of each voronoi cells defined on the island, and set it as the new centers
|
||||||
|
(define (relax-centers-of-voronoi-cells island)
|
||||||
|
(define cells (island-cells island))
|
||||||
|
(define h (make-hash))
|
||||||
|
; use a statistic version: pick a point on the island and use it to compute the new center
|
||||||
|
; Instead of using all the cells of the island, only use 10 * (nb of voronoi cells)
|
||||||
|
(let loop ((n (* 10 (length (island-voronoi-centers island)))))
|
||||||
|
(when (< 0 n)
|
||||||
|
(define i (random (2d-array-width cells)))
|
||||||
|
(define j (random (2d-array-height cells)))
|
||||||
|
(define vcell (closest-from (point i j) (island-voronoi-centers island)))
|
||||||
|
(if (hash-has-key? h vcell)
|
||||||
|
(let ((prev (hash-ref h vcell)))
|
||||||
|
(hash-set! h vcell
|
||||||
|
(cons (point-add (point i j) (car prev)) (+ 1 (cdr prev)))))
|
||||||
|
(hash-set! h vcell
|
||||||
|
(cons (point i j) 1)))
|
||||||
|
(loop (- n 1))))
|
||||||
|
; update the centers
|
||||||
|
(set-island-voronoi-centers! island
|
||||||
|
(hash-map
|
||||||
|
h
|
||||||
|
(lambda (k v)
|
||||||
|
(point
|
||||||
|
(floor (/ (caar v) (cdr v)))
|
||||||
|
(floor (/ (cdar v) (cdr v)))))))
|
||||||
|
)
|
||||||
|
|
||||||
|
; Add the voronoi cells on the island (a cell is represented by its center)
|
||||||
|
(define (add-voronoi-cells! island)
|
||||||
|
(define cells (island-cells island))
|
||||||
|
(define width (2d-array-width cells))
|
||||||
|
(define height (2d-array-height cells))
|
||||||
|
(time
|
||||||
|
(displayln "Computation of centers")
|
||||||
|
; random centers
|
||||||
|
(set-island-voronoi-centers! island
|
||||||
|
; Remove points located in sea and lakes
|
||||||
|
(filter
|
||||||
|
(lambda (x)
|
||||||
|
(define biome (island-biome island (car x) (cdr x)))
|
||||||
|
(and (not (eq? 'sea biome))
|
||||||
|
(not (eq? 'lake biome))))
|
||||||
|
; remove identical points
|
||||||
|
(remove-duplicates
|
||||||
|
; build the list: each point is randomly choosen
|
||||||
|
(build-list
|
||||||
|
(ceiling (* width height 1/25)) ; number of points: island-width/25 * island-height/25
|
||||||
|
(lambda (i)
|
||||||
|
(point (random width) (random height))))))))
|
||||||
|
; relax twice the points : recompute the voronoi centers from each voronoi cell
|
||||||
|
(time
|
||||||
|
(displayln "Relax centers")
|
||||||
|
(relax-centers-of-voronoi-cells island))
|
||||||
|
; compute the closest center for each cell
|
||||||
|
(time
|
||||||
|
(displayln "Cell computation")
|
||||||
|
(set-closest-voronoi-center! island))
|
||||||
|
)
|
||||||
|
|
||||||
|
; Island generation, step 10: add cities
|
||||||
|
; For each cell, we need to compute a city score
|
||||||
|
; The city score take several parameters, so the computation is separated in several functions
|
||||||
|
|
||||||
|
; City score from the cells surrounding the city (in the 8 directions)
|
||||||
|
(define (city-score-from-neighbours-with-corners island i j cell)
|
||||||
|
(foldl
|
||||||
|
(lambda (pos res)
|
||||||
|
(define ni (+ i (car pos)))
|
||||||
|
(define nj (+ j (cdr pos)))
|
||||||
|
(define ncell (and (island-is-inside? island ni nj)
|
||||||
|
(island-get-cell island ni nj)))
|
||||||
|
(if ncell
|
||||||
|
(+ res
|
||||||
|
; penalize the presence of cliffs, prefer plane area
|
||||||
|
(/ (abs (- (cell-altitude ncell) (cell-altitude cell))) -5)
|
||||||
|
; take into account the surrounding biomes
|
||||||
|
(if (or (eq? 'sea (cell-biome ncell))
|
||||||
|
(eq? 'lake (cell-biome ncell)))
|
||||||
|
10
|
||||||
|
(/ (biome-city-score (cell-biome ncell)) 8))
|
||||||
|
; take into account the presence of rivers
|
||||||
|
(* 2 (cell-river-count ncell)))
|
||||||
|
(+ res 0)))
|
||||||
|
0
|
||||||
|
(list
|
||||||
|
north-west north north-east
|
||||||
|
west east
|
||||||
|
south-west south south-east)))
|
||||||
|
|
||||||
|
; City score from the cells surronding the city (in the 4 river directions)
|
||||||
|
(define (city-score-from-neighbours island i j cell)
|
||||||
|
(foldl
|
||||||
|
(lambda (pos res)
|
||||||
|
(define ni (+ i (car pos)))
|
||||||
|
(define nj (+ j (cdr pos)))
|
||||||
|
(define ncell (and (island-is-inside? island ni nj)
|
||||||
|
(island-get-cell island ni nj)))
|
||||||
|
(if ncell
|
||||||
|
; penalize if there is not enough ground to make a road to the city
|
||||||
|
(* res
|
||||||
|
(if (or (eq? 'sea (cell-biome ncell))
|
||||||
|
(eq? 'lake (cell-biome ncell)))
|
||||||
|
10
|
||||||
|
1))
|
||||||
|
(* res 1)))
|
||||||
|
-1
|
||||||
|
river-directions))
|
||||||
|
|
||||||
|
; City score from the cell itself
|
||||||
|
(define (city-score-from-cell cell)
|
||||||
|
(+ ; biome of the cell
|
||||||
|
(biome-city-score (cell-biome cell))
|
||||||
|
; altitude of the cell: avoid too high altitudes
|
||||||
|
(max 0 (+ 50 (* -1/10 (cell-altitude cell))))
|
||||||
|
; avoid being placed on a river
|
||||||
|
(* -100 (cell-river-count cell))
|
||||||
|
; avoid dry areas
|
||||||
|
(cell-rainfall cell)
|
||||||
|
))
|
||||||
|
|
||||||
|
; Compute the city score for each voronoi center and return a list of possible cities with their score
|
||||||
|
(define (compute-possible-cities island)
|
||||||
|
(define candidates (list))
|
||||||
|
(for-each
|
||||||
|
(lambda (x)
|
||||||
|
(define i (car x))
|
||||||
|
(define j (cdr x))
|
||||||
|
(define cell (island-get-cell island (car x) (cdr x)))
|
||||||
|
; compute the city score
|
||||||
|
(set-cell-city-score! cell
|
||||||
|
(+ (city-score-from-cell cell)
|
||||||
|
(city-score-from-neighbours island i j cell)
|
||||||
|
(city-score-from-neighbours-with-corners island i j cell)
|
||||||
|
))
|
||||||
|
; exclude places with a too negative score
|
||||||
|
(when (< -200 (cell-city-score cell))
|
||||||
|
(set! candidates (cons (make-city (point i j) (cell-city-score cell)) candidates))))
|
||||||
|
(island-voronoi-centers island))
|
||||||
|
(sort
|
||||||
|
candidates
|
||||||
|
(lambda (x y) (> (city-score x) (city-score y)))))
|
||||||
|
|
||||||
|
; Get the list of city from the closest to the furthest from another city
|
||||||
|
(define (closest-cities ct lst-cities)
|
||||||
|
(sort
|
||||||
|
(filter (lambda (x) (not (eq? ct x))) lst-cities) ; remove the city we are checking
|
||||||
|
(lambda (x y) (< (distance-between (city-position ct) (city-position x))
|
||||||
|
(distance-between (city-position ct) (city-position y))))))
|
||||||
|
|
||||||
|
; Get the closest city from a point
|
||||||
|
(define (closest-city-from pnt lst-cities)
|
||||||
|
(car
|
||||||
|
(foldl
|
||||||
|
(lambda (x res)
|
||||||
|
(define dist (distance-between pnt (city-position x)))
|
||||||
|
(if (< dist (cdr res))
|
||||||
|
(cons x dist)
|
||||||
|
res))
|
||||||
|
(cons #f +inf.0) ; Point + distance
|
||||||
|
lst-cities)))
|
||||||
|
|
||||||
|
; Distance between a point and the closest city
|
||||||
|
(define (horizontal-distance-to-city island pos)
|
||||||
|
(if (null? (island-cities island))
|
||||||
|
+inf.0
|
||||||
|
(distance-between
|
||||||
|
pos
|
||||||
|
(city-position (closest-city-from pos (island-cities island))))))
|
||||||
|
|
||||||
|
; add a certain number of cities of a given size taken from a list of candidates
|
||||||
|
; candidates should be sorted by city-score (higher first)
|
||||||
|
(define (add-cities island candidates nb-cities size min-score min-distance-to-other)
|
||||||
|
(when (and (< 0 nb-cities)
|
||||||
|
(not (null? candidates))
|
||||||
|
(< min-score (city-score (car candidates))))
|
||||||
|
(define possible-city (car candidates))
|
||||||
|
(define nb nb-cities)
|
||||||
|
(define cell
|
||||||
|
(island-get-cell
|
||||||
|
island
|
||||||
|
(car (city-position possible-city))
|
||||||
|
(cdr (city-position possible-city))))
|
||||||
|
(when (and
|
||||||
|
(not (cell-city cell))
|
||||||
|
(< min-distance-to-other (horizontal-distance-to-city island (city-position possible-city))))
|
||||||
|
(set-city-size! possible-city size)
|
||||||
|
(set-island-cities! island (cons possible-city (island-cities island)))
|
||||||
|
(set-cell-city! cell possible-city)
|
||||||
|
(set! nb (- nb-cities 1)))
|
||||||
|
(add-cities island (cdr candidates) nb size min-score min-distance-to-other)
|
||||||
|
))
|
||||||
|
|
||||||
|
; add the cities
|
||||||
|
(define (add-cities! island)
|
||||||
|
(define candidates (compute-possible-cities island))
|
||||||
|
(add-cities island candidates 1 'capital -inf.0 30)
|
||||||
|
(add-cities island candidates 20 'city 150 30)
|
||||||
|
(add-cities island candidates 60 'town 0 15)
|
||||||
|
(add-cities island candidates 120 'village -inf.0 5))
|
||||||
|
|
||||||
|
; Island generation, step 11: add subdivisions
|
||||||
|
; Indicate which city manages a cell
|
||||||
|
|
||||||
|
; Add the municipality on cells
|
||||||
|
(define (add-municipalities island)
|
||||||
|
; For each voronoi cell, define to which municipality it belongs to (closest municipality)
|
||||||
|
(for-each
|
||||||
|
(lambda (x)
|
||||||
|
(define cell (island-get-cell island (car x) (cdr x)))
|
||||||
|
(set-cell-municipality! cell
|
||||||
|
(closest-city-from x (island-cities island))))
|
||||||
|
(island-voronoi-centers island))
|
||||||
|
; For each cell, assign the municipality of its voronoi center
|
||||||
|
(2d-array-for-each
|
||||||
|
(island-cells island)
|
||||||
|
(lambda (cell)
|
||||||
|
(set-cell-municipality! cell
|
||||||
|
(cell-municipality
|
||||||
|
(island-get-cell island
|
||||||
|
(car (cell-voronoi-center cell))
|
||||||
|
(cdr (cell-voronoi-center cell))
|
||||||
|
)))))
|
||||||
|
)
|
||||||
|
|
||||||
|
; Add territories
|
||||||
|
(define (add-territories! island)
|
||||||
|
(define capital (car (filter (lambda (x) (eq? 'capital (city-size x))) (island-cities island))))
|
||||||
|
(define cities (filter (lambda (x) (eq? 'city (city-size x))) (island-cities island)))
|
||||||
|
(define towns (filter (lambda (x) (eq? 'town (city-size x))) (island-cities island)))
|
||||||
|
(define villages (filter (lambda (x) (eq? 'village (city-size x))) (island-cities island)))
|
||||||
|
(define region-capitals (cons capital cities))
|
||||||
|
(define canton-capitals (append region-capitals towns))
|
||||||
|
; Add municipalities
|
||||||
|
(add-municipalities island)
|
||||||
|
; Add canton
|
||||||
|
(for-each
|
||||||
|
(lambda (ca)
|
||||||
|
(define pos (city-position ca))
|
||||||
|
(define cell (island-get-cell island (car pos) (cdr pos)))
|
||||||
|
(set-cell-canton! cell ca))
|
||||||
|
canton-capitals)
|
||||||
|
; Attach each village to its closest canton-capital
|
||||||
|
(for-each
|
||||||
|
(lambda (vi)
|
||||||
|
(define pos (city-position vi))
|
||||||
|
(define cell (island-get-cell island (car pos) (cdr pos)))
|
||||||
|
(set-cell-canton! cell
|
||||||
|
(car
|
||||||
|
(closest-cities vi canton-capitals))))
|
||||||
|
villages)
|
||||||
|
; Add region
|
||||||
|
(for-each
|
||||||
|
(lambda (re)
|
||||||
|
(define pos (city-position re))
|
||||||
|
(define cell (island-get-cell island (car pos) (cdr pos)))
|
||||||
|
(set-cell-region! cell re))
|
||||||
|
region-capitals)
|
||||||
|
; Attach each town to its closest region capital
|
||||||
|
(for-each
|
||||||
|
(lambda (tw)
|
||||||
|
(define pos (city-position tw))
|
||||||
|
(define cell (island-get-cell island (car pos) (cdr pos)))
|
||||||
|
(set-cell-region! cell
|
||||||
|
(car
|
||||||
|
(closest-cities tw region-capitals))))
|
||||||
|
towns)
|
||||||
|
; Attach each village to the region capital of its canton capital
|
||||||
|
(for-each
|
||||||
|
(lambda (vi)
|
||||||
|
(define pos (city-position vi))
|
||||||
|
(define cell (island-get-cell island (car pos) (cdr pos)))
|
||||||
|
(define cpos (city-position (cell-canton cell)))
|
||||||
|
(define ccell (island-get-cell island (car cpos) (cdr cpos)))
|
||||||
|
(set-cell-region! cell (cell-region ccell)))
|
||||||
|
villages)
|
||||||
|
; Fix canton & region to be the same as the one of the municipality a cell belongs to
|
||||||
|
(2d-array-for-each
|
||||||
|
(island-cells island)
|
||||||
|
(lambda (cell)
|
||||||
|
(define ct (cell-municipality cell))
|
||||||
|
(define ct-cell (island-get-cell island (car (city-position ct)) (cdr (city-position ct))))
|
||||||
|
(define canton (cell-canton ct-cell))
|
||||||
|
(define region (cell-region ct-cell))
|
||||||
|
(set-cell-canton! cell canton)
|
||||||
|
(set-cell-region! cell region))))
|
||||||
|
|
||||||
|
; Neighbours
|
||||||
|
; Add a neighbour to a territory
|
||||||
|
(define (add-neighbour island type ct1 ct2)
|
||||||
|
(hash-set!
|
||||||
|
(type island)
|
||||||
|
ct1
|
||||||
|
(cons ct2 (hash-ref (type island) ct1 (list)))))
|
||||||
|
|
||||||
|
; Compute the neighbours of each territories
|
||||||
|
(define (add-neighbours! island)
|
||||||
|
; add the neighbours
|
||||||
|
(2d-array-for-each/indexes
|
||||||
|
(island-cells island)
|
||||||
|
(lambda (cell i j)
|
||||||
|
; ignore the neighbours when at sea
|
||||||
|
(when (not (eq? 'sea (cell-biome cell)))
|
||||||
|
(define municipality (cell-municipality cell))
|
||||||
|
(define canton (cell-canton cell))
|
||||||
|
(define region (cell-region cell))
|
||||||
|
(for-each
|
||||||
|
(lambda (dir)
|
||||||
|
(define ni (+ i (car dir)))
|
||||||
|
(define nj (+ j (cdr dir)))
|
||||||
|
(when (island-is-inside? island ni nj)
|
||||||
|
(define ncell (island-get-cell island ni nj))
|
||||||
|
(when (not (eq? municipality (cell-municipality ncell)))
|
||||||
|
(add-neighbour island island-municipality-neighbours municipality (cell-municipality ncell)))
|
||||||
|
(when (not (eq? canton (cell-canton ncell)))
|
||||||
|
(add-neighbour island island-canton-neighbours canton (cell-canton ncell)))
|
||||||
|
(when (not (eq? region (cell-region ncell)))
|
||||||
|
(add-neighbour island island-region-neighbours region (cell-region ncell)))
|
||||||
|
))
|
||||||
|
river-directions))))
|
||||||
|
; remove the duplications in lists
|
||||||
|
(for-each
|
||||||
|
(lambda (type)
|
||||||
|
(hash-for-each
|
||||||
|
(type island)
|
||||||
|
(lambda (k v)
|
||||||
|
(hash-set! (type island) k (remove-duplicates v)))))
|
||||||
|
(list
|
||||||
|
island-municipality-neighbours
|
||||||
|
island-canton-neighbours
|
||||||
|
island-region-neighbours))
|
||||||
|
)
|
||||||
|
|
||||||
|
; Island generation, step 12: add roads
|
||||||
|
; Link cities with roads
|
||||||
|
|
||||||
|
; Compute the cost to move from a cell to another
|
||||||
|
; If #f is returned, no road can be built between a cell and its neighbour
|
||||||
|
(define (road-cost island origin direction)
|
||||||
|
(define i (car origin))
|
||||||
|
(define j (cdr origin))
|
||||||
|
(define cell (island-get-cell island i j))
|
||||||
|
(define ni (+ i (car direction)))
|
||||||
|
(define nj (+ j (cdr direction)))
|
||||||
|
(cond
|
||||||
|
; The next must be inside
|
||||||
|
( (not (island-is-inside? island ni nj))
|
||||||
|
#f)
|
||||||
|
( (or (not (biome-new-road-cost (cell-biome (island-get-cell island ni nj)))) ; the biome forbids a road
|
||||||
|
(and (< 0 (cell-river-count cell))
|
||||||
|
(< 0 (cell-river-count (island-get-cell island ni nj)))) ; the current cell and next cell are rivers
|
||||||
|
)
|
||||||
|
#f)
|
||||||
|
; Other cases
|
||||||
|
(#t
|
||||||
|
(define ncell (island-get-cell island ni nj))
|
||||||
|
(/
|
||||||
|
(+
|
||||||
|
1000
|
||||||
|
(biome-new-road-cost (cell-biome ncell))
|
||||||
|
(abs (- (cell-altitude ncell) (cell-altitude cell))) ; avoid to much slopes
|
||||||
|
; a bridge should be built if there is a river, only the first bridge is penalized
|
||||||
|
(* 1.2 (cell-river-count ncell))
|
||||||
|
; avoid mountains
|
||||||
|
(cond
|
||||||
|
((< 2100 (cell-altitude ncell)) 100)
|
||||||
|
((< 1800 (cell-altitude ncell)) 50)
|
||||||
|
((< 1500 (cell-altitude ncell)) 25)
|
||||||
|
((< 1200 (cell-altitude ncell)) 12)
|
||||||
|
((< 900 (cell-altitude ncell)) 6)
|
||||||
|
(#t 0))
|
||||||
|
)
|
||||||
|
; If there is already a road, reduce the cost
|
||||||
|
(if (< 0 (cell-road-count ncell))
|
||||||
|
(+ 1 (/ (cell-road-count ncell) 3))
|
||||||
|
1)
|
||||||
|
; If there is a city, further reduce the cost
|
||||||
|
(if (cell-city ncell)
|
||||||
|
1.2
|
||||||
|
1)
|
||||||
|
))))
|
||||||
|
|
||||||
|
; Compute the heuristic cost of a cell
|
||||||
|
(define (heuristic-cost island origin destination)
|
||||||
|
(define i (car origin))
|
||||||
|
(define j (cdr origin))
|
||||||
|
(define di (car destination))
|
||||||
|
(define dj (cdr destination))
|
||||||
|
(+
|
||||||
|
(* 1000 (distance-between origin destination))
|
||||||
|
(abs (- (island-altitude island i j) (island-altitude island di dj)))))
|
||||||
|
|
||||||
|
; Draw a road
|
||||||
|
(define (draw-road island origin-city destination-city count road-cost-function heuristic-cost-function)
|
||||||
|
(let loop ((road (or (island-pathfind
|
||||||
|
island
|
||||||
|
(city-position origin-city) (city-position destination-city)
|
||||||
|
road-cost-function heuristic-cost-function)
|
||||||
|
'()))
|
||||||
|
(cities-on-path (list))
|
||||||
|
)
|
||||||
|
(cond
|
||||||
|
( (null? road)
|
||||||
|
; End by connecting the cities to each others
|
||||||
|
(for-each
|
||||||
|
(lambda (ct)
|
||||||
|
(for-each
|
||||||
|
(lambda (ct2)
|
||||||
|
(hash-set! (city-roads-to ct) ct2 #t))
|
||||||
|
cities-on-path))
|
||||||
|
cities-on-path))
|
||||||
|
(#t
|
||||||
|
; Draw the road
|
||||||
|
(define current (car road))
|
||||||
|
(define cell (island-get-cell island (car current) (cdr current)))
|
||||||
|
(define next (and (not (null? (cdr road))) (cadr road)))
|
||||||
|
(define edge (and next
|
||||||
|
(island-edge-between
|
||||||
|
island
|
||||||
|
(car current) (cdr current)
|
||||||
|
(car next) (cdr next))))
|
||||||
|
(set-cell-road-count! cell (+ (cell-road-count cell) count))
|
||||||
|
(when edge
|
||||||
|
(set-edge-road-count! edge (+ (edge-road-count edge) count)))
|
||||||
|
(loop
|
||||||
|
(cdr road)
|
||||||
|
(if (cell-city cell)
|
||||||
|
(cons (cell-city cell) cities-on-path)
|
||||||
|
cities-on-path)
|
||||||
|
)))))
|
||||||
|
|
||||||
|
; Road cost function when not creating new road. Only follow olready existing roads
|
||||||
|
; If #f is returned, no road can be built between a cell and its neighbour
|
||||||
|
(define (road-cost-no-new-road island origin direction)
|
||||||
|
(define i (car origin))
|
||||||
|
(define j (cdr origin))
|
||||||
|
(define ni (+ i (car direction)))
|
||||||
|
(define nj (+ j (cdr direction)))
|
||||||
|
(define ncell (island-get-cell island ni nj))
|
||||||
|
(and (< 0 (cell-road-count ncell)) 1))
|
||||||
|
|
||||||
|
; Heuristic cost of a cell when not creating new roads
|
||||||
|
(define (heuristic-cost-no-new-road island origin destination)
|
||||||
|
(distance-between origin destination))
|
||||||
|
|
||||||
|
; Road size depending on the cities
|
||||||
|
(define (road-size ct1 ct2)
|
||||||
|
(define size-ct1 (city-size ct1))
|
||||||
|
(define size-ct2 (city-size ct2))
|
||||||
|
(define ct1-capital? (eq? 'capital size-ct1))
|
||||||
|
(define ct2-capital? (eq? 'capital size-ct2))
|
||||||
|
(define ct1-city? (eq? 'city size-ct1))
|
||||||
|
(define ct2-city? (eq? 'city size-ct2))
|
||||||
|
(define ct1-town? (eq? 'town size-ct1))
|
||||||
|
(define ct2-town? (eq? 'town size-ct2))
|
||||||
|
(cond
|
||||||
|
((and (or ct1-capital? ct1-city?)
|
||||||
|
(or ct2-capital? ct2-city?))
|
||||||
|
16)
|
||||||
|
((and (or ct1-capital? ct1-city? ct1-town?)
|
||||||
|
ct2-town?)
|
||||||
|
8)
|
||||||
|
(#t
|
||||||
|
1)))
|
||||||
|
|
||||||
|
; Add roads
|
||||||
|
(define (add-roads! island)
|
||||||
|
; link every municipality to its neighbours
|
||||||
|
(hash-for-each
|
||||||
|
(island-municipality-neighbours island)
|
||||||
|
(lambda (ct1 v)
|
||||||
|
(define region? (or (eq? 'capital (city-size ct1)) (eq? 'city (city-size ct1))))
|
||||||
|
(define canton? (or (eq? 'capital (city-size ct1)) (eq? 'city (city-size ct1)) (eq? 'town (city-size ct1))))
|
||||||
|
(for-each
|
||||||
|
(lambda (ct2)
|
||||||
|
(when (not (hash-has-key? (city-roads-to ct1) ct2))
|
||||||
|
(draw-road
|
||||||
|
island ct1 ct2
|
||||||
|
; Use the right road importance
|
||||||
|
(road-size ct1 ct2)
|
||||||
|
road-cost heuristic-cost)))
|
||||||
|
v)))
|
||||||
|
; Link every canton to its neighbours - don't create new roads, only improve existing ones
|
||||||
|
(hash-for-each
|
||||||
|
(island-canton-neighbours island)
|
||||||
|
(lambda (ct1 v)
|
||||||
|
(for-each
|
||||||
|
(lambda (ct2)
|
||||||
|
(when (not (hash-has-key? (city-roads-to ct1) ct2))
|
||||||
|
(draw-road island ct1 ct2 (road-size ct1 ct2) road-cost-no-new-road heuristic-cost-no-new-road)))
|
||||||
|
v)))
|
||||||
|
; Link every region to its neighbours - don't create new roads, only improve existing ones
|
||||||
|
(hash-for-each
|
||||||
|
(island-region-neighbours island)
|
||||||
|
(lambda (ct1 v)
|
||||||
|
(for-each
|
||||||
|
(lambda (ct2)
|
||||||
|
(when (not (hash-has-key? (city-roads-to ct1) ct2))
|
||||||
|
(draw-road island ct1 ct2 (road-size ct1 ct2) road-cost-no-new-road heuristic-cost-no-new-road)))
|
||||||
|
v)))
|
||||||
|
)
|
||||||
|
|
||||||
|
; Island generator
|
||||||
(define (island-generate size)
|
(define (island-generate size)
|
||||||
; Create an island
|
(define island (make-island size size))
|
||||||
(define island
|
|
||||||
(s-island
|
|
||||||
(make-2d-array size size (cell))
|
|
||||||
))
|
|
||||||
; Set the altitude
|
|
||||||
(time
|
(time
|
||||||
(displayln "Define altitude")
|
(displayln "Add Island")
|
||||||
(island-set-altitude! island))
|
(island-set-altitude! island))
|
||||||
; Erosion pass
|
|
||||||
(time
|
(time
|
||||||
(displayln "Erosion pass")
|
(displayln "Add Erosion")
|
||||||
(island-erode! island))
|
(island-erode! island))
|
||||||
; Definition of sea
|
|
||||||
(time
|
(time
|
||||||
(displayln "Sea definition")
|
(displayln "Add Sea")
|
||||||
(island-set-sea! island))
|
(island-set-sea! island))
|
||||||
; Definition of temperatures
|
|
||||||
(time
|
(time
|
||||||
(displayln "Temperature definition")
|
(displayln "Add Temperature")
|
||||||
(island-set-temperature! island))
|
(island-set-temperature! island))
|
||||||
; Definition of rainfall
|
|
||||||
(time
|
(time
|
||||||
(displayln "Rainfall definition")
|
(displayln "Add Rainfall")
|
||||||
(island-set-rainfall! island))
|
(island-set-rainfall! island))
|
||||||
; Definition of biome
|
|
||||||
(time
|
(time
|
||||||
(displayln "Biome definition")
|
(displayln "Add River springs")
|
||||||
|
(add-river-springs! island))
|
||||||
|
(time
|
||||||
|
(displayln "Add Rivers")
|
||||||
|
(add-rivers! island))
|
||||||
|
(time
|
||||||
|
(displayln "Add biomes")
|
||||||
(island-set-biome! island))
|
(island-set-biome! island))
|
||||||
; Definition of rivers and lakes
|
(time
|
||||||
; TODO
|
(displayln "Add Voronoi cells")
|
||||||
; Definition of towns
|
(add-voronoi-cells! island))
|
||||||
; TODO
|
(time
|
||||||
; Definition of roads
|
(displayln "Add cities")
|
||||||
; TODO
|
(add-cities! island))
|
||||||
; Return the island
|
(time
|
||||||
|
(displayln "Add territories")
|
||||||
|
(add-territories! island))
|
||||||
|
(time
|
||||||
|
(displayln "Add neighbours")
|
||||||
|
(add-neighbours! island))
|
||||||
|
(time
|
||||||
|
(displayln "Add roads")
|
||||||
|
(add-roads! island))
|
||||||
island)
|
island)
|
||||||
|
|
|
@ -9,6 +9,9 @@
|
||||||
biome-name
|
biome-name
|
||||||
biome-color
|
biome-color
|
||||||
compute-biome
|
compute-biome
|
||||||
|
;
|
||||||
|
biome-city-score
|
||||||
|
biome-new-road-cost
|
||||||
)
|
)
|
||||||
|
|
||||||
; Biome structure
|
; Biome structure
|
||||||
|
@ -18,8 +21,8 @@
|
||||||
color
|
color
|
||||||
rainfall-threshold ; annual, in cm per m²
|
rainfall-threshold ; annual, in cm per m²
|
||||||
temperature-threshold ; annual mean, in °C
|
temperature-threshold ; annual mean, in °C
|
||||||
; city-score ; a score indicating how plausible a city would be located in that biome
|
city-score ; a score indicating how plausible a city would be located in that biome
|
||||||
; new-road-cost ; cost to trace a new road in that biome
|
new-road-cost ; cost to trace a new road in that biome
|
||||||
))
|
))
|
||||||
; Constructor
|
; Constructor
|
||||||
(define (biome
|
(define (biome
|
||||||
|
@ -28,8 +31,8 @@
|
||||||
#:color [color (rgb-color 0 0 0)]
|
#:color [color (rgb-color 0 0 0)]
|
||||||
#:rainfall-threshold [rainfall-threshold +inf.0]
|
#:rainfall-threshold [rainfall-threshold +inf.0]
|
||||||
#:temperature-threshold [temperature-threshold +inf.0]
|
#:temperature-threshold [temperature-threshold +inf.0]
|
||||||
; #:city-score [city-score -inf.0]
|
#:city-score [city-score -inf.0]
|
||||||
; #:new-road-cost [new-road-cost #f]
|
#:new-road-cost [new-road-cost #f]
|
||||||
)
|
)
|
||||||
(s-biome
|
(s-biome
|
||||||
key
|
key
|
||||||
|
@ -37,8 +40,8 @@
|
||||||
color
|
color
|
||||||
rainfall-threshold
|
rainfall-threshold
|
||||||
temperature-threshold
|
temperature-threshold
|
||||||
; city-score
|
city-score
|
||||||
; new-road-cost
|
new-road-cost
|
||||||
))
|
))
|
||||||
|
|
||||||
; A small syntax to ease the definition of biomes
|
; A small syntax to ease the definition of biomes
|
||||||
|
@ -56,104 +59,104 @@
|
||||||
#:color (rgb-color 20 80 180)
|
#:color (rgb-color 20 80 180)
|
||||||
#:rainfall-threshold +inf.0
|
#:rainfall-threshold +inf.0
|
||||||
#:temperature-threshold +inf.0
|
#:temperature-threshold +inf.0
|
||||||
; #:city-score -inf.0
|
#:city-score -inf.0
|
||||||
; #:new-road-cost #f
|
#:new-road-cost #f
|
||||||
)
|
)
|
||||||
(lake
|
(lake
|
||||||
#:name "Lake"
|
#:name "Lake"
|
||||||
#:color (rgb-color 15 130 240)
|
#:color (rgb-color 15 130 240)
|
||||||
#:rainfall-threshold +inf.0
|
#:rainfall-threshold +inf.0
|
||||||
#:temperature-threshold +inf.0
|
#:temperature-threshold +inf.0
|
||||||
; #:city-score -inf.0
|
#:city-score -inf.0
|
||||||
; #:new-road-cost #f
|
#:new-road-cost #f
|
||||||
)
|
)
|
||||||
(tropical-rain-forest
|
(tropical-rain-forest
|
||||||
#:name "Tropical rain forest"
|
#:name "Tropical rain forest"
|
||||||
#:color (rgb-color 10 195 70)
|
#:color (rgb-color 10 195 70)
|
||||||
#:rainfall-threshold 250
|
#:rainfall-threshold 250
|
||||||
#:temperature-threshold 20
|
#:temperature-threshold 20
|
||||||
; #:city-score 50
|
#:city-score 50
|
||||||
; #:new-road-cost 120
|
#:new-road-cost 120
|
||||||
)
|
)
|
||||||
(tropical-seasonal-forest
|
(tropical-seasonal-forest
|
||||||
#:name "Tropical seasonal forest"
|
#:name "Tropical seasonal forest"
|
||||||
#:color (rgb-color 150 210 90)
|
#:color (rgb-color 150 210 90)
|
||||||
#:rainfall-threshold 100
|
#:rainfall-threshold 100
|
||||||
#:temperature-threshold 20
|
#:temperature-threshold 20
|
||||||
; #:city-score 100
|
#:city-score 100
|
||||||
; #:new-road-cost 60
|
#:new-road-cost 60
|
||||||
)
|
)
|
||||||
(savanna
|
(savanna
|
||||||
#:name "Savanna"
|
#:name "Savanna"
|
||||||
#:color (rgb-color 150 240 60)
|
#:color (rgb-color 150 240 60)
|
||||||
#:rainfall-threshold 30
|
#:rainfall-threshold 30
|
||||||
#:temperature-threshold 20
|
#:temperature-threshold 20
|
||||||
; #:city-score 120
|
#:city-score 120
|
||||||
; #:new-road-cost 30
|
#:new-road-cost 30
|
||||||
)
|
)
|
||||||
(subtropical-desert
|
(subtropical-desert
|
||||||
#:name "Subtropical desert"
|
#:name "Subtropical desert"
|
||||||
#:color (rgb-color 240 180 120)
|
#:color (rgb-color 240 180 120)
|
||||||
#:rainfall-threshold -inf.0
|
#:rainfall-threshold -inf.0
|
||||||
#:temperature-threshold 20
|
#:temperature-threshold 20
|
||||||
; #:city-score -100
|
#:city-score -100
|
||||||
; #:new-road-cost 20
|
#:new-road-cost 20
|
||||||
)
|
)
|
||||||
(temperate-rain-forest
|
(temperate-rain-forest
|
||||||
#:name "Temperate rain forest"
|
#:name "Temperate rain forest"
|
||||||
#:color (rgb-color 60 240 120)
|
#:color (rgb-color 60 240 120)
|
||||||
#:rainfall-threshold 200
|
#:rainfall-threshold 200
|
||||||
#:temperature-threshold 7
|
#:temperature-threshold 7
|
||||||
; #:city-score 80
|
#:city-score 80
|
||||||
; #:new-road-cost 120
|
#:new-road-cost 120
|
||||||
)
|
)
|
||||||
(temperate-deciduous-forest
|
(temperate-deciduous-forest
|
||||||
#:name "Temperate deciduous forest"
|
#:name "Temperate deciduous forest"
|
||||||
#:color (rgb-color 70 220 40)
|
#:color (rgb-color 70 220 40)
|
||||||
#:rainfall-threshold 100
|
#:rainfall-threshold 100
|
||||||
#:temperature-threshold 7
|
#:temperature-threshold 7
|
||||||
; #:city-score 150
|
#:city-score 150
|
||||||
; #:new-road-cost 60
|
#:new-road-cost 60
|
||||||
)
|
)
|
||||||
(boreal-forest
|
(boreal-forest
|
||||||
#:name "Boreal forest"
|
#:name "Boreal forest"
|
||||||
#:color (rgb-color 10 190 130)
|
#:color (rgb-color 10 190 130)
|
||||||
#:rainfall-threshold 50
|
#:rainfall-threshold 50
|
||||||
#:temperature-threshold 0
|
#:temperature-threshold 0
|
||||||
; #:city-score 50
|
#:city-score 50
|
||||||
; #:new-road-cost 90
|
#:new-road-cost 90
|
||||||
)
|
)
|
||||||
(shrubland
|
(shrubland
|
||||||
#:name "Shrubland"
|
#:name "Shrubland"
|
||||||
#:color (rgb-color 130 170 30)
|
#:color (rgb-color 130 170 30)
|
||||||
#:rainfall-threshold 50
|
#:rainfall-threshold 50
|
||||||
#:temperature-threshold 7
|
#:temperature-threshold 7
|
||||||
; #:city-score 90
|
#:city-score 90
|
||||||
; #:new-road-cost 50
|
#:new-road-cost 50
|
||||||
)
|
)
|
||||||
(grassland
|
(grassland
|
||||||
#:name "Grassland"
|
#:name "Grassland"
|
||||||
#:color (rgb-color 200 240 70)
|
#:color (rgb-color 200 240 70)
|
||||||
#:rainfall-threshold -inf.0
|
#:rainfall-threshold -inf.0
|
||||||
#:temperature-threshold 0
|
#:temperature-threshold 0
|
||||||
; #:city-score 70
|
#:city-score 70
|
||||||
; #:new-road-cost 20
|
#:new-road-cost 20
|
||||||
)
|
)
|
||||||
(tundra
|
(tundra
|
||||||
#:name "Tundra"
|
#:name "Tundra"
|
||||||
#:color (rgb-color 30 230 230)
|
#:color (rgb-color 30 230 230)
|
||||||
#:rainfall-threshold -inf.0
|
#:rainfall-threshold -inf.0
|
||||||
#:temperature-threshold -10
|
#:temperature-threshold -10
|
||||||
; #:city-score -100
|
#:city-score -100
|
||||||
; #:new-road-cost 20
|
#:new-road-cost 20
|
||||||
)
|
)
|
||||||
(ice-shelf
|
(ice-shelf
|
||||||
#:name "Ice shelf"
|
#:name "Ice shelf"
|
||||||
#:color (rgb-color 160 250 250)
|
#:color (rgb-color 160 250 250)
|
||||||
#:rainfall-threshold -inf.0
|
#:rainfall-threshold -inf.0
|
||||||
#:temperature-threshold -inf.0
|
#:temperature-threshold -inf.0
|
||||||
; #:city-score -10000
|
#:city-score -10000
|
||||||
; #:new-road-cost 800
|
#:new-road-cost 800
|
||||||
)
|
)
|
||||||
))
|
))
|
||||||
|
|
||||||
|
@ -162,6 +165,10 @@
|
||||||
(s-biome-name (hash-ref biomes b)))
|
(s-biome-name (hash-ref biomes b)))
|
||||||
(define (biome-color b)
|
(define (biome-color b)
|
||||||
(s-biome-color (hash-ref biomes b)))
|
(s-biome-color (hash-ref biomes b)))
|
||||||
|
(define (biome-city-score b)
|
||||||
|
(s-biome-city-score (hash-ref biomes b)))
|
||||||
|
(define (biome-new-road-cost b)
|
||||||
|
(s-biome-new-road-cost (hash-ref biomes b)))
|
||||||
|
|
||||||
; Sort by temperature, then by rainfall
|
; Sort by temperature, then by rainfall
|
||||||
(define (sort-by-temperature-rainfall lst-biomes)
|
(define (sort-by-temperature-rainfall lst-biomes)
|
||||||
|
|
|
@ -1,76 +0,0 @@
|
||||||
#lang racket/base
|
|
||||||
|
|
||||||
; Cell of island generator
|
|
||||||
; The island generator uses cells to discretely represents the map
|
|
||||||
|
|
||||||
(provide
|
|
||||||
; Constructor
|
|
||||||
cell
|
|
||||||
; Accessors
|
|
||||||
cell-altitude set-cell-altitude
|
|
||||||
cell-biome set-cell-biome
|
|
||||||
cell-temperature set-cell-temperature
|
|
||||||
cell-rainfall set-cell-rainfall
|
|
||||||
)
|
|
||||||
|
|
||||||
; Cell structure
|
|
||||||
(struct s-cell
|
|
||||||
(altitude ; number
|
|
||||||
biome ; symbol or #f is not set
|
|
||||||
temperature ; number, in °C
|
|
||||||
rainfall ; number, annual in cm per m²
|
|
||||||
))
|
|
||||||
|
|
||||||
; Cell constructor
|
|
||||||
(define (cell)
|
|
||||||
(s-cell
|
|
||||||
0
|
|
||||||
#f
|
|
||||||
0
|
|
||||||
0))
|
|
||||||
|
|
||||||
; Accessors
|
|
||||||
; Altitude
|
|
||||||
(define (cell-altitude c)
|
|
||||||
(s-cell-altitude c))
|
|
||||||
; Return a new cell copied from a cell with altitude changed
|
|
||||||
(define (set-cell-altitude c alt)
|
|
||||||
(s-cell
|
|
||||||
alt
|
|
||||||
(s-cell-biome c)
|
|
||||||
(s-cell-temperature c)
|
|
||||||
(s-cell-rainfall c)
|
|
||||||
))
|
|
||||||
|
|
||||||
; Biome
|
|
||||||
(define (cell-biome c)
|
|
||||||
(s-cell-biome c))
|
|
||||||
; Return a new cell copied from a cell with biome changed
|
|
||||||
(define (set-cell-biome c biome)
|
|
||||||
(s-cell
|
|
||||||
(s-cell-altitude c)
|
|
||||||
biome
|
|
||||||
(s-cell-temperature c)
|
|
||||||
(s-cell-rainfall c)))
|
|
||||||
|
|
||||||
; Temperature
|
|
||||||
(define (cell-temperature c)
|
|
||||||
(s-cell-temperature c))
|
|
||||||
; Return a new cell copied from a cell with temperature changed
|
|
||||||
(define (set-cell-temperature c temperature)
|
|
||||||
(s-cell
|
|
||||||
(s-cell-altitude c)
|
|
||||||
(s-cell-biome c)
|
|
||||||
temperature
|
|
||||||
(s-cell-rainfall c)))
|
|
||||||
|
|
||||||
; Rainfall
|
|
||||||
(define (cell-rainfall c)
|
|
||||||
(s-cell-rainfall c))
|
|
||||||
; Return a new cell copied from a cell with rainfall changed
|
|
||||||
(define (set-cell-rainfall c rainfall)
|
|
||||||
(s-cell
|
|
||||||
(s-cell-altitude c)
|
|
||||||
(s-cell-biome c)
|
|
||||||
(s-cell-temperature c)
|
|
||||||
rainfall))
|
|
|
@ -0,0 +1,308 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require
|
||||||
|
racket/function
|
||||||
|
"../../collection/2d-array.rkt")
|
||||||
|
|
||||||
|
(provide
|
||||||
|
; points
|
||||||
|
point point-add
|
||||||
|
; directions
|
||||||
|
north south west east north-west north-east south-west south-east
|
||||||
|
river-directions
|
||||||
|
; edge
|
||||||
|
edge-river-count set-edge-river-count!
|
||||||
|
edge-road-count set-edge-road-count!
|
||||||
|
; cell
|
||||||
|
cell-voronoi-center set-cell-voronoi-center!
|
||||||
|
cell-altitude set-cell-altitude!
|
||||||
|
cell-biome set-cell-biome!
|
||||||
|
cell-temperature set-cell-temperature!
|
||||||
|
cell-rainfall set-cell-rainfall!
|
||||||
|
cell-river-spring?
|
||||||
|
cell-river-count set-cell-river-count!
|
||||||
|
cell-city-score set-cell-city-score!
|
||||||
|
cell-city set-cell-city!
|
||||||
|
cell-road-count set-cell-road-count!
|
||||||
|
cell-region set-cell-region!
|
||||||
|
cell-canton set-cell-canton!
|
||||||
|
cell-municipality set-cell-municipality!
|
||||||
|
; city
|
||||||
|
make-city
|
||||||
|
city-position city-score
|
||||||
|
city-size set-city-size!
|
||||||
|
city-roads-to
|
||||||
|
; island
|
||||||
|
make-island
|
||||||
|
island-cells
|
||||||
|
island-voronoi-centers set-island-voronoi-centers!
|
||||||
|
island-river-springs
|
||||||
|
island-sinkholes set-island-sinkholes!
|
||||||
|
island-cities set-island-cities!
|
||||||
|
island-municipality-neighbours
|
||||||
|
island-canton-neighbours
|
||||||
|
island-region-neighbours
|
||||||
|
;
|
||||||
|
island-get-cell island-is-inside?
|
||||||
|
island-pathfind
|
||||||
|
;
|
||||||
|
island-altitude island-biome island-temperature
|
||||||
|
island-rainfall island-river-spring? island-add-river-spring!
|
||||||
|
island-river-count island-city-score island-road-count
|
||||||
|
;
|
||||||
|
island-has-edges?
|
||||||
|
island-east-edge island-south-edge island-west-edge island-north-edge
|
||||||
|
island-edge island-edge-between
|
||||||
|
)
|
||||||
|
|
||||||
|
; Definitions around the concepts of edge/cell/island for the map of the island generator
|
||||||
|
|
||||||
|
; A point is a pair or two numbers
|
||||||
|
(define (point i j)
|
||||||
|
(cons i j))
|
||||||
|
|
||||||
|
; Points can be added
|
||||||
|
(define (point-add a b)
|
||||||
|
(cons (+ (car a) (car b))
|
||||||
|
(+ (cdr a) (cdr b))))
|
||||||
|
|
||||||
|
; Directions
|
||||||
|
(define north (point 0 -1))
|
||||||
|
(define south (point 0 1))
|
||||||
|
(define west (point -1 0))
|
||||||
|
(define east (point 1 0))
|
||||||
|
(define north-west (point-add north west))
|
||||||
|
(define north-east (point-add north east))
|
||||||
|
(define south-west (point-add south west))
|
||||||
|
(define south-east (point-add south east))
|
||||||
|
|
||||||
|
; River directions: rivers can't move in diagonals
|
||||||
|
(define river-directions
|
||||||
|
(list west north east south))
|
||||||
|
|
||||||
|
; Structure edge
|
||||||
|
(struct edge
|
||||||
|
([river-count #:mutable] ; number of river crossing the edge
|
||||||
|
[road-count #:mutable] ; number of roads crossing the edge
|
||||||
|
))
|
||||||
|
; constructor
|
||||||
|
(define (make-edge)
|
||||||
|
(edge
|
||||||
|
0 ; river-count
|
||||||
|
0 ; road-count
|
||||||
|
))
|
||||||
|
|
||||||
|
; City structure
|
||||||
|
(struct city
|
||||||
|
(position ; position of the city, as a point
|
||||||
|
score ; city score of the city
|
||||||
|
[size #:mutable] ; symbolic size of the city. Possible values: 'capital 'city 'town 'village
|
||||||
|
roads-to ; indicate the cities this one has a road to, to avoid building unnecessary roads
|
||||||
|
))
|
||||||
|
; city constructor
|
||||||
|
(define (make-city position score)
|
||||||
|
(city
|
||||||
|
position
|
||||||
|
score
|
||||||
|
'village ; default size
|
||||||
|
(make-hash) ; roads to
|
||||||
|
))
|
||||||
|
|
||||||
|
; Structure cell
|
||||||
|
(struct cell
|
||||||
|
(east-edge ; eastern edge
|
||||||
|
south-edge ; southern edge
|
||||||
|
[voronoi-center #:mutable] ; closest voronoi center to the cell
|
||||||
|
[altitude #:mutable] ; altitude of cell
|
||||||
|
[biome #:mutable] ; biome of the cell
|
||||||
|
[temperature #:mutable] ; Temperature
|
||||||
|
[rainfall #:mutable] ; Rainfall
|
||||||
|
[river-spring? #:mutable] ; tell if the cell is a river spring
|
||||||
|
[river-count #:mutable] ; how many rivers go on the cell
|
||||||
|
[city-score #:mutable] ; how the cell is compatible with the presence of a city
|
||||||
|
[city #:mutable] ; the city on the cell or #f
|
||||||
|
[road-count #:mutable] ; how many roads go on the cell
|
||||||
|
[region #:mutable] ; city the territory belongs to
|
||||||
|
[canton #:mutable] ; town, or city the territory belongs to
|
||||||
|
[municipality #:mutable] ; village, town, or city the territory belongs to
|
||||||
|
))
|
||||||
|
|
||||||
|
(define (make-cell)
|
||||||
|
(cell
|
||||||
|
(make-edge) ; eastern edge
|
||||||
|
(make-edge) ; southern edge
|
||||||
|
#f ; voronoi center
|
||||||
|
0 ; altitude
|
||||||
|
#f ; biome
|
||||||
|
0 ; temperature
|
||||||
|
0 ; rainfall
|
||||||
|
#f ; river spring
|
||||||
|
0 ; river count
|
||||||
|
0 ; city-score
|
||||||
|
#f; city
|
||||||
|
0 ; road count
|
||||||
|
#f ; region
|
||||||
|
#f ; canton
|
||||||
|
#f ; municipality
|
||||||
|
))
|
||||||
|
|
||||||
|
; An island is a 2d vector of cell
|
||||||
|
(struct island
|
||||||
|
(cells ; array of arrays of cells
|
||||||
|
[voronoi-centers #:mutable] ; list of points used as centers for voronoi cells
|
||||||
|
[river-springs #:mutable] ; list of river springs
|
||||||
|
[sinkholes #:mutable] ; list of sinkholes, used to draw lakes
|
||||||
|
[cities #:mutable] ; list of cities
|
||||||
|
municipality-neighbours ; table of neighbours by municipalities
|
||||||
|
canton-neighbours ; table of neighbours by cantons
|
||||||
|
region-neighbours ; table of neighbours by regions
|
||||||
|
))
|
||||||
|
|
||||||
|
; Constructor for an island
|
||||||
|
(define (make-island width height)
|
||||||
|
(island
|
||||||
|
(build-2d-array
|
||||||
|
width height
|
||||||
|
(lambda (i j)
|
||||||
|
(make-cell))) ; cells
|
||||||
|
(list) ; voronoi cells
|
||||||
|
(list) ; river-springs
|
||||||
|
(list) ; sinkholes
|
||||||
|
(list) ; cities
|
||||||
|
(make-hash) ; municipality-neighbours
|
||||||
|
(make-hash) ; canton-neighbours
|
||||||
|
(make-hash) ; region-neighbours
|
||||||
|
))
|
||||||
|
|
||||||
|
; Get the cell at a given coordinate
|
||||||
|
(define (island-get-cell zn x y)
|
||||||
|
(2d-array-ref (island-cells zn) x y))
|
||||||
|
|
||||||
|
; Check if a position is inside the island
|
||||||
|
(define (island-is-inside? zn x y)
|
||||||
|
(2d-array-inside? (island-cells zn) x y))
|
||||||
|
|
||||||
|
; Find a path from a point to another across a island using the costs functions
|
||||||
|
; The possible directions indicate the possible movements from a cell to another
|
||||||
|
; Return either a list of positions or #f if there is no path
|
||||||
|
(define (island-pathfind zn from to move-cost heuristic-cost [possible-directions river-directions])
|
||||||
|
(define position-cost (make-hash)) ; cost of each position
|
||||||
|
(define path (make-hash)) ; from which position do we go to another one ? (cell-to->cell-from)
|
||||||
|
; Build the path
|
||||||
|
(define (build-path lst current)
|
||||||
|
(if current
|
||||||
|
(build-path (cons current lst) (hash-ref path current))
|
||||||
|
lst))
|
||||||
|
; add a list of new position to the frontier
|
||||||
|
(define (push lst-next lst-frontier)
|
||||||
|
(sort
|
||||||
|
(append lst-next lst-frontier)
|
||||||
|
(lambda (x y) (< (cdr x) (cdr y)))))
|
||||||
|
; Return the next position and its cost from a current position and a direction
|
||||||
|
; Return #f if there is no way to go to the next position (or if it has already been visited with a lower cost)
|
||||||
|
(define (next+cost current-position next-direction)
|
||||||
|
(define move (move-cost zn current-position next-direction))
|
||||||
|
(define new-cost (and move (+ move (hash-ref position-cost current-position))))
|
||||||
|
(define next-position (point-add current-position next-direction))
|
||||||
|
(define next-cost (hash-ref position-cost next-position #f))
|
||||||
|
(if (and new-cost (or (not next-cost) (< new-cost next-cost)))
|
||||||
|
(begin
|
||||||
|
(hash-set! position-cost next-position new-cost)
|
||||||
|
(hash-set! path next-position current-position)
|
||||||
|
(cons next-position (+ new-cost (heuristic-cost zn next-position to))))
|
||||||
|
#f))
|
||||||
|
; Get the neighbours of a given position
|
||||||
|
(define (neighbours current-position)
|
||||||
|
(filter
|
||||||
|
identity
|
||||||
|
(map
|
||||||
|
(lambda (x) (next+cost current-position x))
|
||||||
|
possible-directions)))
|
||||||
|
; find the path
|
||||||
|
(define (findpath frontier)
|
||||||
|
(cond
|
||||||
|
((null? frontier) #f)
|
||||||
|
((equal? (caar frontier) to) (build-path (list) to))
|
||||||
|
(#t (findpath (push (neighbours (caar frontier)) (cdr frontier))))))
|
||||||
|
; Compute the path
|
||||||
|
(hash-set! position-cost from 0)
|
||||||
|
(hash-set! path from #f)
|
||||||
|
(findpath (list (cons from 0))))
|
||||||
|
|
||||||
|
; Get the altitude of a cell
|
||||||
|
(define (island-altitude zn x y)
|
||||||
|
(cell-altitude (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the biome of a cell
|
||||||
|
(define (island-biome zn x y)
|
||||||
|
(cell-biome (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the temperature of a cell
|
||||||
|
(define (island-temperature zn x y)
|
||||||
|
(cell-temperature (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the rainfall of a cell
|
||||||
|
(define (island-rainfall zn x y)
|
||||||
|
(cell-rainfall (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the spring status of a cell
|
||||||
|
(define (island-river-spring? zn x y)
|
||||||
|
(cell-river-spring? (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Add a river spring
|
||||||
|
(define (island-add-river-spring! zn x y)
|
||||||
|
(set-cell-river-spring?! (island-get-cell zn x y) #t)
|
||||||
|
(set-island-river-springs! zn (cons (cons x y) (island-river-springs zn))))
|
||||||
|
|
||||||
|
; Get the river count of a cell
|
||||||
|
(define (island-river-count zn x y)
|
||||||
|
(cell-river-count (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the city score of a cell
|
||||||
|
(define (island-city-score zn x y)
|
||||||
|
(cell-city-score (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; Get the road count of a cell
|
||||||
|
(define (island-road-count zn x y)
|
||||||
|
(cell-road-count (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; edges
|
||||||
|
; Check if the 4 edges of the given cell are defined
|
||||||
|
(define (island-has-edges? zn x y)
|
||||||
|
(and (island-is-inside? zn x y) ; east and south edges
|
||||||
|
(island-is-inside? zn (- x 1) y) ; west edge
|
||||||
|
(island-is-inside? zn x (- y 1)))) ; north edge
|
||||||
|
|
||||||
|
; east edge
|
||||||
|
(define (island-east-edge zn x y)
|
||||||
|
(cell-east-edge (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; south edge
|
||||||
|
(define (island-south-edge zn x y)
|
||||||
|
(cell-south-edge (island-get-cell zn x y)))
|
||||||
|
|
||||||
|
; west edge [east edge of (x-1,y)]
|
||||||
|
(define (island-west-edge zn x y)
|
||||||
|
(cell-east-edge (island-get-cell zn (- x 1) y)))
|
||||||
|
|
||||||
|
; north edge [south edge of (x,y-1)]
|
||||||
|
(define (island-north-edge zn x y)
|
||||||
|
(cell-south-edge (island-get-cell zn x (- y 1))))
|
||||||
|
|
||||||
|
; edge from a direction
|
||||||
|
(define (island-edge zn x y dir)
|
||||||
|
(cond
|
||||||
|
((equal? dir north)
|
||||||
|
(island-north-edge zn x y))
|
||||||
|
((equal? dir south)
|
||||||
|
(island-south-edge zn x y))
|
||||||
|
((equal? dir west)
|
||||||
|
(island-west-edge zn x y))
|
||||||
|
((equal? dir east)
|
||||||
|
(island-east-edge zn x y))
|
||||||
|
(#t #f)))
|
||||||
|
|
||||||
|
; edge between two points
|
||||||
|
(define (island-edge-between zn x1 y1 x2 y2)
|
||||||
|
(define diff (point (- x2 x1) (- y2 y1)))
|
||||||
|
(island-edge zn x1 y1 diff))
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
; Render a 2d-array of cells into several layers of geographic data
|
; Render a 2d-array of cells into several layers of geographic data
|
||||||
(require
|
(require
|
||||||
"cell.rkt"
|
"island.rkt"
|
||||||
"biome.rkt"
|
"biome.rkt"
|
||||||
"../../collection/2d-array.rkt"
|
"../../collection/2d-array.rkt"
|
||||||
"../../graphics/color.rkt"
|
"../../graphics/color.rkt"
|
||||||
|
@ -11,9 +11,6 @@
|
||||||
(provide
|
(provide
|
||||||
island-render)
|
island-render)
|
||||||
|
|
||||||
; Size of cells when rendered
|
|
||||||
(define cell-size 4) ; Each cell is represented by a (4px × 4px) rectangle
|
|
||||||
|
|
||||||
; Brush to use to render the altitude
|
; Brush to use to render the altitude
|
||||||
(define (altitude-brush cell)
|
(define (altitude-brush cell)
|
||||||
(define alt (cell-altitude cell))
|
(define alt (cell-altitude cell))
|
||||||
|
@ -57,76 +54,250 @@
|
||||||
; Brush to use to render the temperature
|
; Brush to use to render the temperature
|
||||||
(define (temperature-brush cell)
|
(define (temperature-brush cell)
|
||||||
(define temp (cell-temperature cell))
|
(define temp (cell-temperature cell))
|
||||||
(make-brush
|
(define bio (cell-biome cell))
|
||||||
(cond
|
; Do not draw over the sea
|
||||||
((< 35 temp) (rgb-color 255 70 70))
|
(if (eq? bio 'sea)
|
||||||
((< 30 temp) (rgb-color 255 0 0))
|
#f
|
||||||
((< 25 temp) (rgb-color 255 130 0))
|
(make-brush
|
||||||
((< 20 temp) (rgb-color 255 175 0))
|
(cond
|
||||||
((< 15 temp) (rgb-color 255 230 0))
|
((< 35 temp) (rgb-color 255 70 70))
|
||||||
((< 10 temp) (rgb-color 230 255 0))
|
((< 30 temp) (rgb-color 255 0 0))
|
||||||
((< 5 temp) (rgb-color 130 255 0))
|
((< 25 temp) (rgb-color 255 130 0))
|
||||||
((< 0 temp) (rgb-color 0 255 255))
|
((< 20 temp) (rgb-color 255 175 0))
|
||||||
((< -5 temp) (rgb-color 0 200 255))
|
((< 15 temp) (rgb-color 255 230 0))
|
||||||
((< -10 temp) (rgb-color 0 115 255))
|
((< 10 temp) (rgb-color 230 255 0))
|
||||||
((< -15 temp) (rgb-color 0 0 255))
|
((< 5 temp) (rgb-color 130 255 0))
|
||||||
(#t (rgb-color 160 0 255))
|
((< 0 temp) (rgb-color 0 255 255))
|
||||||
)))
|
((< -5 temp) (rgb-color 0 200 255))
|
||||||
|
((< -10 temp) (rgb-color 0 115 255))
|
||||||
|
((< -15 temp) (rgb-color 0 0 255))
|
||||||
|
(#t (rgb-color 160 0 255))
|
||||||
|
))))
|
||||||
|
|
||||||
; Brush to use to render the rainfall
|
; Brush to use to render the rainfall
|
||||||
(define (rainfall-brush cell)
|
(define (rainfall-brush cell)
|
||||||
(define val (inexact->exact (floor (min (cell-rainfall cell) 255))))
|
(define val (inexact->exact (floor (min (cell-rainfall cell) 255))))
|
||||||
(make-brush
|
(define bio (cell-biome cell))
|
||||||
(rgb-color val val val)))
|
; Do not draw over the sea
|
||||||
|
(if (eq? bio 'sea)
|
||||||
|
#f
|
||||||
|
(make-brush
|
||||||
|
(rgb-color val val val))))
|
||||||
|
|
||||||
; Brush to use to render the biome
|
; Brush to use to render the biome
|
||||||
(define (biome-brush cell)
|
(define (biome-brush cell)
|
||||||
(make-brush
|
(define bio (cell-biome cell))
|
||||||
(biome-color (cell-biome cell))))
|
; Do not draw over the sea
|
||||||
|
(if (eq? bio 'sea)
|
||||||
|
#f
|
||||||
|
(make-brush
|
||||||
|
(biome-color bio))))
|
||||||
|
|
||||||
; Takes an array of cells, a brush procedure computing the color from a cell, and returns an image
|
; Brush to use to render the blank map
|
||||||
(define (render-cell-layer cells brush-proc)
|
(define (blank-brush cell)
|
||||||
(define image (make-image
|
(define bio (cell-biome cell))
|
||||||
(* cell-size (2d-array-width cells))
|
; Do not draw over the sea
|
||||||
(* cell-size (2d-array-height cells))))
|
(if (eq? bio 'sea)
|
||||||
; Render
|
#f
|
||||||
(2d-array-for-each/indexes
|
(make-brush
|
||||||
cells
|
(rgb-color 255 255 255))))
|
||||||
(lambda (cell i j)
|
|
||||||
(image-draw-square!
|
; Size of cells when rendered
|
||||||
image
|
(define cell-size 4) ; Each cell is represented by a (4px × 4px) rectangle
|
||||||
(* i cell-size)
|
|
||||||
(* j cell-size)
|
; Layer constructor
|
||||||
cell-size
|
(define (make-layer isl)
|
||||||
(brush-proc cell))))
|
(define cells (island-cells isl))
|
||||||
;
|
(make-image
|
||||||
image)
|
(* cell-size (2d-array-width cells))
|
||||||
|
(* cell-size (2d-array-height cells))))
|
||||||
|
|
||||||
; Layers on which the data is rendered
|
; Layers on which the data is rendered
|
||||||
; Each layer is an image
|
; Each layer is an image
|
||||||
(struct s-layers
|
(struct s-layers
|
||||||
(altitude
|
( ; Backgrounds
|
||||||
temperature
|
altitude
|
||||||
rainfall
|
temperature
|
||||||
biome
|
rainfall
|
||||||
|
biome
|
||||||
|
blank
|
||||||
|
; Foregrounds
|
||||||
|
rivers
|
||||||
|
cities
|
||||||
|
roads
|
||||||
|
territories
|
||||||
))
|
))
|
||||||
|
|
||||||
; Layers constructor
|
; Layers constructor
|
||||||
(define (layers cells)
|
(define (layers isl)
|
||||||
(s-layers
|
; Cells
|
||||||
(render-cell-layer cells altitude-brush)
|
(define cells (island-cells isl))
|
||||||
(render-cell-layer cells temperature-brush)
|
; Result
|
||||||
(render-cell-layer cells rainfall-brush)
|
(define lays
|
||||||
(render-cell-layer cells biome-brush)
|
(s-layers
|
||||||
))
|
(make-layer isl) ; altitude
|
||||||
|
(make-layer isl) ; temperature
|
||||||
|
(make-layer isl) ; rainfall
|
||||||
|
(make-layer isl) ; biome
|
||||||
|
(make-layer isl) ; blank
|
||||||
|
(make-layer isl) ; rivers
|
||||||
|
(make-layer isl) ; cities
|
||||||
|
(make-layer isl) ; roads
|
||||||
|
(make-layer isl) ; territories
|
||||||
|
))
|
||||||
|
; Sprite bank for cities - the name corresponds to the possible values of city-size
|
||||||
|
(define city-sprites
|
||||||
|
(make-sprite-bank
|
||||||
|
"static/images/island-cities.png"
|
||||||
|
'((capital 0 0 19 19)
|
||||||
|
(city 19 0 19 19)
|
||||||
|
(town 38 0 19 19)
|
||||||
|
(village 57 0 19 19))))
|
||||||
|
; Render
|
||||||
|
(2d-array-for-each/indexes
|
||||||
|
cells
|
||||||
|
(lambda (cell i j)
|
||||||
|
; A few definitions
|
||||||
|
(define x (* i cell-size))
|
||||||
|
(define y (* j cell-size))
|
||||||
|
; All background layers
|
||||||
|
(for-each
|
||||||
|
(lambda (layer+brush)
|
||||||
|
(image-draw-square!
|
||||||
|
((car layer+brush) lays)
|
||||||
|
x y
|
||||||
|
cell-size
|
||||||
|
((cdr layer+brush) cell)))
|
||||||
|
(list
|
||||||
|
(cons s-layers-altitude altitude-brush)
|
||||||
|
(cons s-layers-temperature temperature-brush)
|
||||||
|
(cons s-layers-rainfall rainfall-brush)
|
||||||
|
(cons s-layers-biome biome-brush)
|
||||||
|
(cons s-layers-blank blank-brush)))
|
||||||
|
; Foreground layers
|
||||||
|
; Rivers + lakes - not shown if there are ice-shelf
|
||||||
|
(define bio (cell-biome cell))
|
||||||
|
(define half-cell-size (/ cell-size 2))
|
||||||
|
(cond
|
||||||
|
( (eq? 'lake bio)
|
||||||
|
(image-draw-square!
|
||||||
|
(s-layers-rivers lays)
|
||||||
|
x y
|
||||||
|
cell-size
|
||||||
|
(biome-brush cell)))
|
||||||
|
( (and (not (eq? 'ice-shelf bio))
|
||||||
|
(not (eq? 'sea bio))
|
||||||
|
(< 0 (cell-river-count cell))
|
||||||
|
(island-has-edges? isl i j))
|
||||||
|
(for-each
|
||||||
|
(lambda (direction)
|
||||||
|
(define edge (island-edge isl i j direction))
|
||||||
|
(when (< 0 (edge-river-count edge))
|
||||||
|
(image-draw-line!
|
||||||
|
(s-layers-rivers lays)
|
||||||
|
(+ x half-cell-size) (+ y half-cell-size)
|
||||||
|
(+ x (* (+ 1 (car direction)) half-cell-size)) (+ y (* (+ 1 (cdr direction)) half-cell-size))
|
||||||
|
(make-pen
|
||||||
|
(biome-color 'lake)
|
||||||
|
(min (- cell-size 1) (+ 1 (floor (/ (edge-river-count edge) 10)))))
|
||||||
|
)))
|
||||||
|
river-directions)))
|
||||||
|
; Cities
|
||||||
|
(when (cell-city cell)
|
||||||
|
(image-draw-sprite!
|
||||||
|
(s-layers-cities lays)
|
||||||
|
(+ x half-cell-size -9) (+ y half-cell-size -9) ; -9 is sprite-size/2, sprite-size is 19
|
||||||
|
city-sprites
|
||||||
|
(city-size (cell-city cell))))
|
||||||
|
; Roads
|
||||||
|
(when (and (< 0 (cell-road-count cell))
|
||||||
|
(island-has-edges? isl i j))
|
||||||
|
(for-each
|
||||||
|
(lambda (direction)
|
||||||
|
(define edge (island-edge isl i j direction))
|
||||||
|
(when (< 0 (edge-road-count edge))
|
||||||
|
(image-draw-line!
|
||||||
|
(s-layers-roads lays)
|
||||||
|
(+ x half-cell-size) (+ y half-cell-size)
|
||||||
|
(+ x (* (+ 1 (car direction)) half-cell-size)) (+ y (* (+ 1 (cdr direction)) half-cell-size))
|
||||||
|
(make-pen
|
||||||
|
(named-color "red")
|
||||||
|
(min (- cell-size 1) (+ 1 (floor (/ (edge-road-count edge) 10)))))
|
||||||
|
)))
|
||||||
|
river-directions))
|
||||||
|
; Territories
|
||||||
|
(for-each
|
||||||
|
(lambda (dir)
|
||||||
|
(define ni (+ i (car dir)))
|
||||||
|
(define nj (+ j (cdr dir)))
|
||||||
|
(define ncell (and (island-is-inside? isl ni nj)
|
||||||
|
(island-get-cell isl ni nj)))
|
||||||
|
(define land? (and (not (eq? 'sea bio))
|
||||||
|
(and ncell (not (eq? 'sea (cell-biome ncell))))))
|
||||||
|
; Pen to use to draw the limit - use dotted lines if the border is at sea
|
||||||
|
(define pen
|
||||||
|
(cond
|
||||||
|
((and ncell (not (eq? (cell-region cell) (cell-region ncell))))
|
||||||
|
(make-pen (named-color "black") 2 (if land? 'solid 'dot)))
|
||||||
|
((and ncell (not (eq? (cell-canton cell) (cell-canton ncell))))
|
||||||
|
(make-pen (named-color "gray") 2 (if land? 'solid 'dot)))
|
||||||
|
((and ncell (not (eq? (cell-municipality cell) (cell-municipality ncell))))
|
||||||
|
(make-pen (named-color "gray") 1 (if land? 'solid 'dot)))
|
||||||
|
(#t #f)))
|
||||||
|
; Draw a line using the pen
|
||||||
|
(when pen
|
||||||
|
(image-draw-line!
|
||||||
|
(s-layers-territories lays)
|
||||||
|
(* ni cell-size) (* nj cell-size)
|
||||||
|
(+ x cell-size) (+ y cell-size)
|
||||||
|
pen)))
|
||||||
|
; check against the south and east
|
||||||
|
(list south east))
|
||||||
|
))
|
||||||
|
; Output
|
||||||
|
lays)
|
||||||
|
|
||||||
; Render an island into a directory
|
; Render an island into a directory
|
||||||
(define (island-render cells directory)
|
(define (island-render isl directory)
|
||||||
; Render the layers
|
; Render the layers
|
||||||
(define lays (layers cells))
|
(define lays (layers isl))
|
||||||
; Output the layers
|
; Output the layers
|
||||||
(image-save (s-layers-altitude lays) (string-append directory "/altitude.png"))
|
(for-each
|
||||||
(image-save (s-layers-temperature lays) (string-append directory "/temperature.png"))
|
(lambda (layer+file)
|
||||||
(image-save (s-layers-rainfall lays) (string-append directory "/rainfall.png"))
|
(image-save ((car layer+file) lays) (string-append directory "/" (cdr layer+file))))
|
||||||
(image-save (s-layers-biome lays) (string-append directory "/biome.png"))
|
(list
|
||||||
|
; Backgrounds
|
||||||
|
(cons s-layers-altitude "altitude.png")
|
||||||
|
(cons s-layers-temperature "temperature.png")
|
||||||
|
(cons s-layers-rainfall "rainfall.png")
|
||||||
|
(cons s-layers-biome "biomes.png")
|
||||||
|
(cons s-layers-blank "blank.png")
|
||||||
|
; Foregrounds
|
||||||
|
(cons s-layers-rivers "rivers.png")
|
||||||
|
(cons s-layers-cities "cities.png")
|
||||||
|
(cons s-layers-roads "roads.png")
|
||||||
|
(cons s-layers-territories "territories.png")
|
||||||
|
))
|
||||||
|
; Output composite images
|
||||||
|
(for-each
|
||||||
|
(lambda (layers+file)
|
||||||
|
(define composite (make-layer isl))
|
||||||
|
; Draw a sea biome background
|
||||||
|
(image-draw-rectangle!
|
||||||
|
composite
|
||||||
|
0 0 (image-width composite) (image-height composite)
|
||||||
|
(make-brush (biome-color 'sea)))
|
||||||
|
; Draw the layers
|
||||||
|
(for-each
|
||||||
|
(lambda (layer-proc)
|
||||||
|
(image-draw-image!
|
||||||
|
composite
|
||||||
|
(layer-proc lays)
|
||||||
|
0 0))
|
||||||
|
(car layers+file))
|
||||||
|
(image-save composite (string-append directory "/" (cdr layers+file))))
|
||||||
|
(list
|
||||||
|
(cons (list s-layers-altitude s-layers-rivers s-layers-cities) "altitude+rivers+cities.png")
|
||||||
|
(cons (list s-layers-blank s-layers-territories s-layers-cities) "blank+territories+cities.png")
|
||||||
|
))
|
||||||
)
|
)
|
||||||
|
|
Binary file not shown.
After Width: | Height: | Size: 1.5 KiB |
|
@ -0,0 +1,107 @@
|
||||||
|
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
|
||||||
|
<svg
|
||||||
|
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||||
|
xmlns:cc="http://creativecommons.org/ns#"
|
||||||
|
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||||
|
xmlns:svg="http://www.w3.org/2000/svg"
|
||||||
|
xmlns="http://www.w3.org/2000/svg"
|
||||||
|
xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
|
||||||
|
xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
|
||||||
|
inkscape:export-ydpi="96"
|
||||||
|
inkscape:export-xdpi="96"
|
||||||
|
inkscape:export-filename="/home/feufochmar/projets/feuforeve.fr/feuforeve.v4/static/images/island-towns.png"
|
||||||
|
sodipodi:docname="island-towns.svg"
|
||||||
|
inkscape:version="1.0 (4035a4fb49, 2020-05-01)"
|
||||||
|
id="svg8"
|
||||||
|
version="1.1"
|
||||||
|
viewBox="0 0 20.108333 5.0270835"
|
||||||
|
height="19"
|
||||||
|
width="76">
|
||||||
|
<defs
|
||||||
|
id="defs2" />
|
||||||
|
<sodipodi:namedview
|
||||||
|
inkscape:window-maximized="1"
|
||||||
|
inkscape:window-y="0"
|
||||||
|
inkscape:window-x="0"
|
||||||
|
inkscape:window-height="1049"
|
||||||
|
inkscape:window-width="1920"
|
||||||
|
showguides="false"
|
||||||
|
units="px"
|
||||||
|
showgrid="false"
|
||||||
|
inkscape:document-rotation="0"
|
||||||
|
inkscape:current-layer="layer1"
|
||||||
|
inkscape:document-units="mm"
|
||||||
|
inkscape:cy="5.6777641"
|
||||||
|
inkscape:cx="8.5212011"
|
||||||
|
inkscape:zoom="5.6568542"
|
||||||
|
inkscape:pageshadow="2"
|
||||||
|
inkscape:pageopacity="0.0"
|
||||||
|
borderopacity="1.0"
|
||||||
|
bordercolor="#666666"
|
||||||
|
pagecolor="#ffffff"
|
||||||
|
id="base" />
|
||||||
|
<metadata
|
||||||
|
id="metadata5">
|
||||||
|
<rdf:RDF>
|
||||||
|
<cc:Work
|
||||||
|
rdf:about="">
|
||||||
|
<dc:format>image/svg+xml</dc:format>
|
||||||
|
<dc:type
|
||||||
|
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
|
||||||
|
<dc:title></dc:title>
|
||||||
|
</cc:Work>
|
||||||
|
</rdf:RDF>
|
||||||
|
</metadata>
|
||||||
|
<g
|
||||||
|
id="layer1"
|
||||||
|
inkscape:groupmode="layer"
|
||||||
|
inkscape:label="Calque 1">
|
||||||
|
<circle
|
||||||
|
r="2.2489583"
|
||||||
|
cy="2.5135419"
|
||||||
|
cx="2.5135419"
|
||||||
|
id="path833"
|
||||||
|
style="fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:0.529167;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
|
||||||
|
<circle
|
||||||
|
r="1.7197917"
|
||||||
|
style="fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:0.529167;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
|
||||||
|
id="circle844"
|
||||||
|
cx="7.5406251"
|
||||||
|
cy="2.5135419" />
|
||||||
|
<circle
|
||||||
|
r="1.3229166"
|
||||||
|
cy="2.5135419"
|
||||||
|
cx="12.567709"
|
||||||
|
id="circle846"
|
||||||
|
style="fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:0.264583;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
|
||||||
|
<circle
|
||||||
|
r="0.79374999"
|
||||||
|
cy="2.5135419"
|
||||||
|
cx="17.594788"
|
||||||
|
id="circle848"
|
||||||
|
style="fill:#ffffff;fill-opacity:1;stroke:#000000;stroke-width:0.264583;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
|
||||||
|
<circle
|
||||||
|
r="0.52916664"
|
||||||
|
cy="2.5135419"
|
||||||
|
cx="7.5406251"
|
||||||
|
id="circle850"
|
||||||
|
style="fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0.529167;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1" />
|
||||||
|
<path
|
||||||
|
transform="scale(1,-1)"
|
||||||
|
inkscape:transform-center-y="-0.17013199"
|
||||||
|
d="M 2.513542,-0.73867083 2.0946522,-1.943763 0.81909749,-1.9697567 1.8357641,-2.7405386 1.4663176,-3.9616957 l 1.0472244,0.7287228 1.0472242,-0.7287229 -0.3694465,1.2211573 1.0166667,0.7707817 -1.2755548,0.025994 z"
|
||||||
|
inkscape:randomized="0"
|
||||||
|
inkscape:rounded="0"
|
||||||
|
inkscape:flatsided="false"
|
||||||
|
sodipodi:arg2="2.1991149"
|
||||||
|
sodipodi:arg1="1.5707963"
|
||||||
|
sodipodi:r2="0.71265775"
|
||||||
|
sodipodi:r1="1.7816443"
|
||||||
|
sodipodi:cy="-2.5203152"
|
||||||
|
sodipodi:cx="2.5135419"
|
||||||
|
sodipodi:sides="5"
|
||||||
|
id="path852"
|
||||||
|
style="fill:#000000;fill-opacity:1;stroke:#000000;stroke-width:0.264583;stroke-linecap:square;stroke-miterlimit:4;stroke-dasharray:none;stroke-opacity:1"
|
||||||
|
sodipodi:type="star" />
|
||||||
|
</g>
|
||||||
|
</svg>
|
After Width: | Height: | Size: 3.9 KiB |
Loading…
Reference in New Issue