Skip to content

GitLab

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
Hide whitespace changes
Inline Side-by-side
Showing with 287 additions and 217 deletions
android/AndroidManifest.xml
View file @ 2f311bcb
......@@ -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>
......
android/assets/lib.scm
View file @ 2f311bcb
......@@ -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)
......
android/assets/starwisp.scm
View file @ 2f311bcb
......@@ -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"