Commit 7241a161 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

triple widgets and lots of stuff

parent d8230d01
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" <manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.mongoose" package="foam.mongoose"
android:versionCode="7" android:versionCode="8"
android:versionName="1.0"> android:versionName="1.0">
<application android:label="@string/app_name" <application android:label="@string/app_name"
android:icon="@drawable/logo" android:icon="@drawable/logo"
......
...@@ -293,9 +293,9 @@ ...@@ -293,9 +293,9 @@
" as b on b.entity_id = e.entity_id " " as b on b.entity_id = e.entity_id "
"where e.entity_type = ? " "where e.entity_type = ? "
"and a.attribute_id = ? and a.value = ? " "and a.attribute_id = ? and a.value = ? "
"and b.attribute_id = ? and b.value > DateTime(?)" "and b.attribute_id = ? and (b.value > DateTime(?) and b.value != ?)"
) )
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2)))) type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
(msg "date select" (db-status db)) (msg "date select" (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -314,9 +314,9 @@ ...@@ -314,9 +314,9 @@
" as b on b.entity_id = e.entity_id " " as b on b.entity_id = e.entity_id "
"where e.entity_type = ? " "where e.entity_type = ? "
"and a.attribute_id = ? and a.value = ? " "and a.attribute_id = ? and a.value = ? "
"and b.attribute_id = ? and b.value < DateTime(?)" "and b.attribute_id = ? and (b.value < DateTime(?) or b.value = ?)"
) )
type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2)))) type (ktv-key ktv) (ktv-value ktv) (ktv-key ktv2) (ktv-value ktv2) "Unknown")))
(msg "date select" (db-status db)) (msg "date select" (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -325,7 +325,6 @@ ...@@ -325,7 +325,6 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (cdr s)))))
(define (update-entities-where2 db table type ktv ktv2) (define (update-entities-where2 db table type ktv ktv2)
(let ((s (db-select (let ((s (db-select
db (string-append db (string-append
...@@ -432,7 +431,6 @@ ...@@ -432,7 +431,6 @@
(prof-end "db-all-where older") (prof-end "db-all-where older")
r)) r))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
......
...@@ -793,7 +793,7 @@ ...@@ -793,7 +793,7 @@
r)) r))
(define (top-callback type activity-name activity args) (define (top-callback type activity-name activity args)
;;(display "activity-callback ")(display type)(display " ")(display args)(newline) ;;(display "activity/fragment-callback ")(display type)(display " ")(display args)(newline)
(if (not activity) (if (not activity)
(begin (display "no activity/fragment called ")(display activity-name)(newline)) (begin (display "no activity/fragment called ")(display activity-name)(newline))
(let ((ret (cond (let ((ret (cond
......
...@@ -358,6 +358,15 @@ ...@@ -358,6 +358,15 @@
(define (mtoggle-button id title fn) (define (mtoggle-button id title fn)
(toggle-button (make-id id) title 30 (layout 'fill-parent 'wrap-content 1 'centre 0) "fancy" fn)) (toggle-button (make-id id) title 30 (layout 'fill-parent 'wrap-content 1 'centre 0) "fancy" fn))
(define (mtoggle-button-yes id title fn)
(toggle-button (make-id id) title 30 (layout 49 43 1 'centre 0) "yes" fn))
(define (mtoggle-button-maybe id title fn)
(toggle-button (make-id id) title 30 (layout 49 43 1 'centre 0) "maybe" fn))
(define (mtoggle-button-no id title fn)
(toggle-button (make-id id) title 30 (layout 49 43 1 'centre 0) "no" fn))
(define (mtoggle-button2 id title fn) (define (mtoggle-button2 id title fn)
(toggle-button (make-id id) title 30 (layout 150 100 1 'centre 0) "plain" fn)) (toggle-button (make-id id) title 30 (layout 150 100 1 'centre 0) "plain" fn))
...@@ -425,19 +434,27 @@ ...@@ -425,19 +434,27 @@
(define (fast-get-name item) (define (fast-get-name item)
(list-ref (list-ref item 1) 2)) (list-ref (list-ref item 1) 2))
(define (build-button-items name items) (define (build-button-items name items unknown)
(map (append
(lambda (item) (map
(let ((item-name (fast-get-name item))) (lambda (item)
(list (make-id (string-append name item-name)) (let ((item-name (fast-get-name item)))
item (list (make-id (string-append name item-name))
item-name))) item
items)) item-name)))
items)
(define (populate-grid-selector name type items fn) (if unknown
(list
(list (make-id (string-append name "-unknown"))
(list (ktv "name" "varchar" "Unknown")
(ktv "unique_id" "varchar" "Unknown"))
"???"))
'())))
(define (populate-grid-selector name type items unknown fn)
(prof-start "popgrid") (prof-start "popgrid")
(prof-start "popgrid setup") (prof-start "popgrid setup")
(let ((id->items (build-button-items name items)) (let ((id->items (build-button-items name items unknown))
(selected-set '())) (selected-set '()))
(prof-end "popgrid setup") (prof-end "popgrid setup")
(let ((r (update-widget (let ((r (update-widget
...@@ -446,7 +463,7 @@ ...@@ -446,7 +463,7 @@
type 3 30 (layout 100 60 1 'left 0) type 3 30 (layout 100 60 1 'left 0)
(map (map
(lambda (ii) (lambda (ii)
(list (car ii) (caddr ii))) (dbg (list (car ii) (caddr ii))))
id->items) id->items)
(lambda (v state) (lambda (v state)
(cond (cond
...@@ -509,6 +526,59 @@ ...@@ -509,6 +526,59 @@
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id")) (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6))))) (ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
(define (tri-state id text key)
(linear-layout
(make-id "") 'vertical (layout 'fill-parent 'wrap-content '1 'centre 0) trans-col
(list
(linear-layout
(make-id "") 'horizontal (layout 'wrap-content 'wrap-parent '1 'centre 0) trans-col
(list
(mtoggle-button-yes
(string-append id "-y") ""
(lambda (v)
(cond
(v
(entity-add-value! key "varchar" "yes")
(list
(update-widget 'toggle-button (get-id (string-append id "-n")) 'checked 0)
(update-widget 'toggle-button (get-id (string-append id "-m")) 'checked 0)))
(else
(list
(update-widget 'toggle-button (get-id (string-append id "-y")) 'checked 1))))
))
(mtoggle-button-maybe
(string-append id "-m") ""
(lambda (v)
(cond
(v
(entity-add-value! key "varchar" "maybe")
(list
(update-widget 'toggle-button (get-id (string-append id "-y")) 'checked 0)
(update-widget 'toggle-button (get-id (string-append id "-n")) 'checked 0)))
(else
(list
(update-widget 'toggle-button (get-id (string-append id "-m")) 'checked 1))))
))
(mtoggle-button-no
(string-append id "-n") ""
(lambda (v)
(cond
(v
(entity-add-value! key "varchar" "no")
(list
(update-widget 'toggle-button (get-id (string-append id "-y")) 'checked 0)
(update-widget 'toggle-button (get-id (string-append id "-m")) 'checked 0)))
(else
(list
(update-widget 'toggle-button (get-id (string-append id "-n")) 'checked 1))))
))))
(text-view 0 text 30 (layout 'wrap-content 'wrap-parent '1 'centre 0)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
...@@ -680,13 +750,13 @@ ...@@ -680,13 +750,13 @@
(vibrate 300) (vibrate 300)
(populate-grid-selector (populate-grid-selector
"pf-scan-nearest" "single" "pf-scan-nearest" "single"
(db-mongooses-by-pack-adults) (db-mongooses-by-pack-adults) #t
(lambda (individual) (lambda (individual)
(entity-add-value! "id-nearest" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-nearest" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
(populate-grid-selector (populate-grid-selector
"pf-scan-close" "toggle" "pf-scan-close" "toggle"
(db-mongooses-by-pack-adults) (db-mongooses-by-pack-adults) #t
(lambda (individuals) (lambda (individuals)
(entity-add-value! "id-list-close" "varchar" (assemble-array individuals)) (entity-add-value! "id-list-close" "varchar" (assemble-array individuals))
(list))) (list)))
...@@ -728,7 +798,7 @@ ...@@ -728,7 +798,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupfeed-who" "single" "pf-pupfeed-who" "single"
(db-mongooses-by-pack-adults) (db-mongooses-by-pack-adults) #t
(lambda (individual) (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))) (list)))
...@@ -802,7 +872,7 @@ ...@@ -802,7 +872,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupcare-who" "single" "pf-pupcare-who" "single"
(db-mongooses-by-pack-adults) (db-mongooses-by-pack-adults) #t
(lambda (individual) (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))) (list)))
...@@ -833,12 +903,16 @@ ...@@ -833,12 +903,16 @@
(spinner (make-id "pf-pupaggr-level") (list "Block" "Snap" "Chase" "Push" "Fight") fillwrap (spinner (make-id "pf-pupaggr-level") (list "Block" "Snap" "Chase" "Push" "Fight") fillwrap
(lambda (v) (lambda (v)
(entity-add-value! "level" "varchar" v) '()))) (entity-add-value! "level" "varchar" v) '())))
(mtoggle-button "pf-pupaggr-in" "Initiate?"
(lambda (v) (tri-state "pf-pupaggr-in" "Initiate?" "initiate")
(entity-add-value! "initiate" "varchar" (if v "yes" "no")) '()))
(mtoggle-button "pf-pupaggr-win" "Win?" ;(mtoggle-button "pf-pupaggr-in" "Initiate?"
(lambda (v) ; (lambda (v)
(entity-add-value! "win" "varchar" (if v "yes" "no")) '())))) ; (entity-add-value! "initiate" "varchar" (if v "yes" "no")) '()))
(tri-state "pf-pupaggr-win" "Win?" "win")))
(spacer 20) (spacer 20)
(horiz (horiz
(mbutton "pf-pupaggr-done" "Done" (mbutton "pf-pupaggr-done" "Done"
...@@ -858,7 +932,7 @@ ...@@ -858,7 +932,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"pf-pupaggr-partner" "single" "pf-pupaggr-partner" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack) #t
(lambda (individual) (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))) (list)))
...@@ -909,13 +983,13 @@ ...@@ -909,13 +983,13 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gp-int-pack" "single" "gp-int-pack" "single"
(db-all db "sync" "pack") (db-all db "sync" "pack") #f
(lambda (pack) (lambda (pack)
(entity-add-value! "id-other-pack" "varchar" (ktv-get pack "unique_id")) (entity-add-value! "id-other-pack" "varchar" (ktv-get pack "unique_id"))
(list))) (list)))
(populate-grid-selector (populate-grid-selector
"gp-int-leader" "single" "gp-int-leader" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack) #t
(lambda (individual) (lambda (individual)
(entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
...@@ -933,15 +1007,18 @@ ...@@ -933,15 +1007,18 @@
(list (list
(mtitle "title" "Event: Group alarm") (mtitle "title" "Event: Group alarm")
(build-grid-selector "gp-alarm-caller" "single" "Alarm caller") (build-grid-selector "gp-alarm-caller" "single" "Alarm caller")
(mtext "text" "Cause")
(horiz (linear-layout
(spinner (make-id "gp-alarm-cause") (list "Predator" "Other mongoose pack" "Humans" "Other" "Unknown") fillwrap (make-id "") 'horizontal fillwrap trans-col
(lambda (v) (list
(entity-add-value! "cause" "varchar" v) '())) (vert
(mtoggle-button "gp-alarm-join" "Did the others join in?" (mtext "text" "Cause")
(lambda (v) (spinner (make-id "gp-alarm-cause") (list "Predator" "Other mongoose pack" "Humans" "Other" "Unknown") fillwrap
(entity-add-value! "others-join" "varchar" (lambda (v)
(if v "yes" "no")) '()))) (entity-add-value! "cause" "varchar" v) '())))
(tri-state "gp-alarm-join" "Did the others join in?" "others-join")))
(horiz (horiz
(mbutton "pf-grpalarm-done" "Done" (mbutton "pf-grpalarm-done" "Done"
(lambda () (lambda ()
...@@ -960,7 +1037,7 @@ ...@@ -960,7 +1037,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gp-alarm-caller" "single" "gp-alarm-caller" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack) #t
(lambda (individual) (lambda (individual)
(entity-add-value! "id-caller" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-caller" "varchar" (ktv-get individual "unique_id"))
(list)))) (list))))
...@@ -990,7 +1067,7 @@ ...@@ -990,7 +1067,7 @@
(list (list
(vert (vert
(mtext "" "Direction") (mtext "" "Direction")
(spinner (make-id "gp-mov-to") (list "To" "From") fillwrap (spinner (make-id "gp-mov-dir") (list "To" "From") fillwrap
(lambda (v) (entity-add-value! "direction" "varchar" v) '()))) (lambda (v) (entity-add-value! "direction" "varchar" v) '())))
(vert (vert
...@@ -1017,7 +1094,7 @@ ...@@ -1017,7 +1094,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gp-mov-leader" "single" "gp-mov-leader" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack) #t
(lambda (individual) (lambda (individual)
(entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-leader" "varchar" (ktv-get individual "unique_id"))
(list))) (list)))
...@@ -1051,7 +1128,10 @@ ...@@ -1051,7 +1128,10 @@
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-reset!) (entity-reset!)
(force-pause)) (append
(force-pause)
(list
(update-widget 'edit-text (get-id "note-text") 'request-focus 1))))
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -1089,7 +1169,7 @@ ...@@ -1089,7 +1169,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-start-present" "toggle" "gc-start-present" "toggle"
(db-mongooses-by-pack) (db-mongooses-by-pack) #f
(lambda (individual) (lambda (individual)
(lambda (v) (entity-add-value! "group-comp-code" "varchar" v) '())) (lambda (v) (entity-add-value! "group-comp-code" "varchar" v) '()))
...@@ -1134,7 +1214,7 @@ ...@@ -1134,7 +1214,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-weigh-choose" "single" "gc-weigh-choose" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack) #f
(lambda (individual) (lambda (individual)
(msg "loading") (msg "loading")
(entity-add-value! "id-mongoose" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-mongoose" "varchar" (ktv-get individual "unique_id"))
...@@ -1173,7 +1253,7 @@ ...@@ -1173,7 +1253,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-preg-choose" "toggle" "gc-preg-choose" "toggle"
(db-mongooses-by-pack-female) (db-mongooses-by-pack-female) #f
(lambda (individual) (lambda (individual)
(list))) (list)))
)) ))
...@@ -1208,11 +1288,11 @@ ...@@ -1208,11 +1288,11 @@
(lambda (fragment arg) (lambda (fragment arg)
(list (list
(populate-grid-selector "gc-pup-choose" "toggle" (populate-grid-selector "gc-pup-choose" "toggle"
(db-mongooses-by-pack-pups) (db-mongooses-by-pack-pups) #f
(lambda (individual) (lambda (individual)
(list))) (list)))
(populate-grid-selector "gc-pup-escort" "toggle" (populate-grid-selector "gc-pup-escort" "toggle"
(db-mongooses-by-pack-adults) (db-mongooses-by-pack-adults) #t
(lambda (individual) (lambda (individual)
(list))) (list)))
)) ))
...@@ -1246,12 +1326,12 @@ ...@@ -1246,12 +1326,12 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-oestrus-female" "single" "gc-oestrus-female" "single"
(db-mongooses-by-pack-female) (db-mongooses-by-pack-female) #f
(lambda (individual) (lambda (individual)
(list))) (list)))
(populate-grid-selector (populate-grid-selector
"gc-oestrus-guard" "single" "gc-oestrus-guard" "single"
(db-mongooses-by-pack-male) (db-mongooses-by-pack-male) #f
(lambda (individual) (lambda (individual)
)))) ))))
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -1340,7 +1420,7 @@ ...@@ -1340,7 +1420,7 @@
(update-entity (update-entity
db "local" 1 (list (ktv "user-id" "varchar" v))))) db "local" 1 (list (ktv "user-id" "varchar" v)))))
(mtext "foo" "Database") (mtext "foo" "Database")
(mbutton2 "main-sync" "Sync" (lambda () (list (start-activity "sync" 0 ""))))) (mbutton2 "main-sync" "Sync database" (lambda () (list (start-activity "sync" 0 "")))))
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
...@@ -1429,7 +1509,7 @@ ...@@ -1429,7 +1509,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"choose-obs-pack-selector" "single" "choose-obs-pack-selector" "single"
(db-all db "sync" "pack") (db-all db "sync" "pack") #f
(lambda (pack) (lambda (pack)
(msg "in selector" pack) (msg "in selector" pack)
(set-current! 'pack pack) (set-current! 'pack pack)
...@@ -1482,7 +1562,7 @@ ...@@ -1482,7 +1562,7 @@
(medit-text "pf1-count" "How many mongooses can you see?" "numeric" (medit-text "pf1-count" "How many mongooses can you see?" "numeric"
(lambda (v) (entity-add-value! "pack-count" "int" v) '())) (lambda (v) (entity-add-value! "pack-count" "int" v) '()))
(horiz (horiz
(mbutton2 "choose-obs-back" "Back" (lambda () (list (finish-activity 1)))) (mbutton2 "pf1-back" "Back" (lambda () (list (finish-activity 1))))
(mbutton2 "pf1-done" "Done" (mbutton2 "pf1-done" "Done"
(lambda () (lambda ()
(cond (cond
...@@ -1506,7 +1586,7 @@ ...@@ -1506,7 +1586,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"pf1-grid" "single" "pf1-grid" "single"
(db-mongooses-by-pack-pups) (db-mongooses-by-pack-pups) #f
(lambda (individual) (lambda (individual)
(set-current! 'individual individual) (set-current! 'individual individual)
(entity-add-value! "id-focal-subject" "varchar" (ktv-get individual "unique_id")) (entity-add-value! "id-focal-subject" "varchar" (ktv-get individual "unique_id"))
...@@ -1568,7 +1648,7 @@ ...@@ -1568,7 +1648,7 @@
(number->string (get-current 'timer-seconds 60))) (number->string (get-current 'timer-seconds 60)))
(delayed "timer" 1000 timer-cb))) (delayed "timer" 1000 timer-cb)))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) (list (delayed "timer" 1000 (lambda () '())))) (lambda (activity) '())
(lambda (activity) (list (delayed "timer" 1000 (lambda () '())))) (lambda (activity) (list (delayed "timer" 1000 (lambda () '()))))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity requestcode resultcode) '())) (lambda (activity requestcode resultcode) '()))
...@@ -1599,14 +1679,16 @@ ...@@ -1599,14 +1679,16 @@
(vert (vert
(text-view (make-id "title") "Manage packs" 40 fillwrap) (text-view (make-id "title") "Manage packs" 40 fillwrap)
(build-grid-selector "manage-packs-list" "button" "Choose pack") (build-grid-selector "manage-packs-list" "button" "Choose pack")
(mbutton2 "manage-packs-new" "New pack" (lambda () (list (start-activity "new-pack" 2 "")))) (horiz
(mbutton2 "choose-obs-back" "Back" (lambda () (list (finish-activity 1))))
(mbutton2 "manage-packs-new" "New pack" (lambda () (list (start-activity "new-pack" 2 "")))))
) )
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(list (list
(populate-grid-selector (populate-grid-selector
"manage-packs-list" "button" (db-all db "sync" "pack") "manage-packs-list" "button" (db-all db "sync" "pack") #f
(lambda (pack) (lambda (pack)
(set-current! 'pack pack) (set-current! 'pack</