use cqueues for gnss socket

This is to avoid a weird bug in the previous glib iochannel
implementation, where the socket was randomly being closed
after about a minute run time. But it's also less code, so
that's OK

pkgs/maps/Makefile

@@ -2,7 +2,7 @@ FENNEL?=fennel
 PREFIX?=/usr/local
 NAME?=maps
 
-MODULES=main.fnl
+MODULES=main.fnl tiles.fnl
 
 %.lua : %.fnl
 	$(FENNEL) --compile $< > $@
@@ -11,6 +11,12 @@ $(NAME): $(patsubst %.fnl,%.lua,$(MODULES)) Makefile
 	(echo -e "#!/usr/bin/env lua\n" ; cat main.lua ) > $@
 	chmod +x $@
 
+run:
+	fennel -e '((. (require :main) :run) "/tmp/gnss")'
+
+test:
+	fennel run-tests.fnl $(MODULES)
+
 install:
 	mkdir -p $(PREFIX)/bin $(PREFIX)/
 	cp $(NAME) $(PREFIX)/bin

pkgs/maps/fake-nmea.fnl

@@ -1,10 +1,72 @@
-(local { : sleep } (require :posix.unistd))
+(local { : sleep : close } (require :posix.unistd))
+(local sock (require :posix.sys.socket))
+(local poll (require :posix.poll))
+(local { : view }  (require :fennel))
+
+(fn handle-client [fd event]
+  (case event
+    {:HUP true}
+    (do
+      (print fd " disconnected")
+      (close fd)
+      (values fd nil))
+    {:IN true}
+    (do
+      (sock.recv fd 1024)               ; discard input and carry on
+      nil)))
+
+(fn accept-new-connection [server-sock event]
+  (case event
+    {:IN true}
+    (do
+      (print "new connection")
+      (let [connected (sock.accept server-sock)]
+        (print connected)
+        (values connected handle-client)))
+    {:HUP true}
+    (do
+      (print "HUP on server socket")
+      (os.exit 1))
+    _
+    (values nil nil)))
+
+(fn server-socket [path]
+  (let [s (assert (sock.socket sock.AF_UNIX sock.SOCK_STREAM 0))
+        sa { :family sock.AF_UNIX
+             :path path
+             }]
+    (assert (sock.bind s sa))
+    (assert (sock.listen s 10))
+    s))
+
+(fn read-with-rewind [handle]
+  (let [(s err) (handle:read "L")]
+    (if s
+        s
+        (if (and (not err) (handle:seek "set" 0)) ; eof
+            (read-with-rewind handle)
+            (error err)))))
+
+(fn write-sentences [handle outputs]
+  (var done false)
+  (while (not done)
+    (let [l (read-with-rewind handle)]
+      (if (string.match l "GNS") (set done true))
+      (each [fd action (pairs outputs)]
+        (when (sock.getpeername fd) ; cheeky
+          (sock.send fd l))))))
 
 (let [[filename socketname]  arg
-      socket (io.popen (.. "socat - unix-listen:" socketname) :w)]
+      server (server-socket socketname)
+      fd-actions { server accept-new-connection }]
   (with-open [handle (io.open filename :r)]
-    (each [l (handle:lines "L")]
+    (while true
-      (if (string.match l "GNS") (sleep 1))
+      (let [poll-fds (collect [fd _ (pairs fd-actions)]
-      (socket:write l)
+                       (values fd {:events { :IN true } }))]
-      (socket:flush)
+        (if (> (poll.poll poll-fds (* 1 1000)) 0)
-      )))
+            (each [fd v (pairs poll-fds)]
+              (when (. v :revents)
+                (print :polled fd (view v.revents))
+                (let [(k v) ((. fd-actions fd) fd v.revents)]
+                  (and k (tset fd-actions k v)))))
+            (write-sentences handle fd-actions))))))

pkgs/maps/main.fnl

@@ -2,6 +2,7 @@
 (local { : fdopen } (require :posix.stdio))
 (local ptime (require :posix.time))
 (local cqueues (require :cqueues))
+(local socket (require :cqueues.socket))
 
 (local nmea (require :nmea))
 (local tiles (require :tiles))
@@ -86,6 +87,7 @@ label.readout {
             :lon 0
             :zoom 17
             :course 0 ; direction of travel
+            :courses [0 0 0]
             :orientation-target 0  ; map rotation angle from north
             :orientation-actual 0  ; map rotation angle from north
             :tiles {}
@@ -140,18 +142,20 @@ label.readout {
               }
      }))
 
-;; diagonal radius is 538 pixels, 2.1 tiles
+(define-tests
+  :map-bounds-tile
+  ;; diagonal radius is 538 pixels, 2.1 tiles
 
-(let [bounds (map-bounds-tile 65539.5 45014.5)]
+  (let [bounds (map-bounds-tile 65539.5 45014.5)]
-  (expect= bounds.min {:x 65537 :y 45012})
+    (expect= bounds.min {:x 65537 :y 45012})
-  (expect= bounds.max {:x 65541 :y 45016})
+    (expect= bounds.max {:x 65541 :y 45016})
-  (expect= bounds.centre {:x 65539.5 :y 45014.5}))
+    (expect= bounds.centre {:x 65539.5 :y 45014.5}))
 
-(let [bounds (map-bounds-tile 65539.0 45014.0)]
+  (let [bounds (map-bounds-tile 65539.0 45014.0)]
-  (expect= bounds.min {:x 65536 :y 45011})
+    (expect= bounds.min {:x 65536 :y 45011})
-  (expect= bounds.max {:x 65541 :y 45016})
+    (expect= bounds.max {:x 65541 :y 45016})
-  (expect= bounds.centre {:x 65539 :y 45014})
+    (expect= bounds.centre {:x 65539 :y 45014})
-  )
+    ))
 
 (fn map-bounds [lat lon zoom]
   (let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)]
@@ -279,7 +283,6 @@ label.readout {
 
 
     (when (not (= app-state.orientation-actual app-state.orientation-target))
-      (print (- app-state.orientation-actual app-state.orientation-target))
       (g:translate (+ (/ viewport-width 2))  (+ (/ viewport-height 2)))
       (g:rotate (* (/ (- 360 (- app-state.orientation-actual app-state.orientation-target)) 180) math.pi))
       (g:translate (- (/ viewport-width 2))  (- (/ viewport-height 2))))
@@ -322,13 +325,13 @@ label.readout {
         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")
+(define-tests
+  :hhmmss
+  (expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45"))
 
 (fn turn-smoothly [from to]
-  (if (< (math.abs (- from to)) 10) to
+  (if (< (math.abs (- from to)) 3) to
-      (+ from (* 0.05 (- to from)))))
+      (+ from (* 0.3 (- to from)))))
-
-
 
 (fn update-app-state [new-vals]
   (let [old-state (merge {} app-state)
@@ -445,55 +448,34 @@ label.readout {
                  }))))
 
 
-(local socket-path (or (. arg 1) "/var/run/gnss-share.sock"))
+(fn clamp [a b c]
+  (if (< b a) a
+      (> b c) c
+      b))
 
-(local gnss-socket
+(fn read-gnss-sentence [l]
-       (let [addr (Gio.UnixSocketAddress {
+  (if (not (= l ""))
-                                          :path socket-path
+      (let [message (nmea.parse l)]
-                                          })]
+        (case message
-         (: (Gio.SocketClient) :connect addr nil)))
+          { : lat : lon : utc}
-
+          (update-app-state
-(fn read-gnss [socket]
+           {
-  (each [l #(socket:read "l")]
+            : lat : lon
-    ; (print "gnss" l)
+            :time-of-day
-    (if (not (= l ""))
+            (let [(h m s) (string.match utc "(..)(..)(..)")]
-        (let [message (nmea.parse l)]
+              (+ s (* m 60) (* h 60 60)))
-          (case message
+            }
-            { : lat : lon : utc}
+           )
+          { : speed-knots }
+          (update-app-state { :speed (* speed-knots knot-in-m-s) }))
+        (when message.bearing-true
+          (let [c1 message.bearing-true
+                c2 (. app-state.courses 1)
+                c3 (. app-state.courses 2)]
             (update-app-state
-             {
+             { :course (clamp c1 c2 c3)
-              : lat : lon
+               :courses [c1 c2 c3]
-              :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
- 100 ; 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)
 
 (fn collect-profile []
   (GLib.timeout_add
@@ -503,16 +485,39 @@ label.readout {
   (print "profiling for 60 seconds")
   (profile.start 0))
 
+(fn watch-gnss-socket [socket-path]
+  (let [sock (socket.connect { :path socket-path :unlink true })]
+    (cq:wrap
+     #(each [l (sock:lines "*L")]
+        (read-gnss-sentence l)))))
 
-(window:add
- (doto (Gtk.Overlay {})
-   (: :add (osm-widget))
-   (: :add_overlay (readouts))
-   (: :add_overlay (arrow))
-   (: :add_overlay (rose))
-   ))
 
-(window:show_all)
+(fn run [gnss-socket]
-(styles)
+  (watch-gnss-socket (or gnss-socket "/var/run/gnss-share.sock"))
-(when (os.getenv "MAP_PROFILE") (collect-profile))
+
-(Gtk:main)
+  (GLib.timeout_add
+   GLib.PRIORITY_DEFAULT
+   100 ; 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)
+
+  (window:add
+   (doto (Gtk.Overlay {})
+     (: :add (osm-widget))
+     (: :add_overlay (readouts))
+     (: :add_overlay (arrow))
+     (: :add_overlay (rose))
+     ))
+
+  (window:show_all)
+  (styles)
+  (when (os.getenv "MAP_PROFILE") (collect-profile))
+  (Gtk:main))
+
+{ : run }

pkgs/maps/run-tests.fnl

@@ -0,0 +1,10 @@
+(local fennel (require :fennel))
+(local specials (require :fennel.specials))
+
+(local compiler-env
+       (doto (. (specials.make-compiler-env) :_G)
+         (tset "RUNNING_TESTS" true)))
+
+(each [_ f (ipairs arg)]
+  (print :testing f)
+  (fennel.dofile f { :correlate true :compilerEnv compiler-env }))

pkgs/maps/tiles.fnl

@@ -10,7 +10,8 @@
 
 (fn sinh [x] (/ (- 1 (math.exp (* -2 x))) (* 2 (math.exp (- x)))))
 
-(expect (< (math.abs  (- (sinh 2) 3.626860407847)) 0.001))
+(define-tests :sinh
+  (expect (< (math.abs  (- (sinh 2) 3.626860407847)) 0.001)))
 
 (fn tile->latlon [xtile ytile zoom]
   (let [n (^ 2 zoom)
@@ -21,15 +22,17 @@
 
     (values (/ (* lat-rad 180) math.pi) lon-deg)))
 
-(let [(lat lon) (tile->latlon 0 0 0)]
+(define-tests
-  (expect= lon -180)
+  :tile->latlon
-  (expect-near lat 85.05112877)
+  (let [(lat lon) (tile->latlon 0 0 0)]
-  )
+    (expect= lon -180)
+    (expect-near lat 85.05112877)
+    )
 
-(let [(lat lon) (tile->latlon 232798 103246 18)]
+  (let [(lat lon) (tile->latlon 232798 103246 18)]
-  (expect-near lon 139.699401855)
+    (expect-near lon 139.699401855)
-  (expect-near lat 35.6595278648)
+    (expect-near lat 35.6595278648)
-  )
+    ))
 
 (fn latlon->tile [lat lon zoom]
   (let [n (^ 2 zoom)
@@ -39,9 +42,10 @@
         y (* (- 1 (/ t math.pi)) (/ n 2))]
     (values x y)))
 
-(let [(x y) (latlon->tile 52.1234 -0.53 17)]
+(define-tests :latlon->tile
-  (expect= (math.floor x) 65343)
+  (let [(x y) (latlon->tile 52.1234 -0.53 17)]
-  (expect= (math.floor y) 43221))
+    (expect= (math.floor x) 65343)
+    (expect= (math.floor y) 43221)))
 
 
 (fn overpass [lat lon zoom]