com.github.jlangch.venice.mercator.venice Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of venice Show documentation
Show all versions of venice Show documentation
Venice, a sandboxed Lisp implemented in Java.
;;;; __ __ _
;;;; \ \ / /__ _ __ (_) ___ ___
;;;; \ \/ / _ \ '_ \| |/ __/ _ \
;;;; \ / __/ | | | | (_| __/
;;;; \/ \___|_| |_|_|\___\___|
;;;;
;;;;
;;;; Copyright 2017-2024 Venice
;;;;
;;;; Licensed under the Apache License, Version 2.0 (the "License");
;;;; you may not use this file except in compliance with the License.
;;;; You may obtain a copy of the License at
;;;;
;;;; http://www.apache.org/licenses/LICENSE-2.0
;;;;
;;;; Unless required by applicable law or agreed to in writing, software
;;;; distributed under the License is distributed on an "AS IS" BASIS,
;;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;;; See the License for the specific language governing permissions and
;;;; limitations under the License.
;;;; The Mercator projection is a cylindrical map projection. It can be used
;;;; to map IP locations to a world map.
;;;;
;;;; See: https://en.wikipedia.org/wiki/Mercator_projection
;;;;
;;;; World coordinates are given by a latitude and a longitude.
;;;;
;;;; Latitude specifies the north-south position of a point on the Earth's
;;;; surface. Latitude is an angle which ranges from 0° at the equator to +90°
;;;; at north and -90° at south pole.
;;;;
;;;; Longitude specifies the east-west position of a point on the Earth's
;;;; surface. Longitude is an angle which ranges from 0° at the prime meridian
;;;; to +180° eastward and -180° westward.
;;;;
;;;; The formulas are taken from:
;;;; https://en.wikipedia.org/wiki/Web_Mercator_projection
;;;;
;;;; A square Mercator map with a latitude range -85.0° to +85.0°:
;;;; https://upload.wikimedia.org/wikipedia/commons/7/73/Mercator_projection_Square.JPG
;;;;
;;;; Resources:
;;;; https://en.m.wikipedia.org/wiki/World_Geodetic_System#A_new_World_Geodetic_System:_WGS_84
;;;; https://www.glk.uni-mainz.de/files/2018/08/FB08_Masterarbeit_PaulWeber.pdf
;;;;
;;;;
;;;; Example:
;;;;
;;;; (do
;;;; (load-module :mercator)
;;;;
;;;; (-> (mercator/load-mercator-image)
;;;; (mercator/draw-locations (vals mercator/cities))
;;;; (mercator/crop-image 400 600)
;;;; (mercator/save-image :png "./test-map.png")))
;;;;
;;;;
;;;;
;;;; Customizing visualization:
;;;;
;;;; The IP markers can be customized with various properties. The
;;;; properties are passed as an optional map as 3rd value in the location
;;;; list that is passed to 'draw-locations'
;;;;
;;;; Location [ ]
;;;; [ ]
;;;;
;;;; E.g.: [ 47.37174 8.54226 { :label "Zurich"
;;;; :radius 12
;;;; :fill-color [128 128 255 255]
;;;; :border-color [0 0 255 255]
;;;; :label-color [255 255 255 255]
;;;; :font-size-px 20 } ]
;;;;
;;;; Only the :label parameter is mandatory if an option map is passed. All
;;;; other parameters are optional and have default values.
;;;;
;;;; :label the label string
;;;; :radius the marker circle radius in pixel
;;;; :fill-color the marker circle fill color (RGBA vector)
;;;; :border-color the marker circle border color (RGBA vector)
;;;; :label-color the label color (RGBA vector)
;;;; :font-size-px the label font size in pixel
(ns mercator)
(import :javax.imageio.ImageIO)
(import :java.awt.Color)
(import :java.awt.Font)
(import :java.awt.RenderingHints)
(import :java.net.URL)
;; Some cities (https://www.laengengrad-breitengrad.de/)
(def cities
; id latitude longitude marker
{ :zurich [ 47.37174 8.54226 { :label "Zurich"
:radius 10
:fill-color [128 128 255 255]
:border-color [0 0 255 255]
:label-color [255 255 255 255]
:font-size-px 14 } ]
:new-york [ 40.712778 -74.005833 { :label "New York" } ]
:tokyo [ 35.6894875 139.6917064 { :label "Tokyo" } ]
:perth [-31.953513 115.857047 { :label "Perth" } ]
:honolulu [ 21.3069444 -157.8583333 { :label "Honolulu" } ]
:montevideo [-34.9011127 -56.1645314 { :label "Montevideo" } ]
:greenwich [ 51.482577 0.0 { :label "Greenwich" } ]
:reykjavik [ 64.13548 -21.89541 { :label "Reykjavik" } ]
:kapstadt [-33.924869 18.424055 { :label "Kapstadt" } ]
:zero [ 0.0 0.0 ] })
(def mercator-map "https://upload.wikimedia.org/wikipedia/commons/7/73/Mercator_projection_Square.JPG")
;; major and the minor radius of Earth measured in meters
(def earth-radius-major 6378137.0)
(def earth-radius-minor 6356752.3142)
(def pi (. :java.lang.Math :PI))
(def latitude-range [-85.0 85.0])
;; spherical mercator projection bounding box based on the
;; latitude range [-85.0 85.0]
(def spherical-box
{ :top 19971868.88
:right 20037508.34
:bottom -19971868.88
:left -20037508.34 })
;; elliptical mercator projection bounding box based on the
;; latitude range [-85.0 85.0]
(def elliptical-box
{ :top 19929239.11
:right 20037508.34
:bottom -19929239.11
:left -20037508.34 })
(def bitmap-format
{ :png "PNG"
:gif "GIF"
:bmp "BMP"
:jpg "JPG" })
(def font-styles
{ :plain (. :Font :PLAIN)
:italic (. :Font :ITALIC)
:bold (. :Font :BOLD) })
; default styles
(def default-styles { :marker { :fill-color [255 128 128 255]
:border-color [255 0 0 255]
:label-color [255 255 255 255]
:radius 10
:font-size-px 14 }
:font { :style :plain }})
(defn color
([r g b] (color r g b 255))
([r g b a] (. :Color :new (int r) (int g) (int b) (int a)))
([[r g b a]] (color r g b a)))
(def font
(memoize (fn [size style]
(. :Font :new "SansSerif"
(get font-styles style (:plain font-styles))
size))))
(defn- limit [val [lower upper]]
(min upper (max lower val)))
(defn- text-metrics [g2d text text-font]
(let [ctx (. g2d :getFontRenderContext)
line-metrics (. text-font :getLineMetrics text ctx)
width (. (. text-font :getStringBounds text ctx) :getWidth)
ascent (. line-metrics :getAscent)
descent (. line-metrics :getDescent)]
{ :width (long width)
:ascent (long ascent)
:descent (long descent) }))
(defn spherical-x-axis [longitude]
(* (math/to-radians longitude) earth-radius-major))
(defn spherical-y-axis [latitude]
(-<> (math/to-radians (limit latitude latitude-range))
(/ <> 2.0)
(+ <> (/ pi 4.0))
(math/tan <>)
(log <>)
(* <> earth-radius-major)))
(defn elliptical-x-axis [longitude]
(* (math/to-radians longitude) earth-radius-major))
(defn elliptical-y-axis [latitude]
(let [latitude-radians
(math/to-radians (limit latitude latitude-range))
earth-dimensional-rate-normalized
(- 1.0 (square (/ earth-radius-minor earth-radius-major)))
latitude-on-earth-proj
(* (sqrt earth-dimensional-rate-normalized)
(math/sin latitude-radians))
latitude-on-earth-proj
(pow (/ (- 1.0 latitude-on-earth-proj)
(+ 1.0 latitude-on-earth-proj))
(* 0.5 (sqrt earth-dimensional-rate-normalized)))
latitude-on-earth-proj-normalized
(/ (math/tan (* 0.5 (- (* pi 0.5) latitude-radians)))
latitude-on-earth-proj)]
(* -1.0 earth-radius-major (log latitude-on-earth-proj-normalized))))
(defn x-axis-normalize [x box]
(/ (- x (:left box))
(- (:right box) (:left box))))
(defn y-axis-normalize [y box]
(/ (- y (:bottom box))
(- (:top box) (:bottom box))))
(defn spherical-mapper [map-width map-height]
(fn [longitude latitude]
{ :longitude longitude
:latitude latitude
:x (long (* map-width (x-axis-normalize (spherical-x-axis longitude)
spherical-box)))
:y (long (* map-height (y-axis-normalize (spherical-y-axis latitude)
spherical-box))) }))
(defn elliptical-mapper [map-width map-height]
(fn [longitude latitude]
{ :longitude longitude
:latitude latitude
:x (long (* map-width (x-axis-normalize (elliptical-x-axis longitude)
elliptical-box)))
:y (long (* map-height (y-axis-normalize (elliptical-y-axis latitude)
elliptical-box))) }))
(defn load-mercator-image []
(. :ImageIO :read (. :URL :new mercator-map)))
(defn load-image [file]
(. :ImageIO :read (io/file file)))
(defn save-image [image format file]
(. :ImageIO :write image (get bitmap-format format) (io/file file)))
(defn image-dimensions [image]
[ (. image :getWidth nil) (. image :getHeight nil)])
(defn crop-image [image crop-top crop-bottom]
(let [[width height] (image-dimensions image)]
(. image :getSubimage 0 crop-top width (- height crop-top crop-bottom))))
(defn draw-circle [g2d x y radius fill-color border-color]
(. g2d :setRenderingHints { (. :RenderingHints :KEY_ANTIALIASING)
(. :RenderingHints :VALUE_ANTIALIAS_ON) } )
(. g2d :setColor fill-color)
(. g2d :fillOval (- x radius) (- y radius) (* 2 radius) (* 2 radius))
(. g2d :setColor border-color)
(. g2d :drawOval (- x radius) (- y radius) (* 2 radius) (* 2 radius)))
(defn draw-text [g2d x y color label font]
(. g2d :setFont font)
(. g2d :setColor color)
(. g2d :drawString label x y))
(defn draw-marker [g2d img-width img-height pos styles opts circle? label?]
(let [x (:x pos)
y (- img-height (:y pos))
label (:label opts)
radius (:radius opts (-> styles :marker :radius))
diameter (* 2 radius)
font-size (:font-size-px opts (-> styles :marker :font-size-px))]
(when circle?
(draw-circle g2d x y
radius
(color (:fill-color opts (-> styles :marker :fill-color)))
(color (:border-color opts (-> styles :marker :border-color)))))
(when (and label? (some? label))
(let [label-font (font font-size (:font styles))
metrics (text-metrics g2d label label-font)
x-off (long (* 1.5 radius))
y-off (long (/ (- (:ascent metrics) (:descent metrics)) 2))]
(draw-text g2d (+ x x-off) (+ y y-off)
(color (:label-color opts (-> styles :marker :label-color)))
label
label-font)))))
(defn draw-locations
([image locations]
(draw-locations image locations default-styles))
([image locations styles]
(let [[img-width img-height] (image-dimensions image)
g2d (. image :createGraphics)
geo-mapper (spherical-mapper img-width img-height)
styles (merge default-styles styles)]
(. g2d :setFont (font (-> styles :marker :font-size-px) (:font styles)))
(let [data (map #(let [[lat lon styles] %]
(vector (geo-mapper lon lat) styles))
locations)]
;; layer 1: draw all circles
(docoll #(let [[pos opts] %]
(draw-marker g2d img-width img-height
pos styles opts
true false))
data)
;; layer 2: draw all labels
(docoll #(let [[pos opts] %]
(draw-marker g2d img-width img-height
pos styles opts
false true))
data)))
image))
(defn test []
(-> (load-mercator-image)
(draw-locations (vals cities))
(crop-image 400 600)
(save-image :png "test-cities.png")))