309 lines
9.3 KiB
Racket
309 lines
9.3 KiB
Racket
#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))
|