feuforeve.v4/src/generators/island/biome.rkt

#lang racket/base

; Biome information
; Each biome is refered by a symbol
(require
  "../../graphics/color.rkt")

(provide
  biome-name
  biome-color
  compute-biome
  ;
  biome-city-score
  biome-new-road-cost
  )

; Biome structure
(struct s-biome
  (key
   name
   color
   rainfall-threshold ; annual, in cm per m²
   temperature-threshold ; annual mean, in °C
   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
   ))
; Constructor
(define (biome
          #:key key
          #:name [name ""]
          #:color [color (rgb-color 0 0 0)]
          #:rainfall-threshold [rainfall-threshold +inf.0]
          #:temperature-threshold [temperature-threshold +inf.0]
          #:city-score [city-score -inf.0]
          #:new-road-cost [new-road-cost #f]
          )
  (s-biome
    key
    name
    color
    rainfall-threshold
    temperature-threshold
    city-score
    new-road-cost
    ))

; A small syntax to ease the definition of biomes
(define-syntax make-biomes
  (syntax-rules ()
    ((make-biomes (key val* ...) ...)
     (make-immutable-hash
       `((key . ,(biome #:key 'key val* ...)) ...)))))

; List of biomes
(define biomes
  (make-biomes
    (sea
      #:name "Sea"
      #:color (rgb-color 20 80 180)
      #:rainfall-threshold +inf.0
      #:temperature-threshold +inf.0
      #:city-score -inf.0
      #:new-road-cost #f
      )
    (lake
      #:name "Lake"
      #:color (rgb-color 15 130 240)
      #:rainfall-threshold +inf.0
      #:temperature-threshold +inf.0
      #:city-score -inf.0
      #:new-road-cost #f
      )
    (tropical-rain-forest
      #:name "Tropical rain forest"
      #:color (rgb-color 10 195 70)
      #:rainfall-threshold 250
      #:temperature-threshold 20
      #:city-score 50
      #:new-road-cost 120
      )
    (tropical-seasonal-forest
      #:name "Tropical seasonal forest"
      #:color (rgb-color 150 210 90)
      #:rainfall-threshold 100
      #:temperature-threshold 20
      #:city-score 100
      #:new-road-cost 60
      )
    (savanna
      #:name "Savanna"
      #:color (rgb-color 150 240 60)
      #:rainfall-threshold 30
      #:temperature-threshold 20
      #:city-score 120
      #:new-road-cost 30
      )
    (subtropical-desert
      #:name "Subtropical desert"
      #:color (rgb-color 240 180 120)
      #:rainfall-threshold -inf.0
      #:temperature-threshold 20
      #:city-score -100
      #:new-road-cost 20
      )
    (temperate-rain-forest
      #:name "Temperate rain forest"
      #:color (rgb-color 60 240 120)
      #:rainfall-threshold 200
      #:temperature-threshold 7
      #:city-score 80
      #:new-road-cost 120
      )
    (temperate-deciduous-forest
      #:name "Temperate deciduous forest"
      #:color (rgb-color 70 220 40)
      #:rainfall-threshold 100
      #:temperature-threshold 7
      #:city-score 150
      #:new-road-cost 60
      )
    (boreal-forest
      #:name "Boreal forest"
      #:color (rgb-color 10 190 130)
      #:rainfall-threshold 50
      #:temperature-threshold 0
      #:city-score 50
      #:new-road-cost 90
      )
    (shrubland
      #:name "Shrubland"
      #:color (rgb-color 130 170 30)
      #:rainfall-threshold 50
      #:temperature-threshold 7
      #:city-score 90
      #:new-road-cost 50
      )
    (grassland
      #:name "Grassland"
      #:color (rgb-color 200 240 70)
      #:rainfall-threshold -inf.0
      #:temperature-threshold 0
      #:city-score 70
      #:new-road-cost 20
      )
    (tundra
      #:name "Tundra"
      #:color (rgb-color 30 230 230)
      #:rainfall-threshold -inf.0
      #:temperature-threshold -10
      #:city-score -100
      #:new-road-cost 20
      )
    (ice-shelf
      #:name "Ice shelf"
      #:color (rgb-color 160 250 250)
      #:rainfall-threshold -inf.0
      #:temperature-threshold -inf.0
      #:city-score -10000
      #:new-road-cost 800
      )
    ))

; Accessors from their key
(define (biome-name b)
  (s-biome-name (hash-ref biomes b)))
(define (biome-color 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
(define (sort-by-temperature-rainfall lst-biomes)
  (sort
    lst-biomes
    (lambda (x y)
      (or (> (s-biome-temperature-threshold x) (s-biome-temperature-threshold y))
          (and (eq? (s-biome-temperature-threshold x) (s-biome-temperature-threshold y))
               (> (s-biome-rainfall-threshold x) (s-biome-rainfall-threshold y)))))))

; Sort by rainfall, then by temperature
(define (sort-by-rainfall-temperature lst-biomes)
  (sort
    lst-biomes
    (lambda (x y)
      (or (> (s-biome-rainfall-threshold x) (s-biome-rainfall-threshold y))
          (and (eq? (s-biome-rainfall-threshold x) (s-biome-rainfall-threshold y))
               (> (s-biome-temperature-threshold x) (s-biome-temperature-threshold y)))))))

(define sorted-biomes
  (sort-by-temperature-rainfall
    (hash-values biomes)))

; Compute a biome from parameters
(define (compute-biome old-biome temperature rainfall)
  (cond
    ; TODO: Add special case for ice-shelf generation ?
    (old-biome old-biome) ; Do not change if already set
    (#t
      (s-biome-key
        (car
          (filter
            (lambda (x)
              (and (> temperature (s-biome-temperature-threshold x))
                   (> rainfall (s-biome-rainfall-threshold x))))
            sorted-biomes))))))