001  (ns ^{:doc "Functions to apply a heightmap to a world.
002              
003              Heightmaps are considered only as greyscale images, so colour is redundent
004              (will be ignored). Darker shades are higher."
005        :author "Simon Brooke"}
006    mw-engine.heightmap
007    (:require [mikera.image.core :refer [load-image filter-image]]
008              [mikera.image.filters :as filters]
009              [mw-engine.utils :refer [get-int get-neighbours map-world]]
010              [mw-engine.world :refer [make-world]]))
011  
012  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
013  ;;;;
014  ;;;; mw-engine: the state/transition engine of MicroWorld.
015  ;;;;
016  ;;;; This program is free software; you can redistribute it and/or
017  ;;;; modify it under the terms of the GNU General Public License
018  ;;;; as published by the Free Software Foundation; either version 2
019  ;;;; of the License, or (at your option) any later version.
020  ;;;;
021  ;;;; This program is distributed in the hope that it will be useful,
022  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
023  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
024  ;;;; GNU General Public License for more details.
025  ;;;;
026  ;;;; You should have received a copy of the GNU General Public License
027  ;;;; along with this program; if not, write to the Free Software
028  ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
029  ;;;; USA.
030  ;;;;
031  ;;;; Copyright (C) 2014 Simon Brooke
032  ;;;;
033  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
034  
035  (defn tag-property
036    "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`.
037     If the heightmap you supply is smaller than the world, this will break.
038  
039     * `world` not actually used, but present to enable this function to be
040       passed as an argument to `mw-engine.utils/map-world`, q.v.
041     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map;
042     * `property` the property (normally a keyword) whose value will be set on the cell.
043     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should
044       exceed those of the world of which the `cell` forms part."
045    ([_ cell property heightmap]
046      (tag-property cell property heightmap))
047    ([cell property heightmap]
048      (merge cell
049             {property
050              (+ (get-int cell property)
051                 (- 256
052                    (abs
053                      (mod
054                        (.getRGB heightmap
055                          (get-int cell :x)
056                          (get-int cell :y)) 256))))})))
057  
058  (defn tag-gradient
059    "Set the `gradient` property of this `cell` of this `world` to the difference in
060     altitude between its highest and lowest neghbours."
061    [world cell]
062    (let [heights (remove nil? (map :altitude (get-neighbours world cell)))
063          highest (cond (empty? heights) 0 ;; shouldn't happen
064                    :else (apply max heights))
065          lowest (cond (empty? heights) 0 ;; shouldn't
066                   :else (apply min heights))
067          gradient (- highest lowest)]
068      (merge cell {:gradient gradient})))
069  
070  (defn tag-gradients
071    "Set the `gradient` property of each cell in this `world` to the difference in
072     altitude between its highest and lowest neghbours."
073    [world]
074    (map-world world tag-gradient))
075  
076  (defn tag-altitude
077    "Set the altitude of this cell from the corresponding pixel of this heightmap.
078     If the heightmap you supply is smaller than the world, this will break.
079  
080     * `world` not actually used, but present to enable this function to be
081       passed as an argument to `mw-engine.utils/map-world`, q.v.;
082     * `cell` a cell, as discussed in world.clj, q.v. Alternatively, a map;
083     * `heightmap` an (ideally) greyscale image, whose x and y dimensions should
084       exceed those of the world of which the `cell` forms part."
085    ([_ cell heightmap]
086      (tag-property cell :altitude heightmap))
087    ([cell heightmap]
088      (tag-property cell :altitude heightmap)))
089  
090  (defn apply-heightmap
091    "Apply the image file loaded from this path to this world, and return a world whose
092    altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that
093    the heightmap is at least as large in x and y dimensions as the world. Note that, in
094    addition to setting the `:altitude` of each cell, this function also sets the `:gradient`.
095  
096    * `world` a world, as defined in `world.clj`, q.v.; if world is not supplied,
097      a world the size of the heightmap will be created;
098    * `imagepath` a file path or URL which indicates an (ideally greyscale) image file."
099    ([world imagepath]
100      (let [heightmap (filter-image
101                       (load-image imagepath)
102                        (filters/grayscale))]
103        (map-world
104          (map-world world tag-altitude (list heightmap))
105          tag-gradient)))
106     ([imagepath]
107      (let [heightmap (filter-image
108                        (load-image imagepath)
109                        (filters/grayscale))
110            world (make-world (.getWidth heightmap) (.getHeight heightmap))]
111        (map-world
112          (map-world world tag-altitude (list heightmap))
113          tag-gradient))))
114  
115  (defn apply-valuemap
116    "Generalised from apply-heightmap, set an arbitrary property on each cell
117     of this `world` from the values in this (ideally greyscale) heightmap.
118  
119     * `world` a world, as defined in `world.clj`, q.v.;
120     * `imagepath` a file path or URL which indicates an (ideally greyscale) image file;
121     * `property` the property of each cell whose value should be added to from the
122        intensity of the corresponding cell of the image."
123    [world imagepath property]
124      (let [heightmap (filter-image
125                        (load-image imagepath)
126                        (filters/grayscale))]
127        (map-world world tag-property (list property heightmap))))