Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Dave Griffiths
mongoose-2000
Commits
5cc16103
Commit
5cc16103
authored
Jun 25, 2014
by
Dave Griffiths
Browse files
fixed loads of group comp stuff
parent
2ed59d11
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
46 additions
and
24 deletions
+46
-24
android/assets/mongoose.scm
android/assets/mongoose.scm
+1
-8
android/assets/starwisp.scm
android/assets/starwisp.scm
+45
-16
No files found.
android/assets/mongoose.scm
View file @
5cc16103
...
...
@@ -713,7 +713,6 @@
(
mbutton
(
string-append
id
"-nextb"
)
"Next"
(
lambda
()
(
msg
"update from next button"
)
(
entity-update-values!
)
(
append
(
fn
)
...
...
@@ -729,7 +728,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(
define
(
update-selector-colours
id
entity-type
where
)
(
msg
"update-selector-colours"
)
(
update-grid-selector-colours
id
"id-mongoose"
(
db-filter
...
...
@@ -739,7 +737,6 @@
where
))))
(
define
(
update-selector-colours2
id
entity-type
where
)
(
msg
"update-selector-colours 2"
)
(
update-grid-selector-colours
id
"id-escort"
(
db-filter
...
...
@@ -749,7 +746,6 @@
where
))))
(
define
(
update-selector-colours3
id
entity-type
)
(
msg
"update-selector-colours 3"
)
(
update-grid-selector-colours
id
"id-mongoose"
(
db-filter
...
...
@@ -758,10 +754,7 @@
(
list
"parent"
"varchar"
"="
(
get-current
'group-composition-id
0
))))))
(
define
(
invert-mongoose-selection
individuals
)
(
msg
"invert-mongoose-selection"
)
(
msg
individuals
)
(
filter
(
lambda
(
m
)
(
msg
m
)
(
dbg
(
not
(
in-list?
m
individuals
))))
(
not
(
in-list?
m
individuals
)))
(
map
(
lambda
(
m
)
(
ktv-get
m
"unique_id"
))
(
db-mongooses-by-pack
))))
android/assets/starwisp.scm
View file @
5cc16103
...
...
@@ -503,15 +503,17 @@
(
mtitle
"title"
"Start"
)
(
horiz
(
mtoggle-button
"gc-start-main-obs"
"I'm the main observer"
(
lambda
(
v
)
(
entity-set-value!
"main-observer"
"varchar"
v
)
'
()))
(
lambda
(
v
)
(
entity-update-single-value!
(
ktv
"main-observer"
"varchar"
v
))
'
()))
(
vert
(
mtext
""
"Code"
)
(
edit-text
(
make-id
"gc-start-code"
)
""
30
"numeric"
fillwrap
(
lambda
(
v
)
(
entity-set-value!
"group-comp-code"
"varchar"
v
)
'
()))))
(
lambda
(
v
)
(
entity-update-values!
(
ktv
"group-comp-code"
"varchar"
v
))
'
()))))
(
build-grid-selector
"gc-start-present"
"toggle"
"Who's present?"
)
(
next-button
"gc-start-"
"Go to weighing, have you finished here?"
"gc-start"
"gc-weights"
(
lambda
()
(
set-current!
'gc-not-present
(
dbg
(
invert-mongoose-selection
(
string-split-simple
(
entity-get-value
"present"
)
#
\
,
)))
)
(
set-current!
'gc-not-present
(
invert-mongoose-selection
(
string-split-simple
(
entity-get-value
"present"
)
#
\
,
)))
(
entity-update-values!
)
'
()))
))
...
...
@@ -520,6 +522,7 @@
(
activity-layout
fragment
))
(
lambda
(
fragment
arg
)
;; in case we come back from weights...
(
msg
"frag start:"
(
get-current
'group-composition-id
#f
))
(
entity-init!
db
"stream"
"group-composition"
(
get-entity-by-unique
db
"stream"
(
get-current
'group-composition-id
#f
)))
...
...
@@ -531,7 +534,9 @@
(
lambda
(
individuals
)
(
entity-set-value!
"present"
"varchar"
(
assemble-array
individuals
))
(
list
))
(
get-current
'gc-not-present
'
())))
;; need to invert, but not () if there are none set yet...
(
let
((
r
(
get-current
'gc-not-present
#f
)))
(
if
(
not
r
)
'
()
(
invert-mongoose-selection
r
)))))
(
update-grid-selector-checked
"gc-start-present"
"present"
))
)
(
lambda
(
fragment
)
'
())
...
...
@@ -592,7 +597,7 @@
(
list
(
update-widget
'edit-text
(
get-id
"gc-weigh-weight"
)
'text
(
if
(
null?
s
)
""
(
ktv-get
(
car
s
)
"weight"
)))
(
update-widget
'toggle-button
(
get-id
"gc-weigh-accurate"
)
'
sel
ec
t
ed
(
update-widget
'toggle-button
(
get-id
"gc-weigh-accurate"
)
'
ch
ec
k
ed
(
if
(
null?
s
)
0
(
ktv-get
(
car
s
)
"accurate"
))))
(
update-selector-colours
"gc-weigh-choose"
"weight"
(
list
"weight"
"real"
"!="
0
)))))))
(
update-grid-selector-enabled
"gc-weigh-choose"
(
get-current
'gc-not-present
'
()))
...
...
@@ -753,7 +758,14 @@
(
lambda
(
v
)
(
msg
"updating acc"
)
(
entity-update-single-value!
(
ktv
"accurate"
"varchar"
(
spinner-choice
list-strength
v
)))
'
()))))
'
())))
(
mtoggle-button
"gc-oestrus-pester"
"Pestering?"
(
lambda
(
v
)
(
entity-update-single-value!
(
ktv
"pester"
"int"
(
if
v
1
0
)))
'
()))
)
(
build-grid-selector
"gc-oestrus-guard"
"toggle"
"Choose mate guard"
)
(
next-button
"gc-pup-oestrus-"
"Going to babysitters, have you finished here?"
"gc-pup-assoc"
"gc-babysitting"
(
lambda
()
'
()))))
...
...
@@ -793,13 +805,15 @@
(
ktv
"id-escort"
"varchar"
(
ktv-get
escort-individual
"unique_id"
))
(
ktv
"accurate"
"varchar"
"none"
)
(
ktv
"strength"
"varchar"
"none"
)
(
ktv
"pester"
"int"
0
)
(
ktv
"parent"
"varchar"
(
get-current
'group-composition-id
0
))
(
ktv
"id-mongoose"
"varchar"
(
ktv-get
pup-individual
"unique_id"
))))
(
entity-init!
db
"stream"
"mate-guard"
(
car
s
)))
(
append
(
list
(
update-widget
'spinner
(
get-id
"gc-oestrus-strength"
)
'selection
(
spinner-index
list-strength
(
entity-get-value
"strength"
)))
(
update-widget
'spinner
(
get-id
"gc-oestrus-accuracy"
)
'selection
(
spinner-index
list-strength
(
entity-get-value
"accurate"
))))
(
update-widget
'spinner
(
get-id
"gc-oestrus-accuracy"
)
'selection
(
spinner-index
list-strength
(
entity-get-value
"accurate"
)))
(
update-widget
'toggle-button
(
get-id
"gc-oestrus-pester"
)
'checked
(
entity-get-value
"pester"
)))
(
update-selector-colours2
"gc-oestrus-guard"
"mate-guard"
...
...
@@ -875,7 +889,11 @@
(
list
(
mtitle
""
"Finish group composition"
)
(
next-button
"gc-pup-baby-"
"Ending, have you finished here?"
"gc-babysitting"
"gc-end"
(
lambda
()
(
list
(
finish-activity
0
))))))
(
lambda
()
;; clean up...
(
get-current
'gc-not-present
'
())
(
set-current!
'group-composition-id
#f
)
(
list
(
finish-activity
0
))))))
(
lambda
(
fragment
arg
)
(
activity-layout
fragment
))
(
lambda
(
fragment
arg
)
...
...
@@ -1012,13 +1030,18 @@
((
eq?
(
get-current
'observation
"none"
)
obs-gp
)
(
list
(
start-activity
"group-events"
2
""
)))
(
else
;; create a new gc entity
;; initialise it to the current memory entity
(
set-current!
'group-composition-id
(
entity-init&save!
db
"stream"
"group-composition"
(
list
(
ktv
"pack"
"varchar"
(
ktv-get
(
get-current
'pack
())
"unique_id"
)))))
;; check if there is currently a gc activity active
(
msg
"gc id = "
(
get-current
'group-composition-id
#f
))
(
when
(
not
(
get-current
'group-composition-id
#f
))
(
msg
"making new gc"
)
;; create a new gc entity
;; initialise it to the current memory entity
(
set-current!
'group-composition-id
(
entity-init&save!
db
"stream"
"group-composition"
(
list
(
ktv
"pack"
"varchar"
(
ktv-get
(
get-current
'pack
())
"unique_id"
))))))
(
list
(
start-activity
"group-composition"
2
""
))))
(
list
...
...
@@ -1035,7 +1058,13 @@
"choose-obs-pack-selector"
"single"
(
db-all-sort-normal
db
"sync"
"pack"
)
#f
(
lambda
(
pack
)
(
msg
"in selector"
pack
)
(
when
(
and
(
get-current
'pack
#f
)
;; if we have a current pack...
(
not
(
equal?
(
ktv-get
pack
"unique_id"
)
(
ktv-get
(
get-current
'pack
'
())
"unique_id"
))))
;; need to clear the current group comp
;; id here if we are changing the pack
(
set-current!
'group-composition-id
#f
))
(
set-current!
'pack
pack
)
'
()))))
(
lambda
(
activity
)
'
())
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment