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
citizen-science
symbai
Commits
3ba3f7ee
Commit
3ba3f7ee
authored
Jul 09, 2014
by
Dave Griffiths
Browse files
first/family name on lists and search photos
parent
d4fecbf6
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
44 additions
and
22 deletions
+44
-22
android/assets/dbsync.scm
android/assets/dbsync.scm
+21
-6
android/assets/starwisp.scm
android/assets/starwisp.scm
+23
-16
No files found.
android/assets/dbsync.scm
View file @
3ba3f7ee
...
...
@@ -803,7 +803,7 @@
;; a standard builder for list widgets of entities and a
;; make new button, to add defaults to the list
(
define
(
build-list-widget
db
table
title
entity-type
edit-activity
parent-fn
ktv-default-fn
)
(
define
(
build-list-widget
db
table
title
title-ids
entity-type
edit-activity
parent-fn
ktv-default-fn
)
(
vert-colour
colour-two
(
horiz
...
...
@@ -818,7 +818,7 @@
(
ktvlist-merge
(
ktv-default-fn
)
(
list
(
ktv
"parent"
"varchar"
(
parent-fn
)))))
(
list
(
update-list-widget
db
table
entity-type
edit-activity
(
parent-fn
))))))
(
list
(
update-list-widget
db
table
title-ids
entity-type
edit-activity
(
parent-fn
))))))
(
linear-layout
(
make-id
(
string-append
entity-type
"-list"
))
'vertical
...
...
@@ -826,13 +826,28 @@
(
list
0
0
0
0
)
(
list
))))
(
define
(
make-list-widget-title
e
title-ids
)
(
if
(
eqv?
(
length
title-ids
)
1
)
(
ktv-get
e
(
car
title-ids
))
(
string-append
(
ktv-get
e
(
car
title-ids
))
"\n"
(
foldl
(
lambda
(
id
r
)
(
if
(
equal?
r
""
)
(
ktv-get
e
id
)
(
string-append
r
" "
(
ktv-get
e
id
))))
""
(
cdr
title-ids
)))))
;; pull db data into list of button widgets
(
define
(
update-list-widget
db
table
entity-type
edit-activity
parent
)
(
define
(
update-list-widget
db
table
title-ids
entity-type
edit-activity
parent
)
(
let
((
search-results
(
if
parent
(
db-filter-only
db
table
entity-type
(
list
(
list
"parent"
"varchar"
"="
parent
))
(
list
(
list
"name"
"varchar"
)))
(
map
(
lambda
(
id
)
(
list
id
"varchar"
))
title-ids
))
(
db-all
db
table
entity-type
))))
(
update-widget
'linear-layout
...
...
@@ -844,8 +859,8 @@
(
lambda
(
e
)
(
button
(
make-id
(
string-append
"list-button-"
(
ktv-get
e
"unique_id"
)))
(
or
(
ktv-get
e
"name"
)
"Unamed item"
)
4
0
(
layout
'fill-parent
'wrap-content
1
'centre
5
)
(
make-list-widget-title
e
title-ids
)
3
0
(
layout
'fill-parent
'wrap-content
1
'centre
5
)
(
lambda
()
(
list
(
start-activity
edit-activity
0
(
ktv-get
e
"unique_id"
))))))
search-results
)))))
...
...
android/assets/starwisp.scm
View file @
3ba3f7ee
...
...
@@ -484,6 +484,10 @@
(
inexact->exact
(
round
(
*
256
0.9
)))))
(
define
(
make-photo-button-title
e
)
(
string-append
(
ktv-get
e
"name"
)
"\n"
(
ktv-get
e
"first-name"
)
" "
(
ktv-get
e
"family"
)))
(
define
(
build-photo-buttons
search
)
(
grid-ify
(
map
...
...
@@ -496,7 +500,7 @@
((
>
(
length
search
)
500
)
(
button
(
make-id
(
string-append
"chooser-"
id
))
(
ktv-get
e
"name"
)
3
0
(
layout
(
car
button-size
)
(
/
(
cadr
button-size
)
3
)
1
'centre
5
)
(
make-photo-button-title
e
)
2
0
(
layout
(
car
button-size
)
(
/
(
cadr
button-size
)
3
)
1
'centre
5
)
(
lambda
()
(
set-current!
'choose-result
id
)
(
list
(
finish-activity
0
)))))
...
...
@@ -504,7 +508,7 @@
((
equal?
image
"face"
)
(
button
(
make-id
(
string-append
"chooser-"
id
))
(
ktv-get
e
"name"
)
3
0
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
make-photo-button-title
e
)
2
0
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
lambda
()
(
set-current!
'choose-result
id
)
(
list
(
finish-activity
0
)))))
...
...
@@ -517,7 +521,7 @@
(
lambda
()
(
set-current!
'choose-result
id
)
(
list
(
finish-activity
0
))))
(
text-view
0
(
ktv-get
e
"name"
)
20
(
layout
'wrap-content
'wrap-content
-1
'centre
0
)))
(
text-view
0
(
make-photo-button-title
e
)
20
(
layout
'wrap-content
'wrap-content
-1
'centre
0
)))
))))
search
)
3
))
...
...
@@ -538,7 +542,10 @@
(
ktv-get
household
"unique_id"
))))
(
list
(
list
"photo"
"file"
)
(
list
"name"
"varchar"
)))))
(
list
"name"
"varchar"
)
(
list
"first-name"
"varchar"
)
(
list
"family"
"varchar"
)
))))
(
list
(
delayed
"filter-delayed"
100
gradual-build
)
(
update-widget
...
...
@@ -825,7 +832,7 @@
(
mbutton-scale
'find-individual
(
lambda
()
(
list
(
start-activity
"individual-chooser"
choose-code
""
)))))
(
build-list-widget
db
"sync"
'households
"household"
"household"
(
lambda
()
(
get-setting-value
"current-village"
))
db
"sync"
'households
(
list
"name"
)
"household"
"household"
(
lambda
()
(
get-setting-value
"current-village"
))
(
lambda
()
(
let
((
name
;; if it's the first household - change the id...
...
...
@@ -880,7 +887,7 @@
(
number->string
(
car
loc
))
", "
(
number->string
(
cadr
loc
)))))))
(
update-list-widget
db
"sync"
"household"
"household"
(
get-setting-value
"current-village"
))))))
db
"sync"
(
list
"name"
)
"household"
"household"
(
get-setting-value
"current-village"
))))))
(
alog
"end main start"
)
r
))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -907,7 +914,7 @@
(
cadr
(
list-ref
(
get-current
'villages-list
'
())
v
)))
'
()))
(
build-list-widget
db
"sync"
'villages
"village"
"village"
(
lambda
()
#f
)
db
"sync"
'villages
(
list
"name"
)
"village"
"village"
(
lambda
()
#f
)
(
lambda
()
village-ktvlist
)))
...
...
@@ -925,7 +932,7 @@
(
find-index-from-name-array
(
get-current
'villages-list
'
())
(
get-current
'village
#f
)))
(
update-list-widget
db
"sync"
"village"
"village"
#f
))))
(
update-list-widget
db
"sync"
(
list
"name"
)
"village"
"village"
#f
))))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -996,7 +1003,7 @@
"household-list"
(
build-activity
(
build-list-widget
db
"sync"
'households
"household"
"household"
(
lambda
()
(
get-current
'village
#f
))
db
"sync"
'households
(
list
"name"
)
"household"
"household"
(
lambda
()
(
get-current
'village
#f
))
(
lambda
()
;; autogenerate the name from the current ID
(
ktvlist-merge
...
...
@@ -1013,7 +1020,7 @@
(
append
(
update-top-bar
)
(
list
(
update-list-widget
db
"sync"
"household"
"household"
arg
))))
db
"sync"
(
list
"name"
)
"household"
"household"
arg
))))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
...
...
@@ -1040,7 +1047,7 @@
(
build-list-widget
db
"sync"
'individuals
"individual"
"individual"
db
"sync"
'individuals
(
list
"name"
"first-name"
"family"
)
"individual"
"individual"
(
lambda
()
(
get-current
'household
#f
))
(
lambda
()
(
let
((
photo-id
(
get/inc-setting
"photo-id"
))
...
...
@@ -1073,7 +1080,7 @@
(
append
(
update-top-bar
)
(
list
(
update-list-widget
db
"sync"
"individual"
"individual"
arg
)
(
update-list-widget
db
"sync"
(
list
"name"
"first-name"
"family"
)
"individual"
"individual"
arg
)
(
mupdate
'edit-text
'num-pots
"num-pots"
)
(
mupdate
'edit-text
'num-children
"num-children"
))
(
mupdate-gps
'house
"house"
)
...
...
@@ -1387,7 +1394,7 @@
(
mspinner
'hire-land
yesno-list
(
lambda
(
v
)
(
entity-set-value!
"hire-land"
"varchar"
(
spinner-choice
yesno-list
v
))
'
())))
(
mtext
'crops-detail
)
(
build-list-widget
db
"sync"
'crops
"crop"
"crop"
(
lambda
()
(
get-current
'individual
#f
))
db
"sync"
'crops
(
list
"name"
)
"crop"
"crop"
(
lambda
()
(
get-current
'individual
#f
))
(
lambda
()
crop-ktvlist
))
(
mspinner-other
'house-type
house-type-list
(
lambda
(
v
)
(
entity-set-value!
"house-type"
"varchar"
(
spinner-choice
house-type-list
v
))
'
()))
...
...
@@ -1415,7 +1422,7 @@
(
update-top-bar
)
(
mupdate-spinner-other
'house-type
"house-type"
house-type-list
)
(
list
(
update-list-widget
db
"sync"
"crop"
"crop"
(
get-current
'individual
#f
))
(
update-list-widget
db
"sync"
(
list
"name"
)
"crop"
"crop"
(
get-current
'individual
#f
))
(
mupdate-spinner
'occupation-agriculture
"occupation-agriculture"
yesno-list
)
(
mupdate-spinner
'occupation-gathering
"occupation-gathering"
yesno-list
)
(
mupdate-spinner
'occupation-labour
"occupation-labour"
yesno-list
)
...
...
@@ -1513,7 +1520,7 @@
(
build-person-selector
'mother
"id-mother"
(
list
)
mother-request-code
)
(
build-person-selector
'father
"id-father"
(
list
)
father-request-code
))
(
build-list-widget
db
"sync"
'children
"child"
"child"
(
lambda
()
(
get-current
'individual
#f
))
db
"sync"
'children
(
list
"name"
)
"child"
"child"
(
lambda
()
(
get-current
'individual
#f
))
(
lambda
()
child-ktvlist
))
(
mbutton
'gene-next
(
lambda
()
(
list
(
start-activity
"friendship"
0
""
))))
(
spacer
20
))
...
...
@@ -1525,7 +1532,7 @@
(
entity-init!
db
"sync"
"individual"
(
get-entity-by-unique
db
"sync"
(
get-current
'individual
#f
)))
(
append
(
update-top-bar
)
(
list
(
update-list-widget
db
"sync"
"child"
"child"
(
get-current
'individual
#f
)))
(
list
(
update-list-widget
db
"sync"
(
list
"name"
)
"child"
"child"
(
get-current
'individual
#f
)))
(
update-person-selector
db
"sync"
'mother
"id-mother"
)
(
update-person-selector
db
"sync"
'father
"id-father"
)))
(
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