; (local { : view } (require :fennel))
(local { : fdopen } (require :posix.stdio))
(local cqueues (require :cqueues))

(local nmea (require :nmea))
(local tiles (require :tiles))

(import-macros { : define-tests : expect : expect= } :assert)

(local {
        : Gtk
        : Gdk
        : Gio
        : GLib
        : cairo
        }
       (require :lgi))

(local CSS "
label.readout {
    font: 48px \"Noto Sans\";
    margin: 10px;
    padding: 5px;
    background-color: rgba(0, 0, 0, 0.2);
}
")

(local utc-offset
       (let [now (os.time)
             localt (os.date "*t" now)
             utct (os.date "!*t" now)]
         (tset localt :isdst false)
         (os.difftime (os.time localt) (os.time utct))))


(local map-width 720)
(local map-height 800)
(local tile-size 256)

(fn styles []
  (let [style_provider (Gtk.CssProvider)]
    (Gtk.StyleContext.add_provider_for_screen
     (Gdk.Screen.get_default)
     style_provider
     Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION
     )
    (style_provider:load_from_data CSS)))

(local window (Gtk.Window {
                           :title "Map"
                           :name "toplevel"
                           :default_width map-width
                           :default_height map-height

                           :on_destroy Gtk.main_quit
                           }))

(local state-widgets { })

(local
 app-state {
            :time-of-day 0
            :elapsed-time 0
            :speed 14
            :lat 49
            :lon 0
            :zoom 17
            :course 22
            }
 )

(fn merge [table1 table2]
  (collect [k v (pairs table2) &into table1]
    k v))



(fn map-bounds-tile [tile-x tile-y]
  (let [min-tile-x (math.floor (- tile-x (/ map-width tile-size 2)))
        max-tile-x (math.floor (+ tile-x (/ map-width tile-size 2)))
        min-tile-y (math.floor (- tile-y (/ map-height tile-size 2)))
        max-tile-y (math.floor (+ tile-y (/ map-height tile-size 2)))
        num-tiles-x (+ 1 (- max-tile-x min-tile-x))
        num-tiles-y (+ 1 (- max-tile-y min-tile-y))]

    {
     :min { :x min-tile-x :y min-tile-y }
     :max { :x max-tile-x :y max-tile-y }
     : num-tiles-x
     : num-tiles-y
     :pixels {
              :x (* tile-size num-tiles-x)
              :y (* tile-size num-tiles-y)
              }
     }))

;; 720 width is 2.8 * 256 pixel tiles
;; 800 height is 3.125 tiles

(let [bounds (map-bounds-tile 65539.5 45014.5)]
  ;; tile 65539, 45014 is centred on screen. left of it there is space
  ;; for one tile and right of it likewise.
  ;; vertical space for other tiles is (/ (- map-height tile-size) 256)
  ;;  => 2.125 tiles, shared equally to top and bottom therefore
  ;; 1.0625 tiles above and 1.0625 tiles below

  (expect= bounds.min {:x 65538 :y 45012})
  (expect= bounds.max {:x 65540 :y 45016}))

(let [bounds (map-bounds-tile 65539.0 45014.0)]
  ;; top left corner of tile 65539, 45014 is centred on screen.
  ;; to its left there are 360 pixels, so we need two tiles
  ;; to its right there are 104 pixels, so one tile
  ;; above there are 400 pixels: two tiles
  ;; below are 144 pixels: one tile

  (expect= bounds.min {:x 65537 :y 45012})
  (expect= bounds.max {:x 65540 :y 45015})
  )

(fn map-bounds [lat lon zoom]
  (let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)]
    (map-bounds-tile tile-x tile-y)))



(local cq (cqueues.new))

(fn road-width-for [line offset]
  (+ (or offset 0)
     (case (?. line :tags :highway)
       :motorway 18
       :trunk 17
       :primary 16
       :secondary 14
       :cycleway 4
       :footway 4
       other (do (print "highway " other) 12))))

(fn cairo-road-path [g [[sx sy] & points] bounds width]
  (g:save)
  (g:set_line_width width)
  (g:move_to (* tile-size (- sx bounds.min.x))
             (* tile-size (- sy bounds.min.y)))
  (each [_ [x y] (ipairs points)]
    (let [x1 (* tile-size (- x bounds.min.x))
          y1 (* tile-size (- y bounds.min.y))]
      (g:line_to x1 y1)))
  (g:stroke)
  (g:restore))


(fn cairo-roads [g lines bounds]
  (let [road-width 14]
    (g:set_source_rgb 0 0 0)
    (each [_ line (pairs lines)]
      (cairo-road-path g line.points bounds (road-width-for line)))
    (g:set_source_rgb 1 1 1)
    (each [_ line (pairs lines)]
      (cairo-road-path g line.points bounds (road-width-for line -2)))))

(fn label-coords [{ : points } bounds]
  (var biggest 0)
  (var biggest-n 0)

  (for [i 2 (# points)]
    (let [[x1 y1] (. points (- i 1))
          [x2 y2]  (. points i)
          dist
          (+ (* (- x2 x1)  (- x2 x1))
             (* (- y2 y1)  (- y2 y1)))]
      (when (>= dist biggest)
        (set biggest dist)
        (set biggest-n (- i 1)))))
  (let [[x y] (. points biggest-n)
        [nx ny] (. points (+ 1 biggest-n))
        angle (math.atan (- ny y) (- nx x))]
    (if (> nx x)
        (values
         (* tile-size (- x bounds.min.x))
         (* tile-size (- y bounds.min.y))
         angle)
        (values ; if way runs r->l, prefer label to read l->r
         (* tile-size (- nx bounds.min.x))
         (* tile-size (- ny bounds.min.y))
         (+ math.pi angle)))))

(var map-surface nil)

(fn draw-onto-map-surface [surface bounds zoom]
  (let [{ : num-tiles-x : num-tiles-y } bounds
        road-width 14
        lines []]

    (for [x bounds.min.x bounds.max.x]
      (for [y bounds.min.y bounds.max.y]
        (merge lines (tiles.polylines cq x y zoom
                                      #(set map-surface nil)
                                      ))))

    (let [seen-road-names {}
          g (cairo.Context.create surface)]

      (g:set_source_rgb 0.7 0.8 0.8)
      (g:rectangle 0 0 bounds.pixels.x bounds.pixels.y)
      (g:fill)

      (cairo-roads g lines bounds)

      (g:set_source_rgb 0.2 0.2 0.2)
      (g:set_font_size (+ road-width 1))
      (each [_ line (pairs lines)]
        (case line.name
          n (let [(x y angle) (label-coords line bounds)
                  ext  (g:text_extents n)
                  w ext.width
                  h ext.height]
              (when (and x y (not (. seen-road-names n)))
                (tset seen-road-names n true)
                (g:save)
                (g:set_line_width h)
                (g:set_source_rgba 1 0.95 1 0.7)
                (g:move_to (- x 1) (- y 1))
                (g:rotate angle)
                (g:rel_line_to (+ w 1) 0)
                (g:stroke)
                (g:restore)

                (g:save)
                (g:move_to x y)
                (g:rotate angle)
                (g:rel_move_to 0 3)
                (g:text_path n)
                (g:fill)
                (g:restore)))))

      surface)))


(fn on-osm-draw [widget g]
  (let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
        bounds (map-bounds-tile tile-x tile-y)
        offset-x (- (* tile-size (- tile-x bounds.min.x)) (/ map-width 2))
        offset-y (- (* tile-size (- tile-y bounds.min.y)) (/ map-height 2))]

    (when (not map-surface)
      (let [window (widget:get_window)]
        (set map-surface
             (doto
                 (window:create_similar_surface
                  cairo.Content.COLOR
                  bounds.pixels.x
                  bounds.pixels.y)
               (draw-onto-map-surface bounds app-state.zoom)))))

    (g:set_source_surface map-surface (- offset-x) (- offset-y))
    (g:set_operator cairo.Operator.SOURCE)
    (g:rectangle 0 0 map-width map-height)
    (g:fill)))



(fn register-widget [name widget]
  (tset state-widgets name widget)
  widget)

(fn osm-widget []
  (register-widget
   :osm
   (Gtk.DrawingArea {
                     :width map-width :height map-height
                     :on_draw on-osm-draw
                     })))

(fn readout [name text]
  (register-widget
   name
   (doto (Gtk.Label {:label text : name})
     (-> (: :get_style_context)
         (: :add_class :readout)))))

(local knot-in-m-s
       (/ 1852 ; metres in nautical mile
          3600 ; seconds in an hour
          ))

(fn hhmmss [seconds-since-midnight]
  (let [s (% seconds-since-midnight 60)
        m (% (// (- seconds-since-midnight s) 60) 60)
        h (// (- seconds-since-midnight (* m 60) s) 3600)]
    (string.format "%d:%02d:%02d" h m s)))

(expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")





(fn update-app-state [new-vals]
  (let [old-bounds
        (map-bounds app-state.lat app-state.lon app-state.zoom)]
    (merge app-state new-vals)
    (let [bounds
          (map-bounds app-state.lat app-state.lon app-state.zoom)]
      (when (or
             (not (= old-bounds.min.x bounds.min.x))
             (not (= old-bounds.min.y bounds.min.y)))
        (set map-surface nil)))
    (each [name widget (pairs state-widgets)]
      (case name
        :speed (widget:set_label
                (string.format "%.1f km/h" (* app-state.speed 3.6)))
        :osm (: (widget:get_window) :invalidate_rect nil)
        :arrow (: (widget:get_window) :invalidate_rect nil)
        :time (widget:set_label
               (hhmmss (+ utc-offset app-state.time-of-day)))
        ))))


(fn readouts []
  (doto (Gtk.Box
         {
          :orientation Gtk.Orientation.VERTICAL
          :halign Gtk.Align.END
          })
    (-> (: :get_style_context) (: :add_class :readouts))
    (: :add (readout :time ""))
    (: :add (readout :elapsed-time ""))
    (: :add (readout :speed "0"))))

(fn arrow []
  (let [height 40]
    (register-widget
     :arrow
     (Gtk.Label {
                 :halign Gtk.Align.CENTER
                 :valign Gtk.Align.CENTER
                 :width height :height height
                 :on_draw
                 (fn [self g]
                   (g:set_source_rgb 0.4 0.0 0.1)
                   (g:translate (// height 2) (// height 2))
                   (g:rotate (/ (* -2  app-state.course math.pi) 360) )
                   (g:translate (// height -2) (// height -2))
                   (g:set_line_width 4)
                   (g:move_to 10 height)
                   (g:line_to (// height 2) 0)
                   (g:line_to (- height 10) height)
                   (g:fill)
                   true)
                 }))))


(local socket-path (or (. arg 1) "/var/run/gnss-share.sock"))

(local gnss-socket
       (let [addr (Gio.UnixSocketAddress {
                                          :path socket-path
                                          })]
         (: (Gio.SocketClient) :connect addr nil)))

(fn read-gnss [socket]
  (each [l #(socket:read "l")]
    ; (print "gnss" l)
    (if (not (= l ""))
        (let [message (nmea.parse l)]
          (case message
            { : lat : lon : utc}
            (update-app-state
             {
              : lat : lon
              :time-of-day
              (let [(h m s) (string.match utc "(..)(..)(..)")]
                (+ s (* m 60) (* h 60 60)))
              }
             )
            { : speed-knots }
            (update-app-state { :speed (* speed-knots knot-in-m-s) }))
          (if message.bearing-true
              (update-app-state { :course message.bearing-true }))
          )))
  true)

(let [sock (gnss-socket:get_socket)
      fd (sock:get_fd)
      events [ GLib.IOCondition.IN GLib.IOCondition.HUP]
      channel (GLib.IOChannel.unix_new fd)
      handle (fdopen fd :r)]
  (GLib.io_add_watch channel 0 events #(read-gnss handle)))


(GLib.timeout_add
 GLib.PRIORITY_DEFAULT
 20 ; ms
 (fn []
   (cq:step 0)
   true)
 nil nil)

(window:add
 (doto (Gtk.Overlay {})
   (: :add (osm-widget))
   (: :add_overlay (readouts))
   (: :add_overlay (arrow))
   ))

(window:show_all)
(styles)
(Gtk:main)