dan/biscuit
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/noetbook' into tninkpad

Browse Source
This commit is contained in:
Daniel Barlow 2025-06-02 12:07:48 +01:00
commit a0898ff056
4 changed files with 288 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
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?)
@ -81,6 +79,9 @@ elapsed time: what should it actually show? moving time, I guess
should we rename bearing as course in nmea?
perhaps we need a server-side component for route planning
7) think about how to use nfc tags or something for profiles so that
it can recognise when it's attached to bicycle or motorbike
@ -91,9 +92,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.
@ -104,38 +105,45 @@ 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)
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
----
... sod, forgot to push latest changes from noetbook
we need to extend to multiple tiles'-worth of map
* get tile for curent lat/long and request overpass data for enough
surrounding tiles to fill the screen
* I think a way is served with all its nodes whether or not they're in
the bbox, so we can just store the ids of ways we've seen and skip
them if the come up again
* render all the polylines into the widget (some day also the labels etc)
* to get it centred on the cyclist, take the tile fractional part *
256, and translate the canvas up and left by that amount
* add a cache of [x,y,z] -> polylines so that we don't keep hitting overpass

3
pkgs/maps/default.nix
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 = [

223
pkgs/maps/main.fnl
View File

@ -1,15 +1,18 @@
; (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
: OsmGpsMap
: 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,36 +49,120 @@ 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
}))
(local state-widgets { })
(fn osm-widget []
(let [w
(doto (OsmGpsMap.Map {})
(tset :map-source OsmGpsMap.MapSource_t.OPENSTREETMAP)
(: :set_center_and_zoom 52.595 -0.1 17)
(: :layer_add (OsmGpsMap.MapOsd {
:show_copyright true
; :show_coordinates true
:show_scale true
}))
)]
(tset state-widgets :osm w)
w))
(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 [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 []
(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
@ -89,33 +178,28 @@ label.readout {
(expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
(local
app-state {
:time-of-day 0
:elapsed-time 0
:speed 14
:lat 49
:lon 0
:course 22
}
)
(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 []
@ -130,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"))
@ -189,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))

120
pkgs/maps/tiles.fnl
View File

@ -1,39 +1,13 @@
(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))
(local f% string.format)
(local
query
(->
[
"[bbox:30.618338,-96.323712,30.591028,-96.330826]"
"[out:json]"
"[timeout:90];"
"("
"way ("
"30.626917110746,"
"-96.348809105664,"
"30.634468750236,"
"-96.339893442898"
");"
");"
"out ;"
]
(table.concat "\n")))
(let [r
(req.new_from_uri
"https://overpass-api.de/api/interpreter")]
(tset r.headers ":method" "POST")
(r:set_body (dict_to_query { :data query }))
(let [(headers stream) (r:go)]
(print (view headers))
(print (view (json.decode (stream:get_body_as_string))))))
(fn sinh [x] (/ (- 1 (math.exp (* -2 x))) (* 2 (math.exp (- x)))))
(expect (< (math.abs (- (sinh 2) 3.626860407847)) 0.001))
@ -69,3 +43,93 @@
(expect= (math.floor x) 65343)
(expect= (math.floor y) 43221))
(fn overpass [lat lon zoom]
(let [width (/ 360 (^ 2 zoom))
n (+ lat width) ;XXX adjust for latitude
w (- lon width)
s lat
e lon]
(->
[
"[out:json];"
(f% "way(%f,%f,%f,%f)['highway'];" s w n e)
"(._;>;);"
"out;"
]
(table.concat "\n"))))
(fn canvas [elements]
(let [nodes {}
lines {}]
(each [_ e (ipairs elements)]
(case e.type
:node (tset nodes e.id e)
:way
(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)
[ tx ty ])))))
lines))
(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 o }]
(tset r.headers ":method" "POST")
(r:set_body (dict_to_query query))
(let [(headers stream) (r:go)]
(if (= (headers:get ":status") "429")
nil
(stream:get_body_as_string)))))
;; 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 }