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

Compare commits

base: dan:53e377cabdc3856c9b5fbf851b4b0e64bc8b5dde
Branches Tags
dan:main
dan:wip
dan:tninkpad2
dan:tninkpad
dan:noetbook
..
compare: dan:e728052bb6cb97f80670d5662294ea0b5788424d
Branches Tags
dan:main
dan:wip
dan:tninkpad2
dan:tninkpad
dan:noetbook

No commits in common. "53e377cabdc3856c9b5fbf851b4b0e64bc8b5dde" and "e728052bb6cb97f80670d5662294ea0b5788424d" have entirely different histories.
53e377cabd ... e728052bb6

4 changed files with 74 additions and 170 deletions
Show Stats Expand all files Collapse all files

5
pkgs/maps/default.nix
View File

@ -84,9 +84,4 @@ in stdenv.mkDerivation {
icon = "nix-snowflake"; # "${placeholder "out"}/share/icons/${pname}.svg";
})
];
passthru = {
inherit lua luaPackages;
};
}

182
pkgs/maps/main.fnl
View File

@ -33,8 +33,8 @@ label.readout {
(os.difftime (os.time localt) (os.time utct))))
(local viewport-width 720)
(local viewport-height 800)
(local map-width 720)
(local map-height 800)
(local tile-size 256)
(fn styles []
@ -49,8 +49,8 @@ label.readout {
(local window (Gtk.Window {
:title "Map"
:name "toplevel"
:default_width viewport-width
:default_height viewport-height
:default_width map-width
:default_height map-height
:on_destroy Gtk.main_quit
}))
@ -65,8 +65,7 @@ label.readout {
:lat 49
:lon 0
:zoom 17
:course 0
:smooth-course 0
:course 22
}
)
@ -76,95 +75,36 @@ label.readout {
(fn map-bounds-tile [tile-x tile-y]
;; we fetch enough tiles around the current location that the screen
;; can be freely rotated without needing to fetch more.
;; when facing north, we have e.g.
;; 720 width is 2.8 * 256 pixel tiles
;; 800 height is 3.125 tiles
;;
;; however:
;; - when the map is rotated 90 degrees we instead have
;; 3.125 tiles horizontally and 2.8 vertically
;; - at e.g a 45 degree angle ... something else?
;;
;; the furthest points visible from the centre of the screen are the
;; corners. So, we draw a circle about the centre which goes
;; through those points. To ensure we have enough tiles to fill the
;; screen at any angle, we fetch every tile that's (partly
;; or entirely) inside that circle
(let [radius (/ (math.sqrt (+ (^ viewport-width 2) (^ viewport-height 2)))
tile-size 2)
min-tile-x (math.floor (- tile-x radius))
max-tile-x (math.floor (+ tile-x radius))
min-tile-y (math.floor (- tile-y radius))
max-tile-y (math.floor (+ tile-y radius))
num-tiles-x (+ 1 (- max-tile-x min-tile-x))
num-tiles-y (+ 1 (- max-tile-y min-tile-y))]
(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
:pixels {
:x (* tile-size num-tiles-x)
:y (* tile-size num-tiles-y)
}
: num-tiles-x : num-tiles-y
}))
;; diagonal radius is 538 pixels, 2.1 tiles
(let [bounds (map-bounds-tile 65539.5 45014.5)]
(expect= bounds.min {:x 65537 :y 45012})
(expect= bounds.max {:x 65541 :y 45016}))
(let [bounds (map-bounds-tile 65539.0 45014.0)]
(expect= bounds.min {:x 65536 :y 45011})
(expect= bounds.max {:x 65541 :y 45016})
)
(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]
(fn cairo-roads-path [g lines bounds]
(each [_ line (pairs lines)]
(case line.points
[[sx sy] & more]
(do
(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)]
(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)
(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)))))
(g:restore)))))
(fn label-coords [{ : points } bounds]
(var biggest 0)
@ -182,37 +122,40 @@ label.readout {
(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)))))
angle)))
(var map-surface nil)
(fn draw-onto-map-surface [surface bounds zoom]
(let [{ : num-tiles-x : num-tiles-y } bounds
(fn cairo-the-map [window]
(let [{ : lat : lon : zoom } app-state
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
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)
))))
(merge lines (tiles.polylines cq x y zoom))))
(let [seen-road-names {}
g (cairo.Context.create surface)]
(let [map-surface
(window:create_similar_surface
cairo.Content.COLOR
(* tile-size (+ 4 num-tiles-x))
(* tile-size (+ 4 num-tiles-y)))
seen-road-names {}
g (cairo.Context.create map-surface)]
(g:set_source_rgb 0.7 0.8 0.8)
(g:rectangle 0 0 bounds.pixels.x bounds.pixels.y)
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
(g:fill)
(cairo-roads g lines bounds)
(g:set_source_rgb 0 0 0)
(g:set_line_width road-width)
(cairo-roads-path g lines bounds)
(g:set_source_rgb 1 1 1)
(g:set_line_width (- road-width 2))
(cairo-roads-path g lines bounds)
(g:set_source_rgb 0.2 0.2 0.2)
(g:set_font_size (+ road-width 1))
@ -226,7 +169,7 @@ label.readout {
(tset seen-road-names n true)
(g:save)
(g:set_line_width h)
(g:set_source_rgba 1 0.95 1 0.7)
(g:set_source_rgb 1 1 1)
(g:move_to (- x 1) (- y 1))
(g:rotate angle)
(g:rel_line_to (+ w 1) 0)
@ -241,32 +184,24 @@ label.readout {
(g:fill)
(g:restore)))))
surface)))
map-surface)))
(var map-surface nil)
(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)) (/ viewport-width 2))
offset-y (- (* tile-size (- tile-y bounds.min.y)) (/ viewport-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)))))
(set map-surface (cairo-the-map window))))
(g:translate (+ (/ viewport-width 2)) (+ (/ viewport-height 2)))
(g:rotate (* (/ (- 360 app-state.smooth-course) 180) math.pi))
(g:translate (- (/ viewport-width 2)) (- (/ viewport-height 2)))
(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:paint)))
(g:rectangle 0 0 map-width map-height)
(g:fill)))
@ -278,7 +213,7 @@ label.readout {
(register-widget
:osm
(Gtk.DrawingArea {
:width viewport-width :height viewport-height
:width map-width :height map-height
:on_draw on-osm-draw
})))
@ -303,6 +238,9 @@ label.readout {
(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)]
@ -313,9 +251,6 @@ label.readout {
(not (= old-bounds.min.x bounds.min.x))
(not (= old-bounds.min.y bounds.min.y)))
(set map-surface nil)))
(set app-state.smooth-course
(+ app-state.smooth-course
(* 0.05 (- app-state.course app-state.smooth-course))))
(each [name widget (pairs state-widgets)]
(case name
:speed (widget:set_label
@ -350,8 +285,7 @@ label.readout {
(fn [self g]
(g:set_source_rgb 0.4 0.0 0.1)
(g:translate (// height 2) (// height 2))
(g:rotate (* (/ (- app-state.course app-state.smooth-course)
180) math.pi))
(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)
@ -402,13 +336,9 @@ label.readout {
(GLib.timeout_add
GLib.PRIORITY_DEFAULT
100 ; ms
20 ; ms
(fn []
;; run cqueues scheduler
(cq:step 0)
;; for smoother rotation when course changes, repaint more often than
;; once per gnss message
(update-app-state {})
true)
nil nil)

21
pkgs/maps/shell.nix
View File

@ -1,27 +1,8 @@
with import <nixpkgs> {};
let
package = pkgs.callPackage ./. {};
fennel-ls1 =
let inherit (pkgs) stdenv pandoc;
in stdenv.mkDerivation {
name = "fennel-ls";
buildInputs = [ package.lua ];
nativeBuildInputs = [ pandoc ];
makeFlags = [ "PREFIX=\\$out" ];
src = fetchFromSourcehut {
owner ="~xerool";
repo ="fennel-ls";
rev = "552b03b983c18d7db5053350711bef9088cc9110";
hash = "sha256-npR10hzPYgDPbKWB5ueq8cXAWYvUEbVVJ1R/EEdCnVY=";
};
};
fennel-ls = pkgs.fennel-ls.override { inherit (package) lua luaPackages; };
let package = pkgs.callPackage ./. {};
in
package.overrideAttrs(o: {
nativeBuildInputs = [ fennel-ls ] ++ o.nativeBuildInputs;
shellHook = ''
mkdir -p bin
( cd bin && ln -sf `type -p fennel-ls` `type -p fennel` . )
export LUA_CPATH=$(lua -e "print(package.cpath)")
export LUA_PATH=$(lua -e "print(package.path)")\;$RXI_JSON/share/lua/5.3/?.lua
'';

12
pkgs/maps/tiles.fnl
View File

@ -46,10 +46,10 @@
(fn overpass [lat lon zoom]
(let [width (/ 360 (^ 2 zoom))
n lat
w lon
s (- lat width)
e (+ lon width)]
n (+ lat width) ;XXX adjust for latitude
w (- lon width)
s lat
e lon]
(->
[
"[out:json];"
@ -71,7 +71,6 @@
e.id
{
:name (?. e :tags :name)
:tags e.tags
:points
(icollect [_ nd (ipairs e.nodes)]
(let [node (. nodes nd)
@ -109,7 +108,7 @@
;; 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 cb]
(fn polylines [cq x y zoom]
(let [k (.. x "_" y "_" zoom)
pathname (.. "/tmp/tiles/" k ".json")]
(if (file-exists? pathname)
@ -129,7 +128,6 @@
(cqueues.sleep (math.random 2 6))))
(print "got " k)
(f:write json)
(cb)
true)))
[] ; return no lines for now
))))