304 lines
9.7 KiB
Racket
304 lines
9.7 KiB
Racket
#lang racket/base
|
||
|
||
; Render a 2d-array of cells into several layers of geographic data
|
||
(require
|
||
"island.rkt"
|
||
"biome.rkt"
|
||
"../../collection/2d-array.rkt"
|
||
"../../graphics/color.rkt"
|
||
"../../graphics/image.rkt")
|
||
|
||
(provide
|
||
island-render)
|
||
|
||
; Brush to use to render the altitude
|
||
(define (altitude-brush cell)
|
||
(define alt (cell-altitude cell))
|
||
(define bio (cell-biome cell))
|
||
(make-brush
|
||
(cond
|
||
((or (eq? bio 'ice-shelf)
|
||
(eq? bio 'lake))
|
||
(biome-color bio))
|
||
((and (eq? bio 'sea)
|
||
(>= -150 alt))
|
||
(rgb-color 10 40 90))
|
||
((and (eq? bio 'sea)
|
||
(>= -50 alt))
|
||
(rgb-color 15 60 135))
|
||
((eq? bio 'sea)
|
||
(rgb-color 20 80 180))
|
||
((< 3000 alt) (rgb-color 127 127 127))
|
||
((< 2600 alt) (rgb-color 100 100 100))
|
||
((< 2300 alt) (rgb-color 96 73 57))
|
||
((< 2000 alt) (rgb-color 77 47 26))
|
||
((< 1750 alt) (rgb-color 96 58 32))
|
||
((< 1500 alt) (rgb-color 134 82 45))
|
||
((< 1250 alt) (rgb-color 172 105 57))
|
||
((< 1000 alt) (rgb-color 204 140 51))
|
||
((< 800 alt) (rgb-color 215 153 66))
|
||
((< 650 alt) (rgb-color 235 180 71))
|
||
((< 500 alt) (rgb-color 245 236 137))
|
||
((< 400 alt) (rgb-color 201 237 94))
|
||
((< 300 alt) (rgb-color 153 230 77))
|
||
((< 200 alt) (rgb-color 115 201 29))
|
||
((< 150 alt) (rgb-color 88 184 20))
|
||
((< 100 alt) (rgb-color 62 170 9))
|
||
((< 50 alt) (rgb-color 31 145 8))
|
||
((< 0 alt) (rgb-color 21 128 0))
|
||
((< -50 alt) (rgb-color 15 113 0))
|
||
((< -100 alt) (rgb-color 9 98 0))
|
||
(#t (rgb-color 6 83 0))
|
||
)))
|
||
|
||
; Brush to use to render the temperature
|
||
(define (temperature-brush cell)
|
||
(define temp (cell-temperature cell))
|
||
(define bio (cell-biome cell))
|
||
; Do not draw over the sea
|
||
(if (eq? bio 'sea)
|
||
#f
|
||
(make-brush
|
||
(cond
|
||
((< 35 temp) (rgb-color 255 70 70))
|
||
((< 30 temp) (rgb-color 255 0 0))
|
||
((< 25 temp) (rgb-color 255 130 0))
|
||
((< 20 temp) (rgb-color 255 175 0))
|
||
((< 15 temp) (rgb-color 255 230 0))
|
||
((< 10 temp) (rgb-color 230 255 0))
|
||
((< 5 temp) (rgb-color 130 255 0))
|
||
((< 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
|
||
(define (rainfall-brush cell)
|
||
(define val (inexact->exact (floor (min (cell-rainfall cell) 255))))
|
||
(define bio (cell-biome cell))
|
||
; 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
|
||
(define (biome-brush cell)
|
||
(define bio (cell-biome cell))
|
||
; Do not draw over the sea
|
||
(if (eq? bio 'sea)
|
||
#f
|
||
(make-brush
|
||
(biome-color bio))))
|
||
|
||
; Brush to use to render the blank map
|
||
(define (blank-brush cell)
|
||
(define bio (cell-biome cell))
|
||
; Do not draw over the sea
|
||
(if (eq? bio 'sea)
|
||
#f
|
||
(make-brush
|
||
(rgb-color 255 255 255))))
|
||
|
||
; Size of cells when rendered
|
||
(define cell-size 4) ; Each cell is represented by a (4px × 4px) rectangle
|
||
|
||
; Layer constructor
|
||
(define (make-layer isl)
|
||
(define cells (island-cells isl))
|
||
(make-image
|
||
(* cell-size (2d-array-width cells))
|
||
(* cell-size (2d-array-height cells))))
|
||
|
||
; Layers on which the data is rendered
|
||
; Each layer is an image
|
||
(struct s-layers
|
||
( ; Backgrounds
|
||
altitude
|
||
temperature
|
||
rainfall
|
||
biome
|
||
blank
|
||
; Foregrounds
|
||
rivers
|
||
cities
|
||
roads
|
||
territories
|
||
))
|
||
|
||
; Layers constructor
|
||
(define (layers isl)
|
||
; Cells
|
||
(define cells (island-cells isl))
|
||
; Result
|
||
(define lays
|
||
(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
|
||
(define (island-render isl directory)
|
||
; Render the layers
|
||
(define lays (layers isl))
|
||
; Output the layers
|
||
(for-each
|
||
(lambda (layer+file)
|
||
(image-save ((car layer+file) lays) (string-append directory "/" (cdr layer+file))))
|
||
(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")
|
||
))
|
||
)
|