Commit 2f311bcb authored by Dave Griffiths's avatar Dave Griffiths
Browse files

activity back stack fixed, colours on bgs, version for ESI demo meeting

parent 7bd24289
......@@ -10,22 +10,18 @@
>
<activity android:name="starwisp"
android:noHistory="true"
android:label="@string/app_name">
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
<activity android:name="MainActivity"></activity>
<activity android:name="ObservationsActivity"></activity>
<activity android:name="ObservationActivity"></activity>
<activity android:name="IndividualSelectActivity"></activity>
<activity android:name="PupFocalActivity"></activity>
<activity android:name="PupFocalEventActivity"></activity>
<activity android:name="EventSelfActivity"></activity>
<activity android:name="EventFedActivity"></activity>
<activity android:name="EventAggressionActivity"></activity>
<activity android:name="ObservationActivity" android:noHistory="true"></activity>
<activity android:name="IndividualSelectActivity" android:noHistory="true"></activity>
<activity android:name="PupFocalActivity" android:noHistory="true"></activity>
<activity android:name="EventSelfActivity" android:noHistory="true"></activity>
<activity android:name="ManagePacksActivity"></activity>
<activity android:name="NewPackActivity"></activity>
<activity android:name="ManageIndividualActivity"></activity>
......
......@@ -334,12 +334,13 @@
(define (widget-type w) (list-ref w 0))
(define (widget-id w) (list-ref w 1))
(define (linear-layout id orientation layout children)
(list "linear-layout" id orientation layout children))
(define (linear-layout id orientation layout colour children)
(list "linear-layout" id orientation layout colour children))
(define (linear-layout-id t) (list-ref t 1))
(define (linear-layout-orientation t) (list-ref t 2))
(define (linear-layout-layout t) (list-ref t 3))
(define (linear-layout-children t) (list-ref t 4))
(define (linear-layout-colour t) (list-ref t 4))
(define (linear-layout-children t) (list-ref t 5))
;;(define (grid-layout id cols orientation layout children)
;; (list "grid-layout" id cols orientation layout children))
......@@ -517,16 +518,16 @@
(define (horiz . l)
(linear-layout
(make-id "xv")
'horizontal
0 'horizontal
(layout 'fill-parent 'fill-parent 1 'left)
(list 0 0 0 0)
l))
(define (vert . l)
(linear-layout
(make-id "xv")
'vertical
0 'vertical
(layout 'fill-parent 'fill-parent 1 'left)
(list 0 0 0 0)
l))
(define (activity name layout on-create on-start on-resume on-pause on-stop on-destroy on-activity-result)
......
......@@ -18,6 +18,19 @@
(define obs-gc "Group Composition")
(define obs-pf "Pup Focal")
(define obs-gp "Group Events")
;; colours
(define pf-col (list 22 19 178 96))
(define gp-col (list 255 236 0 96))
(define gc-col (list 255 97 0 96))
;(define gc-col (list 0 176 96 64))
;(define pf-col (list 226 0 72 64))
;(define gp-col (list 255 144 0 64))
(define trans-col (list 0 0 0 0))
(define (get-fragment-index name frag)
(define (_ i l)
......@@ -203,13 +216,13 @@
(button (make-id id) title 20 fillwrap fn))
(define (mbutton2 id title fn)
(button (make-id id) title 20 (layout 100 100 1 'centre) fn))
(button (make-id id) title 20 (layout 150 100 1 'centre) fn))
(define (mtoggle-button id title fn)
(toggle-button (make-id id) title 20 fillwrap fn))
(define (mtoggle-button2 id title fn)
(toggle-button (make-id id) title 20 (layout 100 100 1 'centre) fn))
(toggle-button (make-id id) title 20 (layout 150 100 1 'centre) fn))
(define (mtext id text)
(text-view (make-id id) text 20 fillwrap))
......@@ -256,7 +269,7 @@
(list
(linear-layout
(make-id name) 'horizontal
(layout 'wrap-content 'wrap-content 1 'centre)
(layout 'wrap-content 'wrap-content 1 'centre) trans-col
(list
(button-grid (make-id name) type 3 20 (layout 100 40 1 'left)
(list) (lambda (v) '()))))))
......@@ -296,7 +309,7 @@
(fragment
"pf-timer"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(mtitle "title" "Time left: 20 mins")
(mtitle "title" "Next scan: 60 secs")
......@@ -313,26 +326,35 @@
(fragment
"pf-events"
"events"
(linear-layout
(make-id "") 'vertical fillwrap
0 'vertical fillwrap trans-col
(list
(mtext "text" "Pup Focal Events")
(horiz
(mbutton2 "evb-pupfeed" "Pup Feed" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupfeed"))))
(mbutton2 "evb-pupfind" "Pup Find" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupfind"))))
(mbutton2 "evb-pupcare" "Pup Care" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupcare"))))
(mbutton2 "evb-pupagg" "Pup Aggression" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupaggr")))))
(mtext "text" "Group Events")
(horiz
(mbutton2 "evb-grpint" "Interaction" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpint"))))
(mbutton2 "evb-grpalarm" "Pup Find" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpalarm"))))
(mbutton2 "evb-grpmov" "Pup Care" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpmov")))))
))
(mtitle "ev-pf-text" "Pup Focal Events")
(linear-layout
(make-id "ev-pf") 'horizontal fill pf-col
(list
(mbutton2 "evb-pupfeed" "Pup Feed" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupfeed"))))
(mbutton2 "evb-pupfind" "Pup Find" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupfind"))))
(mbutton2 "evb-pupcare" "Pup Care" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupcare"))))
(mbutton2 "evb-pupagg" "Pup Aggression" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-pupaggr"))))))
(mtitle "text" "Group Events")
(linear-layout
0 'horizontal fill gp-col
(list
(mbutton2 "evb-grpint" "Interaction" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpint"))))
(mbutton2 "evb-grpalarm" "Alarm" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpalarm"))))
(mbutton2 "evb-grpmov" "Movement" (lambda () (list (replace-fragment (get-id "pf-bot") "ev-grpmov"))))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(list))
(if (equal? (get-current 'observation "none") obs-gp)
(list
(update-widget 'text-view (get-id "ev-pf-text") 'hide 0)
(update-widget 'linear-layout (get-id "ev-pf") 'hide 0))
(list
(update-widget 'text-view (get-id "ev-pf-text") 'show 0)
(update-widget 'linear-layout (get-id "ev-pf") 'show 0))))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
......@@ -341,10 +363,11 @@
(fragment
"pf-scan1"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(build-grid-selector "pf-scan-nearest" "single" "Nearest neighbour scan: Closest Mongoose")
(build-grid-selector "pf-scan-close" "toggle" "Nearest neighbour scan: Mongooses within 2m")
(mtext "title" "Nearest Neighbour Scan")
(build-grid-selector "pf-scan-nearest" "single" "Closest Mongoose")
(build-grid-selector "pf-scan-close" "toggle" "Mongooses within 2m")
(mbutton "pf-scan-done" "Done" (lambda () (list (replace-fragment (get-id "pf-top") "pf-timer"))))))
(lambda (fragment arg)
......@@ -373,14 +396,14 @@
(fragment
"ev-pupfeed"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(mtitle "title" "Pup is fed")
(mtitle "title" "Event: Pup is fed")
(build-grid-selector "pf-pupfeed-who" "single" "Who fed the pup?")
(mtext "text" "Food size")
(horiz
(spinner (make-id "pf-pupfeed-size") (list "Small" "Medium" "Large") fillwrap (lambda (v) '()))
(mbutton "pf-pupfeed-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "pf-events")))))))
(mbutton "pf-pupfeed-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -401,13 +424,13 @@
(fragment
"ev-pupfind"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(mtitle "title" "Pup found food")
(mtitle "title" "Event: Pup found food")
(mtext "text" "Food size")
(horiz
(spinner (make-id "pf-pupfind-size") (list "Small" "Medium" "Large") fillwrap (lambda (v) '()))
(mbutton "pf-pupfind-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "pf-events")))))))
(mbutton "pf-pupfind-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -423,14 +446,14 @@
(fragment
"ev-pupcare"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(mtitle "title" "Pup is cared for")
(mtitle "title" "Event: Pup is cared for")
(build-grid-selector "pf-pupcare-who" "single" "Who cared for the pup?")
(mtext "text" "Type of care")
(horiz
(spinner (make-id "pf-pupcare-type") (list "Carry" "Lead" "Sniff" "Play" "Ano-genital sniff") fillwrap (lambda (v) '()))
(mbutton "pf-scan-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "pf-events")))))))
(mbutton "pf-scan-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -451,13 +474,13 @@
(fragment
"ev-pupaggr"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap pf-col
(list
(mtitle "title" "Pup aggression")
(mtitle "title" "Event: Pup aggression")
(build-grid-selector "pf-pupaggr-partner" "single" "Aggressive mongoose")
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 100 '1 'left)
(make-id "") 'horizontal (layout 'fill-parent 100 '1 'left) trans-col
(list
(vert
(mtext "" "Fighting over")
......@@ -467,7 +490,7 @@
(spinner (make-id "pf-pupaggr-level") (list "Block" "Snap" "Chase" "Push" "Fight") fillwrap (lambda (v) '())))
(mtoggle-button "pf-pupaggr-in" "Initiate?" (lambda (v) '()))
(mtoggle-button "pf-pupaggr-win" "Win?" (lambda (v) '()))))
(mbutton "pf-scan-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "pf-events"))))))
(mbutton "pf-pupaggr-done" "Done" (lambda () (list (replace-fragment (get-id "pf-bot") "events"))))))
(lambda (fragment arg)
(activity-layout fragment))
......@@ -485,13 +508,126 @@
(lambda (fragment) '())
(lambda (fragment) '()))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(fragment
"ev-grpint"
(linear-layout
(make-id "") 'vertical fillwrap gp-col
(list
(mtitle "title" "Event: Group Interaction")
(build-grid-selector "gp-int-pack" "single" "Inter-group interaction: Other pack identity")
(build-grid-selector "gp-int-leader" "single" "Leader")
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 80 '1 'left) trans-col
(list
(vert
(mtext "text" "Outcome")
(spinner (make-id "gp-int-out") (list "Retreat" "Advance" "Fight & retreat" "Fight & win") fillwrap (lambda (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"))))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(list
(populate-grid-selector
"gp-int-pack" "single"
(db-all db "sync" "pack")
(lambda (individual)
(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)
(list)))
))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '()))
(fragment
"ev-grpalarm"
(linear-layout
(make-id "") 'vertical fillwrap gp-col
(list
(mtitle "title" "Event: Group alarm")
(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"))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(list
(populate-grid-selector
"gp-alarm-caller" "single"
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(list)))
))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '()))
(fragment
"ev-grpmov"
(linear-layout
(make-id "") 'vertical fillwrap gp-col
(list
(mtitle "title" "Event: Group movement")
(build-grid-selector "gp-mov-leader" "single" "Leader")
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 90 '1 'left) 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) '()))))
(linear-layout
(make-id "") 'horizontal (layout 'fill-parent 90 '1 'left) 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"))))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg)
(list
(populate-grid-selector
"gp-mov-leader" "single"
(db-all-where db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(list)))
))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '()))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(fragment
"gc-start"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtitle "title" "Start")
(mtoggle-button "gc-start-main-obs" "Main observer" (lambda (v) '()))
......@@ -518,7 +654,7 @@
(fragment
"gc-weights"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtitle "title" "Weights")
(build-grid-selector "gc-weigh-choose" "toggle" "Choose mongoose")
......@@ -545,7 +681,7 @@
(fragment
"gc-preg"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtitle "title" "Pregnant females")
(build-grid-selector "gc-preg-choose" "toggle" "Choose")))
......@@ -571,9 +707,9 @@
(fragment
"gc-pup-assoc"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtitle "title" "Pregnant females")
(mtitle "title" "Pup Associations")
(build-grid-selector "gc-pup-choose" "toggle" "Choose pup")
(build-grid-selector "gc-pup-escort" "toggle" "Escort")))
......@@ -604,7 +740,7 @@
(fragment
"gc-oestrus"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtext "" "Oestrus...")))
(lambda (fragment arg)
......@@ -619,7 +755,7 @@
(fragment
"gc-babysitting"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtext "" "Babysittings...")))
(lambda (fragment arg)
......@@ -634,7 +770,7 @@
(fragment
"gc-end"
(linear-layout
(make-id "") 'vertical fillwrap
(make-id "") 'vertical fillwrap gc-col
(list
(mtext "" "end!...")))
(lambda (fragment arg)
......@@ -656,44 +792,24 @@
;; activities
(define-activity-list
(activity
"splash"
(vert
(text-view (make-id "splash-title") "Mongoose 2000" 40 fillwrap)
(mtext "splash-about" "Advanced mongoose technology")
(spacer 20)
(mbutton "f2" "Get started!" (lambda () (list (start-activity-goto "main" 2 ""))))
(button-grid (make-id "bg") "toggle" 3 20 (layout 100 40 1 'left)
(list) (lambda (v) (msg v) '()))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(list
(update-widget
'button-grid (get-id "bg") 'grid-buttons
(list
"toggle" 3 20 (layout 100 40 1 'left)
(list
(list (make-id "1") "one")
(list (make-id "2") "two")
(list (make-id "3") "three")
(list (make-id "4") "four")
(list (make-id "5") "five")
(list (make-id "6") "six")
(list (make-id "7") "seven")
(list (make-id "8") "eight")
(list (make-id "9") "nine")
(list (make-id "10") "ten")
)
(lambda (v) (msg "updated" v) '())))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity requestcode resultcode) '()))
; (activity
; "splash"
; (vert
; (text-view (make-id "splash-title") "Mongoose 2000" 40 fillwrap)
; (mtext "splash-about" "Advanced mongoose technology")
; (spacer 20)
; (mbutton2 "f2" "Get started!" (lambda () (list (start-activity-goto "main" 2 ""))))
; )
;
; (lambda (activity arg)
; (activity-layout activity))
; (lambda (activity arg)
; (list))
; (lambda (activity) '())
; (lambda (activity) '())
; (lambda (activity) '())
; (lambda (activity) '())
; (lambda (activity requestcode resultcode) '()))
(activity
......@@ -736,14 +852,27 @@
(vert
(mtext "type" "Choose observation type")
(horiz
(mtoggle-button2 "choose-obs-gc" obs-gc
(lambda (v)
(set-current! 'observation obs-gc)
(mclear-toggles (list "choose-obs-pf"))))
(mtoggle-button2 "choose-obs-pf" obs-pf
(lambda (v)
(set-current! 'observation obs-pf)
(mclear-toggles (list "choose-obs-gc"))))))
(linear-layout
0 'vertical wrap gc-col
(list
(mtoggle-button2 "choose-obs-gc" obs-gc
(lambda (v)
(set-current! 'observation obs-gc)
(mclear-toggles (list "choose-obs-pf" "choose-obs-gp"))))))
(linear-layout
0 'vertical wrap pf-col
(list
(mtoggle-button2 "choose-obs-pf" obs-pf
(lambda (v)
(set-current! 'observation obs-pf)
(mclear-toggles (list "choose-obs-gc" "choose-obs-gp"))))))
(linear-layout
0 'vertical wrap gp-col
(list
(mtoggle-button2 "choose-obs-gp" obs-gp
(lambda (v)
(set-current! 'observation obs-gp)
(mclear-toggles (list "choose-obs-pf" "choose-obs-gc"))))))))
(build-grid-selector "choose-obs-pack-selector" "single" "Choose pack")
(mbutton
"choose-obs-start" "Start"
......@@ -755,14 +884,18 @@
'observation-fragments
(cond
((equal? obs obs-gc) gc-fragments)
((equal? obs obs-pf) '())))))
(else '())))))
;; go to observation
(if (and (current-exists? 'pack)
(current-exists? 'observation))
(if (eq? (get-current 'observation "none") obs-pf)
(list (start-activity "individual-select" 2 ""))
(list (start-activity "observation" 2 "")))
(cond
((eq? (get-current 'observation "none") obs-pf)
(list (start-activity-goto "individual-select" 2 "")))
((eq? (get-current 'observation "none") obs-gp)
(list (start-activity-goto "event-self" 2 "")))
(else
(list (start-activity-goto "observation" 2 ""))))
(list
(alert-dialog
"choose-obs-finish"
......@@ -787,16 +920,17 @@
(lambda (activity requestcode resultcode) '()))
(activity
"observation"
(vert
(text-view (make-id "obs-title") "" 40 fillwrap)
(linear-layout
(make-id "obs-buttons-bar") 'horizontal fillwrap '())
(view-pager
(make-id "obs-container") (layout 'wrap-content 700 1 'left) '())
(mbutton "obs-done" "Done" (lambda () '())))
"observation" ;; group-composition
(linear-layout
0 'vertical fillwrap gc-col
(list
(text-view (make-id "obs-title") "" 40 fillwrap)
(linear-layout
(make-id "obs-buttons-bar") 'horizontal fillwrap trans-col '())
(view-pager
(make-id "obs-container") (layout 'wrap-content 700 1 'left) '())
(mbutton "obs-done" "Done" (lambda () (list (finish-activity 0))))))
(lambda (activity arg)
(activity-layout activity))
......@@ -840,19 +974,21 @@
(activity
"individual-select" ;; pup focal #1
(vert
(mtitle "" "Pup focal setup")
(mtext "pf1-pack" "Pack")
(build-grid-selector "pf1-grid" "single" "Select pup")
(horiz
(medit-text "pf1-width" "Pack width" 20 "numeric" (lambda (v) '()))
(medit-text "pf1-height" "Pack height" 20 "numeric" (lambda (v) '())))
(medit-text "pf1-count" "How many mongooses present?" 20 "numeric" (lambda (v) '()))
(mbutton "pf1-done" "Done"