(in-package :loc) (defvar *positions* nil) (defvar *my-position* nil) (defun ini () #+android (qt:ini-positioning qt:*cpp*) #+ios (q> |active| ui:*position-source* t) (check-offline-map) #+mobile (update-my-position)) #+mobile (defun last-gps-position () (let* ((pos #+android (qrun* (qt:last-position qt:*cpp*)) ; 'qrun*': return value #+ios (qjs |lastPosition| ui:*position-source*)) (time (third pos))) (when time (setf (third pos) (if (zerop (length time)) 0 (parse-integer time)))) pos)) #+mobile (defun update-my-position (&optional (sec 60)) ; try for 1 min "Mobile only: update position from GPS of mobile device." (destructuring-bind (lat lon time) (last-gps-position) (if (zerop lat) (unless (zerop sec) (qsingle-shot 1000 (lambda () (update-my-position (1- sec))))) (let ((pos (list :lat lat :lon lon :time time))) (setf *my-position* pos) (qlog "position-updated: ~A" pos) (set-position (lora:my-num) pos) (send-to-radio))))) ; just once on startup (for now) #+mobile (defun send-to-radio () (if lora:*config-complete* (unless (getf *positions* (lora:my-num)) (lora:send-position *my-position*)) (qsingle-shot 1000 'send-to-radio))) (defun position* (node) (when (stringp node) (setf node (parse-integer node))) ; for JS (x:when-it (getf *positions* node) (list (getf x:it :lat) (getf x:it :lon)))) (defun set-position (node pos) (let ((lat (getf pos :lat))) (when (and node lat (not (zerop lat))) (setf (getf *positions* node) pos)))) ;;; distance (defconstant +earth-mean-radius+ 6371.0072d0) (defun to-rad (deg) (/ (* deg pi) 180)) (defun distance (from to) ;; Haversine formula (destructuring-bind ((lat-1 lon-1) (lat-2 lon-2)) (list from to) (if (and (numberp lat-1) (numberp lat-2)) (let* ((dlat (to-rad (- lat-2 lat-1))) (dlon (to-rad (- lon-2 lon-1))) (h-dlat (sin (/ dlat 2))) (h-dlon (sin (/ dlon 2)))) (setf h-dlat (expt h-dlat 2) h-dlon (expt h-dlon 2)) (let* ((y (+ h-dlat (* (cos (to-rad lat-1)) (cos (to-rad lat-2)) h-dlon))) (x (* 2 (asin (sqrt y))))) (floor (+ 0.5 (* x +earth-mean-radius+ 1000))))) 0))) (defun tile-path () ; see QML (namestring (app:in-data-path "" "tiles/"))) (defun tile-provider-path () ; see QML (if (probe-file "qml/tile-provider/") (x:cc "file://" (namestring (merge-pathnames "qml/tile-provider/"))) ; development "qrc:///qml/tile-provider/")) ; final app (defun activate-map () (unless (q< |active| ui:*map-loader*) (q> |active| ui:*map-loader* t) #+mobile (destructuring-bind (lat lon time) (last-gps-position) (unless (zerop lat) (qjs |setCenter| ui:*map* (list lat lon)))) #-mobile (let ((my-pos (position* (lora:my-num)))) (when my-pos (qjs |setCenter| ui:*map* my-pos))))) (defun show-map-clicked () ; see QML (let ((show (not (q< |visible| ui:*map-view*)))) (when show (activate-map) (qjs |updatePositions| ui:*map* (princ-to-string (lora:my-num)) ; STRING for JS (lora:my-name) (find-quick-item ui:*group*))) (q> |visible| ui:*map-view* show) ;; move map (not page) when swiping to left (q> |interactive| ui:*main-view* (not show)) (unless show (q> |active| ui:*map-loader* nil))) (values)) (defun position-count () ; see QML (length *positions*)) ;;; save/restore tiles (defun copy-stream (from to &optional (size most-positive-fixnum)) (let* ((buf-size (min 8192 size)) (buf (make-array buf-size :element-type (stream-element-type from)))) (loop :for pos = (read-sequence buf from :end (min buf-size size)) :do (write-sequence buf to :end pos) (decf size pos) :until (or (zerop pos) (zerop size)))) (values)) (defun make-map-bin () "Writes all tiles in a single file, because images are already compressed. This is meant to avoid useless (and possibly slow) zipping." (with-open-file (out (app:in-data-path "map.bin" "") :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (let ((directories (directory (app:in-data-path "**/" "tiles/")))) (when directories (let ((p (search "tiles/" (namestring (first directories)) :from-end t))) (flet ((add-string (str) (write-sequence (x:string-to-bytes str) out)) (sep () (write-byte #.(char-code #\|) out))) (dolist (dir directories) (add-string (subseq (namestring dir) p)) (sep)) (let ((files (directory (app:in-data-path "**/*.*" "tiles/")))) (dolist (file files) (with-open-file (in file :element-type (stream-element-type out)) (add-string (subseq (namestring file) p)) (sep) (add-string (princ-to-string (file-length in))) (sep) (copy-stream in out)))))))))) (defun extract-map-bin (&optional delete) "Restores tiles from a previously saved single binary file named 'map.bin'." (let ((blob (app:in-data-path "map.bin" ""))) (when (probe-file blob) (with-open-file (in blob :element-type '(unsigned-byte 8)) (flet ((read-string () (let ((bytes (loop :for byte = (read-byte in nil nil) :while (and byte (/= byte #.(char-code #\|))) :collect byte))) (if bytes (x:bytes-to-string bytes) (progn (when delete (close in) (delete-file blob)) (return-from extract-map-bin)))))) (loop (let ((name (app:in-data-path (read-string) ""))) (if (cl-fad:directory-pathname-p name) (ensure-directories-exist name) (let ((size (parse-integer (read-string)))) (with-open-file (out name :direction :output :if-exists :supersede :element-type (stream-element-type in)) (copy-stream in out size))))))))))) (defun check-offline-map () (extract-map-bin t))