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

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

parent aedc8c6b
......@@ -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
......
......@@ -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")
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap
(lambda (v) (entity-add-value! "size" "varchar" v) '()))
(horiz
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap
(lambda (v) (entity-add-value! "size" "varchar" v) '()))
(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")) '()))))
(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"))))))
(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"))))
(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")) '())))
(mbutton "pf-grpalarm-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-alarm")
(list (replace-fragment (get-id "event-holder") "events"))))))
(horiz
(mbutton "pf-grpalarm-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-alarm")
(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) '())))
(mbutton "pf-grpmov-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-move")
(list (replace-fragment (get-id "event-holder") "events"))))))))
(horiz
(mbutton "pf-grpmov-done" "Done"
(lambda ()
(entity-record-values db "stream" "group-move")
(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