#lang racket/base

; Daily island pages
(require
  racket/date
  "templates.rkt"
  "../webcontainer/weblets.rkt"
  "../webcontainer/weblet-parameter.rkt")

(provide
  pages:daily-island
  pages:daily-island-archives
  pages:daily-island-about)

; Island directory
(define island-dir "/islands")

; About page
(define pages:daily-island-about
  (pages:template
    #:title "About the Daily Island"
    #:author "Feufochmar"
    #:date "2020-11-10"
    #:content
      '(article
        (p
          "The Daily Island is an island map generated every day. "
          "The layers of the map can be hidden and displayed "
          "using the controls left of the map. ")
        (p
          "A previous version generated islands maps as interactive SVG images, "
          "using an hexagonal grid. " (br)
          "The current version uses a rectangular grid and the layers are generated "
          "as PNG images. ")
        (p
          "A Mastodon bot, " (a ((href "https://botsin.space/@DailyIsland")) "@DailyIsland@botsin.space") ", "
          "publishes the generated map twice a day on the Fediverse.")
        (section
          (h3 "Licence of the generated maps")
          (p "I don't care at all about what you could do with the generated islands, "
             "so those are released under the "
             (a ((href "http://creativecommons.org/publicdomain/zero/1.0/"))
                "Creative Commons CC0 1.0 Universal (CC0 1.0) Public Domain Dedication") ".")))))

; Archive page
(define pages:daily-island-archives
  (pages:template
    #:title "Archives of the Daily Island"
    #:author "feuforeve.fr"
    #:content
      (lambda (param)
        (define islands (reverse (map path->string (directory-list (string-append "static" island-dir)))))
        (if (null? islands)
            '(article "No archives.")
            `(article
               ,@(map
                   (lambda (x)
                    `(div (a ((href ,(string-append "/DailyIsland?date=" x))) ,x)))
                   islands))))
      ))

; Daily Island page
(define pages:daily-island
  (pages:template
    #:title "Daily Island"
    #:author "feuforeve.fr"
    #:stylesheets '("/css/daily-island.css")
    #:scripts '("/scripts/daily-island.js")
    #:content
    (lambda (param)
      (define (today-string)
        (parameterize ((date-display-format 'iso-8601))
          (date->string (current-date))))
      (define date (weblet-parameter-ref param 'date #f))
      (define (island-path day) (string-append island-dir "/" day))
      (define today (or (and date (directory-exists? (string-append "static" (island-path date))) date)
                        (today-string)))
      (define today-path (island-path today))
      ; Helpers
      (define (zone-description name color)
        `(div (span ((class "daily-island-zone")(style ,(string-append "background:rgb(" color ");"))) "") " " ,name))
      (define (path-description name color)
        `(div (svg ((width "30")(height "15")(version "1.1")(xmlns "http://www.w3.org/2000/svg")(xmlns:xlink "http://www.w3.org/1999/xlink"))
                (rect ((x "0")(y "0")(width "30")(height "15")(style "fill:rgb(255,255,255);")))
                (path ((d "M 0,10 L 10,5 L 20,10 L 30,5")
                       (style ,(string-append "fill:none;stroke:rgb(" color ");stroke-width:2;")))))
            " " ,name))
      ; Content
      `(article
        (section ((class "controls"))
          (h3 "Layer controls")
          (hr)
          (h4 "Background")
          (input ((type "button")(value "Altitude")(onclick "updateBackground('altitude');")))(br)
          (input ((type "button")(value "Biomes")(onclick "updateBackground('biomes');")))(br)
          (input ((type "button")(value "Rainfall")(onclick "updateBackground('rainfall');")))(br)
          (input ((type "button")(value "Temperatures")(onclick "updateBackground('temperature');")))(br)
          (input ((type "button")(value "Blank")(onclick "updateBackground('blank');")))(br)
          (hr)
          (h4 "Foreground")
          (input ((type "button")(value "Rivers")(onclick "toggleLayer('rivers');")))(br)
          (input ((type "button")(value "Roads")(onclick "toggleLayer('roads');")))(br)
          (input ((type "button")(value "Administrative limits")(onclick "toggleLayer('territories');")))(br)
          (input ((type "button")(value "Cities")(onclick "toggleLayer('cities');")))(br)
          )
        (section ((class "map"))
          (svg ((width "800")
                (height "800")
                (version "1.1")
                (xmlns "http://www.w3.org/2000/svg")
                (xmlns:xlink "http://www.w3.org/1999/xlink"))
            (rect ((width "800")(height "800")(style "fill:rgb(20, 75, 184);")))
            (image ((id "blank")(xlink:href ,(string-append today-path "/blank.png"))(width "800")(height "800")))
            (image ((id "altitude")(xlink:href ,(string-append today-path "/altitude.png"))(width "800")(height "800")))
            (image ((id "biomes")(xlink:href ,(string-append today-path "/biomes.png"))(width "800")(height "800")(style "display:none;")))
            (image ((id "rainfall")(xlink:href ,(string-append today-path "/rainfall.png"))(width "800")(height "800")(style "display:none;")))
            (image ((id "temperature")(xlink:href ,(string-append today-path "/temperature.png"))(width "800")(height "800")(style "display:none;")))
            (image ((id "territories")(xlink:href ,(string-append today-path "/territories.png"))(width "800")(height "800")(style "display:none;")))
            (image ((id "rivers")(xlink:href ,(string-append today-path "/rivers.png"))(width "800")(height "800")))
            (image ((id "roads")(xlink:href ,(string-append today-path "/roads.png"))(width "800")(height "800")(style "display:none;")))
            (image ((id "cities")(xlink:href ,(string-append today-path "/cities.png"))(width "800")(height "800")))
            ))
        (section ((class "captions"))
          (h4 "Keys")
          (hr)
          ; Sea & lake
          ,(zone-description "Sea" "20,75,184")
          ,(zone-description "Lake" "13,128,242")
          ; Rivers
          ,(path-description "Rivers" "13,128,242")
          ; Roads
          ,(path-description "Road" "255,0,0")
          ; Territories
          ,(path-description "Region limits" "0,0,0")
          ,(path-description "Canton limits" "95,95,95")
          ,(path-description "Municipality limits" "190,190,190")
          ; Cities
          (span ((class "daily-island-point")(id "capital")) "") " Island capital" (br)
          (span ((class "daily-island-point")(id "city")) "") " Region capital" (br)
          (span ((class "daily-island-point")(id "town")) "") " Canton capital" (br)
          (span ((class "daily-island-point")(id "village")) "") " Municipality" (br)
          ; Altitude
          (section ((id "altitude-keys"))
            ,@(map
                (lambda (x) (zone-description (car x) (cadr x)))
                '(("Ice shelf" "163,245,245")
                  ("> 3000 m" "127,127,127")
                  ("2600 - 3000 m" "100,100,100")
                  ("2300 - 2600 m" "96,73,57")
                  ("2000 - 2300 m" "77,47,26")
                  ("1750 - 2000 m" "96,58,32")
                  ("1500 - 1750 m" "134,82,45")
                  ("1250 - 1500 m" "172,105,57")
                  ("1000 - 1250 m" "172,105,57")
                  ("800 - 1000 m" "215,153,66")
                  ("650 - 800 m" "235,180,71")
                  ("500 - 650 m" "245,236,137")
                  ("400 - 500 m" "201,237,94")
                  ("300 - 400 m" "153,230,77")
                  ("200 - 300 m" "115,201,29")
                  ("150 - 200 m" "88,184,20")
                  ("100 - 150 m" "62,170,9")
                  ("50 - 100 m" "31,145,8")
                  ("0 - 50 m" "21,128,0")
                  ("-50 - 0 m (land)" "15,113,0")
                  ("-100 - -50 m (land)" "9,98,0")
                  ("< -100 m (land)" "6,83,0")
                  ("-50 - 0 m (sea)" "20,75,184")
                  ("-150 - -50 m (sea)" "10,37,92")
                  ("< -150 m (sea)" "5,18,46"))))
          ; Biomes
          (section ((id "biomes-keys")(style "display: none;"))
            ,@(map
                (lambda (x) (zone-description (car x) (cadr x)))
                '(("Tropical rain forest" "10,194,71")
                  ("Tropical seasonal forest" "153,214,92")
                  ("Savanna" "153,245,61")
                  ("Subtropical desert" "240,179,117")
                  ("Temperate rain forest" "61,245,122")
                  ("Temperate deciduous forest" "68,217,38")
                  ("Boreal forest" "10,194,133")
                  ("Shrubland" "126,173,31")
                  ("Grassland" "207,235,71")
                  ("Ice shelf" "163,245,245")
                  ("Tundra" "26,230,230"))))
          ; Rainfall
          (section ((id "rainfall-keys")(style "display: none;")))
          ; Temperatures
          (section ((id "temperature-keys")(style "display: none;"))
            ,@(map
                (lambda (x) (zone-description (car x) (cadr x)))
                '(("> 35°C" "255,70,70")
                  ("30°C - 35°C" "255,0,0")
                  ("25°C - 30°C" "255,130,0")
                  ("20°C - 25°C" "255,175,0")
                  ("15°C - 20°C" "255,230,0")
                  ("10°C - 15°C" "230,255,0")
                  ("5°C - 10°C" "130,255,0")
                  ("0°C - 5°C" "0,255,255")
                  ("-5°C - 0°C" "0,200,255")
                  ("-10°C - -5°C" "0,115,255")
                  ("-15°C - -10°C" "0,0,255")
                  ("< -15°C" "160,0,255"))))
          ; Blank
          (section ((id "blank-keys")(style "display: none;")))
          )
        ))))
