Skip to content

GitLab

Commit 1d51edcc authored by Dave Griffiths's avatar Dave Griffiths
Browse files

added adult filtering, clearing entities between dialogs, cancel buttons added

parent aedc8c6b
Show whitespace changes
Inline Side-by-side
Showing with 106 additions and 27 deletions
android/assets/eavdb.scm
View file @ 1d51edcc
......@@ -286,6 +286,28 @@
(vector-ref i 0))
(cdr s)))))
(define (all-entities-where-older db table type ktv ktv2)
(let ((s (db-select
db (string-append
"select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv)
" as a on a.entity_id = e.entity_id "
"join " table "_value_" (ktv-type ktv2)
" as b on b.entity_id = e.entity_id "
"where e.entity_type = ? "
"and a.attribute_id = ? and a.value = ? "
"and b.attribute_id = ? and b.value < DateTime(?)"
)
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2))))
(msg "date select" (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (validate db)
;; check attribute for duplicate entity-id/attribute-ids
0)
......@@ -365,6 +387,15 @@
(prof-end "db-all-where newer")
r))
(define (db-all-older db table type ktv ktv2)
(prof-start "db-all-where older")
(let ((r (map
(lambda (i)
(get-entity db table i))
(all-entities-where-older db table type ktv ktv2))))
(prof-end "db-all-where older")
r))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
......
android/assets/starwisp.scm
View file @ 1d51edcc
......@@ -136,11 +136,11 @@
(define (entity-set! ktv-list)
(set-current! 'entity-values ktv-list))
(define (dt->string dt)
(define (date-time->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 2)) " "
(number->string (list-ref dt 3)) ":"
(number->string (list-ref dt 4)) ":"
(substring (number->string (+ 100 (list-ref dt 5))) 1 2)))
......@@ -149,7 +149,7 @@
(define (entity-record-values db table type)
;; standard bits
(entity-add-value! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value! "time" "varchar" (date->string (date-time)))
(entity-add-value! "time" "varchar" (date-time->string (date-time)))
(entity-add-value! "lat" "real" 0)
(entity-add-value! "lon" "real" 0)
(let ((values (get-current 'entity-values '())))
......@@ -472,6 +472,12 @@
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
(define (db-mongooses-by-pack-adults)
(db-all-older
db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
......@@ -584,18 +590,20 @@
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(entity-add-value! "scan-time" "varchar" (date-time->string (date-time)))
(list
(play-sound "ping")
(vibrate 300)
(populate-grid-selector
"pf-scan-nearest" "single"
(db-mongooses-by-pack)
(db-mongooses-by-pack-adults)
(lambda (individual)
(entity-add-value! "id-nearest" "varchar" (ktv-get individual "unique_id"))
(list)))
(populate-grid-selector
"pf-scan-close" "toggle"
(db-mongooses-by-pack)
(db-mongooses-by-pack-adults)
(lambda (individuals)
(entity-add-value! "id-list-close" "varchar" (assemble-array individuals))
(list)))
......@@ -622,15 +630,19 @@
(lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupfeed")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfeed-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"pf-pupfeed-who" "single"
(db-mongooses-by-pack)
(db-mongooses-by-pack-adults)
(lambda (individual)
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list)))
......@@ -647,18 +659,22 @@
(list
(mtitle "title" "Event: Pup found food")
(mtext "text" "Food size")
(horiz
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap
(lambda (v) (entity-add-value! "size" "varchar" v) '()))
(horiz
(mbutton "pf-pupfind-done" "Done"
(lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupfind")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupfind-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
))
(lambda (fragment) '())
......@@ -683,15 +699,19 @@
(lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupcare")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupcare-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"pf-pupcare-who" "single"
(db-mongooses-by-pack)
(db-mongooses-by-pack-adults)
(lambda (individual)
(entity-add-value! "id-who" "varchar" (ktv-get individual "unique_id"))
(list)))
......@@ -728,15 +748,21 @@
(mtoggle-button "pf-pupaggr-win" "Win?"
(lambda (v)
(entity-add-value! "win" "varchar" (if v "yes" "no")) '()))))
(horiz
(mbutton "pf-pupaggr-done" "Done"
(lambda ()
(entity-add-value! "parent" "varchar" (get-current 'pup-focal-id ""))
(entity-record-values db "stream" "pup-focal-pupaggr")
(list (replace-fragment (get-id "event-holder") "events"))))))
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-pupaggr-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"pf-pupaggr-partner" "single"
......@@ -775,11 +801,16 @@
(mbutton "pf-grpint-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-interaction")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpint-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events"))))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"gp-int-pack" "single"
......@@ -816,14 +847,19 @@
(lambda (v)
(entity-add-value! "others-join" "varchar"
(if v "yes" "no")) '())))
(horiz
(mbutton "pf-grpalarm-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-alarm")
(list (replace-fragment (get-id "event-holder") "events"))))))
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"gp-alarm-caller" "single"
......@@ -854,20 +890,25 @@
(medit-text "gp-mov-c" "How many mongooses?" "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
(make-id "") 'horizontal (layout 'fill-parent 'wrap-content '1 'left 0) trans-col
(list
(vert
(mtext "" "Where to")
(spinner (make-id "gp-mov-to") (list "Latrine" "Water" "Food" "Nothing" "Den" "Unknown") fillwrap
(lambda (v) (entity-add-value! "destination" "varchar" v) '())))
(horiz
(mbutton "pf-grpmov-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-move")
(list (replace-fragment (get-id "event-holder") "events"))))))))
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "pf-grpalarm-cancel" "Cancel"
(lambda ()
(list (replace-fragment (get-id "event-holder") "events")))))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(entity-reset!)
(list
(populate-grid-selector
"gp-mov-leader" "single"
......@@ -903,7 +944,9 @@
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg) (list))
(lambda (fragment arg)
(entity-reset!)
(list))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
......@@ -1005,12 +1048,12 @@
(list
(populate-grid-selector
"gc-pup-choose" "toggle"
(db-mongooses-by-pack)
(db-mongooses-by-pack-pups)
(lambda (individual)
(list)))
(populate-grid-selector
"gc-pup-escort" "toggle"
(db-mongooses-by-pack)
(db-mongooses-by-pack-adults)
(lambda (individual)
(list)))
))
......@@ -1271,6 +1314,7 @@
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(entity-reset!)
(list
(populate-grid-selector
"pf1-grid" "single"
......@@ -1394,7 +1438,9 @@
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(entity-reset!)
(list))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -1471,6 +1517,7 @@
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(entity-reset!)
;; make sure all fields exist
(entity-add-value! "name" "varchar" "noname")
(entity-add-value! "gender" "varchar" "Female")
......@@ -1533,6 +1580,7 @@
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(entity-reset!)
(entity-set! (get-current 'individual '()))
(let ((individual (get-current 'individual '())))
(list
......
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