Skip to content

GitLab

Commit f77d50fc authored by Dave Griffiths's avatar Dave Griffiths
Browse files

more stream data, date-time etc, raspberry pi tests

parent 1064e159
Hide whitespace changes
Inline Side-by-side
Showing with 104 additions and 27 deletions
android/assets/eavdb.scm
View file @ f77d50fc
......@@ -424,7 +424,7 @@
(lambda (kt r)
(if (equal? r "") (string-append "\"" (ktv-key kt) "\"")
(string-append r ", \"" (ktv-key kt) "\"")))
""
"id, "
(get-attribute-ids/types db table entity-type)))
(define (csv db table entity-type)
......@@ -451,11 +451,11 @@
(equal? (substring (ktv-key ktv) 0 3) "id-"))
(string-append r ", \"" (get-entity-name db "sync" (ktv-value ktv)) "\""))
(else
(string-append r ", \"" (stringify-value ktv) "\""))))
entity-type ;; type
(string-append r ", \"" (stringify-value-url ktv) "\""))))
(vector-ref res 1) ;; unique_id
entity))))
(csv-titles db table entity-type)
(cdr (db-select
db (string-append
"select entity_id from "
"select entity_id, unique_id from "
table "_entity where entity_type = ?") entity-type))))
android/assets/lib.scm
View file @ f77d50fc
......@@ -886,7 +886,6 @@
((equal? (callback-type cb) "spinner")
((callback-fn cb) (car args)))
((equal? (callback-type cb) "button-grid")
(msg "button grid cb" args)
((callback-fn cb) (car args) (cadr args)))
(else
(msg "no callbacks for type" (callback-type cb))))))
......
android/assets/starwisp.scm
View file @ f77d50fc
......@@ -20,6 +20,18 @@
(define obs-pf "Pup Focal")
(define obs-gp "Group Events")
(define entity-types
(list
"pup-focal"
"pup-focal-nearest"
"pup-focal-pupfeed"
"pup-focal-pupfind"
"pup-focal-pupcare"
"pup-focal-pupaggr"
"group-interaction"
"group-alarm"
"group-move"))
;; colours
(define pf-col (list 22 19 178 96))
......@@ -115,8 +127,22 @@
(get-current 'entity-values '())
(ktv key type value))))
(define (dt->string dt)
(string-append
(number->string (list-ref dt 0)) "-"
(number->string (list-ref dt 1)) "-"
(number->string (list-ref dt 2)) "T"
(number->string (list-ref dt 3)) ":"
(number->string (list-ref dt 4)) ":"
(substring (number->string (+ 100 (list-ref dt 5))) 1 3)))
;; build entity from all ktvs, insert to db, return unique_id
(define (entity-record-values db table type)
;; standard bits
(entity-add-value! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value! "time" "varchar" (dt->string (date-time)))
(entity-add-value! "lat" "real" 0)
(entity-add-value! "lon" "real" 0)
(let ((values (get-current 'entity-values '())))
(msg values)
(cond
......@@ -480,7 +506,7 @@
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id_who" "varchar" (ktv-get individual "unique_id"))
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -542,7 +568,7 @@
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id_who" "varchar" (ktv-get individual "unique_id"))
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -573,10 +599,10 @@
(entity-add-value! "level" "varchar" v) '())))
(mtoggle-button "pf-pupaggr-in" "Initiate?"
(lambda (v)
(entity-add-value! "initiate" "varchar" v) '()))
(entity-add-value! "initiate" "varchar" (if v "yes" "no")) '()))
(mtoggle-button "pf-pupaggr-win" "Win?"
(lambda (v)
(entity-add-value! "win" "varchar" v) '()))))
(entity-add-value! "win" "varchar" (if v "yes" "no")) '()))))
(mbutton "pf-pupaggr-done" "Done"
(lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
......@@ -592,7 +618,7 @@
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id_with" "varchar" (ktv-get individual "unique_id"))
(entity-add-value! "id-with" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -615,11 +641,17 @@
(list
(vert
(mtext "text" "Outcome")
(spinner (make-id "gp-int-out") (list "Retreat" "Advance" "Fight & retreat" "Fight & win") fillwrap (lambda (v) '())))
(spinner (make-id "gp-int-out") (list "Retreat" "Advance" "Fight & retreat" "Fight & win") fillwrap
(lambda (v)
(entity-add-value! "outcome" "varchar" v) '())))
(vert
(mtext "text" "Duration")
(edit-text (make-id "gp-int-dur") "" 20 "numeric" fillwrap (lambda (v) '())))
(mbutton "pf-grpint-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events"))))))))
(edit-text (make-id "gp-int-dur") "" 20 "numeric" fillwrap
(lambda (v) (entity-add-value! "duration" "int" (string->number v)) '())))
(mbutton "pf-grpint-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-interaction")
(list (replace-fragment (get-id "pf-bot") "events"))))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -628,13 +660,15 @@
(populate-grid-selector
"gp-int-pack" "single"
(db-all db "sync" "pack")
(lambda (individual)
(lambda (pack)
(entity-add-value! "id-other-pack" "varchar" (ktv-get pack "unique_id"))
(list)))
(populate-grid-selector
"gp-int-leader" "single"
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -652,9 +686,17 @@
(build-grid-selector "gp-alarm-caller" "single" "Alarm caller")
(mtext "text" "Cause")
(horiz
(spinner (make-id "gp-alarm-cause") (list "Predator" "Other mongoose pack" "Humans" "Other" "Unknown") fillwrap (lambda (v) '()))
(mtoggle-button "gp-alarm-join" "Did the others join in?" (lambda (v) '())))
(mbutton "pf-grpalarm-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events"))))))
(spinner (make-id "gp-alarm-cause") (list "Predator" "Other mongoose pack" "Humans" "Other" "Unknown") fillwrap
(lambda (v)
(entity-add-value! "cause" "varchar" v) '()))
(mtoggle-button "gp-alarm-join" "Did the others join in?"
(lambda (v)
(entity-add-value! "others-join" "varchar"
(if v "yes" "no")) '())))
(mbutton "pf-grpalarm-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-alarm")
(list (replace-fragment (get-id "pf-bot") "events"))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -665,6 +707,7 @@
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id-caller" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -682,16 +725,23 @@
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 90 '1 'left 0) trans-col
(list
(medit-text "gp-mov-w" "Width" "numeric" (lambda (v) '()))
(medit-text "gp-mov-l" "Length" "numeric" (lambda (v) '()))
(medit-text "gp-mov-l" "How many" "numeric" (lambda (v) '()))))
(medit-text "gp-mov-w" "Width" "numeric"
(lambda (v) (entity-add-value! "pack-width" "int" (string->number v)) '()))
(medit-text "gp-mov-l" "Length" "numeric"
(lambda (v) (entity-add-value! "pack-height" "int" (string->number v)) '()))
(medit-text "gp-mov-l" "How many" "numeric"
(lambda (v) (entity-add-value! "pack-count" "int" (string->number v)) '()))))
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 90 '1 'left 0) trans-col
(list
(vert
(mtext "" "Where to")
(spinner (make-id "gp-mov-to") (list "Latrine" "Water" "Food" "Nothing" "Unknown") fillwrap (lambda (v) '())))
(mbutton "pf-grpmov-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events"))))))))
(spinner (make-id "gp-mov-to") (list "Latrine" "Water" "Food" "Nothing" "Unknown") fillwrap
(lambda (v) (entity-add-value! "destination" "varchar" v) '())))
(mbutton "pf-grpmov-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-move")
(list (replace-fragment (get-id "pf-bot") "events"))))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -702,6 +752,7 @@
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
(list)))
))
(lambda (fragment) '())
......@@ -1362,7 +1413,9 @@
(update-widget 'text-view (get-id "sync-connect") 'text state)))))))
(mbutton "sync-sync" "Push"
(lambda ()
(let ((r (spit-dirty db "sync")))
(let ((r (append
(spit-dirty db "sync")
(spit-dirty db "stream"))))
(cons (if (> (length r) 0)
(toast "Uploading data...")
(toast "No data changed to upload")) r))))
......@@ -1374,8 +1427,11 @@
(mbutton2 "sync-prof" "Profile" (lambda () (prof-print) '()))
(mbutton2 "sync-prof" "CSV"
(lambda ()
(msg (csv db "stream" "pup-focal"))
(msg (csv db "stream" "pup-focal-nearest"))
(for-each
(lambda (e)
(msg e)
(msg (csv db "stream" e)))
entity-types)
'()))
(mbutton2 "sync-send" "Done" (lambda () (list (finish-activity 2))))))
......
android/jni/scheme/opdefines.h
View file @ f77d50fc
......@@ -198,6 +198,7 @@
_OP_DEF(opexe_6, "db-insert", 2, INF_ARG, TST_NONE, OP_INSERT_DB )
_OP_DEF(opexe_6, "db-status", 1, 1, TST_NONE, OP_STATUS_DB )
_OP_DEF(opexe_6, "time", 0, 0, TST_NONE, OP_TIME )
_OP_DEF(opexe_6, "date-time", 0, 0, TST_NONE, OP_DATETIME )
_OP_DEF(opexe_6, "id-map-add", 2, 2, TST_NONE, OP_ID_MAP_ADD )
_OP_DEF(opexe_6, "id-map-get", 1, 1, TST_NONE, OP_ID_MAP_GET )
......
android/jni/scheme/scheme.cpp
View file @ f77d50fc
......@@ -31,6 +31,7 @@
#include <float.h>
#include <ctype.h>
#include <sys/time.h>
#include <time.h>
#ifdef ANDROID_NDK
#include <android/log.h>
......@@ -4321,10 +4322,10 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
s_return(sc,sc->F);
case OP_SEND:
if (is_string(car(sc->args))) {
if (starwisp_data!=NULL) {
if (starwisp_data!=NULL) {
__android_log_print(ANDROID_LOG_INFO, "starwisp", "deleting starwisp data: something is wrong!");
free(starwisp_data);
}
}
starwisp_data=strdup(string_value(car(sc->args)));
}
s_return(sc,sc->F);
......@@ -4374,6 +4375,26 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
s_return(sc,cons(sc,mk_integer(sc,t.tv_sec),
cons(sc,mk_integer(sc,t.tv_usec),sc->NIL)));
}
case OP_DATETIME: {
timeval t;
// stop valgrind complaining
t.tv_sec=0;
t.tv_usec=0;
gettimeofday(&t,NULL);
struct tm *now = gmtime((time_t *)&t.tv_sec);
/* note: now->tm_year is the number of years SINCE 1900. On the year 2000, this
will be 100 not 0. Do a man gmtime for more information */
s_return(sc,cons(sc,mk_integer(sc,now->tm_year + 1900),
cons(sc,mk_integer(sc,now->tm_mon + 1),
cons(sc,mk_integer(sc,now->tm_mday),
cons(sc,mk_integer(sc,now->tm_hour),
cons(sc,mk_integer(sc,now->tm_min),
cons(sc,mk_integer(sc,now->tm_sec), sc->NIL)))))));
}
case OP_ID_MAP_ADD: {
the_idmap.add(
string_value(car(sc->args)),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment