Compare commits

..

9 Commits

Author SHA1 Message Date
8ee10214c8 async tile fetcher
we use cqueues, which is the async framework that lua-http is built
on. we integrate it into the glib event loop rather hackily by calling
the cqueues event stepper ever 20ms from a glib timeout function

overpass has very low rate limits so we handle a 429 response by
sleeping for a random length of time and retrying. This is, also,
a bit of a hack
2025-06-01 20:50:26 +01:00
195e028e22 clobber map-surface when bounds change 2025-05-30 23:34:17 +01:00
acbe27e6e2 draw map once only and copy it to screen in on_draw
This massively reduces cpu usage, however it doesn't yet work
if we've moved far enough that we'd need to fetch new tiles.
2025-05-30 21:24:28 +01:00
2a86a2bfde use register-widget more, fewer arrow widget repaints 2025-05-29 21:13:19 +01:00
f64bfeb7fd invalidate map only when app-state changes 2025-05-29 21:09:24 +01:00
cb0314d1d6 invalidate the map display each time we repaint it
really we should only need to do this when the app-state changes
2025-05-29 21:03:02 +01:00
6e61113366 replace in-memory cache with a persistent json cache
we just store the raw response from overpass
2025-05-29 18:43:48 +01:00
86682a2ad6 fetch enough tiles to cover the display 2025-05-29 18:13:47 +01:00
995880e5a3 wip 2025-05-29 12:48:21 +01:00
4 changed files with 248 additions and 92 deletions

54
README
View File

@ -19,8 +19,6 @@ write the app in fennel. I want it to
- show where I am on a map
- record trail of where I've been (note: indoor counts too)
can we somehow do non-flakey bluetooth (is it dbus?)
@ -88,11 +86,6 @@ elapsed time: what should it actually show? moving time, I guess
should we rename bearing as course in nmea?
rotating the map is going to be complicated because the widget we're
using doesn't support it (bitmapped map tiles)
perhaps we need a server-side component for route planning
@ -106,9 +99,9 @@ we can't rotate the map using OsmGpsMap widget because the labels will
be sideways or upside down, so we need something with vectors that we
can rotate
a) we can get data from overpass api as json
[done] a) we can get data from overpass api as json
b) we would like to cache the results, which means some kind of
[done badly] b) we would like to cache the results, which means some kind of
chunking or tiling so that the json for position a is the same as the
json for position b.
@ -119,17 +112,44 @@ do it by hand -
- minor roads
- major roads
or so something smart but complicated like "only return ways that
or do something smart but complicated like "only return ways that
cover more than 1/16th the length of the tile"
d) I think we will need some kind of server so that multiple users get
the benefit of the caching. If we're going to do that, should it also
do transformation e.g. from lat/long to x/y co-ordinates? We don't
need this bit yet though
d) render ways according to their type (road/cycleway/path/etc)
3) alternatively we could use mapbox vector tiles, but tbh I'm
struggling to see now that helps. we don't have to transform from
lat/long but instead we have to parse a protobuf, how is that simpler?
e) label the ways
f) async tile fetching
we don't want everything to stop when it's time to fetch a new
row of tiles, what are our options? lua-http is built on cqueues
which is async enough to make my head hurt, but we also need
to make it coexist with the gtk event loop
assumptions:
1) gtk stuff has to happen in the main thread (whatever that is...)
so we can't control it from cqueues because that has its own
threading stuff
2) there will be lots of fds from lua-http, do we really want the
housekeeping of making GLib.io_add_watch for each of them? it looks
like adding a glib source from lgi is not currently practical
https://github.com/lgi-devs/lgi/issues/111
3) if we put http calls inside cq:wrap, that make them background
provided that we call (cq:step 0)
periodically. we could do that in a glib idle function, perhaps.
- The tile fetcher would need to know where to write the data when
eventually it comes back
- need some say to not fetch the same tile 18 times if there's more than
one request for it while a previous request is in progress
----
https://git.syndicate-lang.org/tonyg/squeak-phone/raw/commit/474960ddc665ed445a1f5afb0164fe39057720f9/devices/pine64-pinephone/modem-docs/80545ST10798A_LM940_QMI_Command_Reference_Guide_r3.pdf
----

View File

@ -2,6 +2,7 @@
, pkg-config
, buildPackages
, callPackage
, cairo
, clutter
, fetchFromGitHub
, fetchurl
@ -52,8 +53,8 @@ in stdenv.mkDerivation {
buildInputs = [
lua
gtk3.dev
cairo.dev
gobject-introspection
osm-gps-map
glib-networking
];
nativeBuildInputs = [

View File

@ -1,5 +1,7 @@
; (local { : view } (require :fennel))
(local { : fdopen } (require :posix.stdio))
(local cqueues (require :cqueues))
(local nmea (require :nmea))
(local tiles (require :tiles))
@ -10,6 +12,7 @@
: Gdk
: Gio
: GLib
: cairo
}
(require :lgi))
@ -30,7 +33,9 @@ label.readout {
(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)]
@ -44,8 +49,8 @@ label.readout {
(local window (Gtk.Window {
:title "Map"
:name "toplevel"
:default_width 720
:default_height 800
:default_width map-width
:default_height map-height
:on_destroy Gtk.main_quit
}))
@ -59,38 +64,105 @@ label.readout {
: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 [lat lon zoom]
(let [num-tiles-x (+ 1 (math.ceil (/ map-width tile-size)))
num-tiles-y (+ 1 (math.ceil (/ map-height tile-size)))
(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
min-tile-x (math.floor (- tile-x (/ num-tiles-x 2)))
max-tile-x (+ min-tile-x num-tiles-x 4)
min-tile-y (math.floor (- tile-y (/ num-tiles-y 2)))
max-tile-y (+ min-tile-y num-tiles-y 4)]
{
:min { :x min-tile-x :y min-tile-y }
:max { :x max-tile-x :y max-tile-y }
: num-tiles-x : num-tiles-y
}))
(local cq (cqueues.new))
(fn cairo-the-map [window]
(let [{ : lat : lon : zoom } app-state
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
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))))
(let [map-surface
(window:create_similar_surface
cairo.Content.COLOR
(* tile-size (+ 4 num-tiles-x))
(* tile-size (+ 4 num-tiles-y)))
g (cairo.Context.create map-surface)]
(g:set_source_rgb 1 1 1)
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
(g:fill)
(g:set_source_rgb 0.2 0.2 0.6)
(g:set_line_width 2)
(each [_ line (pairs lines)]
(case line
[[sx sy] & more]
(do
(g:move_to (* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))
(each [_ [x y] (ipairs more)]
(let [x1 (* tile-size (- x bounds.min.x))
y1 (* tile-size (- y bounds.min.y))]
(g:line_to x1 y1))))))
(g:stroke)
map-surface)))
(var map-surface nil)
(fn on-osm-draw [widget g]
(when (not map-surface)
(let [window (widget:get_window)]
(set map-surface (cairo-the-map window))))
(let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
bounds (map-bounds 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))]
(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 []
(let [height 256]
(Gtk.Label {
:width height :height height
:on_draw
(fn [self g]
(print app-state.lat app-state.lon )
(let [lines (tiles.polylines app-state.lat app-state.lon 17)]
(g:set_source_rgb 0.2 0.2 0.4)
(g:set_line_width 3)
(each [_ line (ipairs lines)]
(case line
[[sx sy] & more]
(do
(g:move_to sx sy)
(each [_ [x y] (ipairs more)]
(g:line_to x y)))))
(g:stroke)
true))
})))
(register-widget
:osm
(Gtk.DrawingArea {
:width map-width :height map-height
:on_draw on-osm-draw
})))
(fn readout [name text]
(let [w
(doto (Gtk.Label {:label text : name})
(-> (: :get_style_context)
(: :add_class :readout)))]
(tset state-widgets name w)
w))
(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
@ -106,21 +178,28 @@ label.readout {
(expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
(fn merge [table1 table2]
(collect [k v (pairs table2) &into table1]
k v))
(fn update-app-state [new-vals]
(merge app-state new-vals)
(each [name widget (pairs state-widgets)]
(case name
:speed (widget:set_label
(string.format "%.1f km/h" (* app-state.speed 3.6)))
:osm (widget:set_center app-state.lat app-state.lon)
:time (widget:set_label
(hhmmss (+ utc-offset app-state.time-of-day)))
)))
(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 []
@ -135,25 +214,26 @@ label.readout {
(: :add (readout :speed "0"))))
(fn arrow []
(let [height 40
w (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)
})]
w))
(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"))
@ -194,6 +274,14 @@ label.readout {
(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))

View File

@ -1,6 +1,7 @@
(local req (require :http.request))
(local { : dict_to_query } (require :http.util))
(local json (require :json))
(local cqueues (require :cqueues))
(import-macros { : define-tests : expect : expect= : expect-near } :assert)
(local { : view } (require :fennel))
@ -43,9 +44,10 @@
(expect= (math.floor y) 43221))
(fn overpass [lat lon]
(let [n (+ lat 0.01)
w (- lon 0.01)
(fn overpass [lat lon zoom]
(let [width (/ 360 (^ 2 zoom))
n (+ lat width) ;XXX adjust for latitude
w (- lon width)
s lat
e lon]
(->
@ -57,32 +59,77 @@
]
(table.concat "\n"))))
(fn canvas [elements offset-x offset-y]
(fn canvas [elements]
(let [nodes {}
lines []]
lines {}]
(each [_ e (ipairs elements)]
(case e.type
:node (tset nodes e.id e)
:way
(table.insert
(tset
lines
e.id
(icollect [_ nd (ipairs e.nodes)]
(let [node (. nodes nd)
(tx ty) (latlon->tile node.lat node.lon 17)]
;;(print e.tags.name e.id e.name node.lat node.lon)
[ (* 256 (- tx offset-x)) (* 256 (- ty offset-y)) ])))))
[ tx ty ])))))
lines))
(fn polylines [lat long zoom]
(let [r
(fn file-exists? [name]
(match (io.open name :r)
f (do (f:close) true)
_ false))
(fn unparsed-for-xyz [x y zoom]
(let [(lat lon) (tile->latlon x y zoom)
o (overpass lat lon zoom)
r
(req.new_from_uri
"https://overpass-api.de/api/interpreter")
query { :data (overpass lat long zoom) }]
query { :data o }]
(tset r.headers ":method" "POST")
(r:set_body (dict_to_query query))
(let [(headers stream) (r:go)
(tx ty) (latlon->tile lat long zoom)
data (json.decode (stream:get_body_as_string))]
(canvas data.elements (math.floor tx) (math.floor ty)))))
(let [(headers stream) (r:go)]
(if (= (headers:get ":status") "429")
nil
(stream:get_body_as_string)))))
{ : polylines }
;; if we have json in disk, return it
;; if we have an empty file on disk, that signifies a request in
;; flight, so return a "pending" sentinel
;; if we have no disk file, kick off a request and send "pending" sentinel
;; we'd like to have a way for completed background fetch to signal
;; so that the map can be redrawn
(fn polylines [cq x y zoom]
(let [k (.. x "_" y "_" zoom)
pathname (.. "/tmp/tiles/" k ".json")]
(if (file-exists? pathname)
(let [data (with-open [i (io.open pathname :r)] (i:read "*a"))]
(if (= data "")
[]
(canvas (. (json.decode data) :elements))))
(let [out (io.open pathname :w)]
(cq:wrap (fn []
(print "getting " k)
(var json nil)
(with-open [f out]
(while (not json)
(set json (unparsed-for-xyz x y zoom))
(when (not json)
(print "sleeping " k)
(cqueues.sleep (math.random 2 6))))
(print "got " k)
(f:write json)
true)))
[] ; return no lines for now
))))
{ : polylines : latlon->tile }