Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
citizen-science
symbai
Commits
fb4b99fd
Commit
fb4b99fd
authored
Apr 11, 2014
by
Dave Griffiths
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
quick add and fixed entity pollution with lists
parent
fad42368
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
114 additions
and
65 deletions
+114
-65
android/assets/dbsync.scm
android/assets/dbsync.scm
+29
-23
android/assets/eavdb.scm
android/assets/eavdb.scm
+15
-0
android/assets/starwisp.scm
android/assets/starwisp.scm
+70
-42
No files found.
android/assets/dbsync.scm
View file @
fb4b99fd
...
...
@@ -105,6 +105,7 @@
(
entity-add-value-create!
key
type
value
)))
(
msg
"done entity-set-value!"
)))
(
define
(
date-time->string
dt
)
(
string-append
(
number->string
(
list-ref
dt
0
))
"-"
...
...
@@ -120,23 +121,26 @@
(
table
(
get-current
'table
#f
))
(
type
(
get-current
'entity-type
#f
)))
;; standard bits
(
entity-add-value-create!
"user"
"varchar"
(
get-current
'user-id
"none"
))
(
entity-add-value-create!
"time"
"varchar"
(
date-time->string
(
date-time
)))
(
entity-add-value-create!
"lat"
"real"
(
car
(
get-current
'location
'
(
0
0
))))
(
entity-add-value-create!
"lon"
"real"
(
cadr
(
get-current
'location
'
(
0
0
))))
(
entity-add-value-create!
"deleted"
"int"
0
)
(
let
((
values
(
get-current
'entity-values
'
())))
(
cond
((
not
(
null?
values
))
(
let
((
r
(
insert-entity/get-unique
db
table
type
(
get-current
'user-id
"no id"
)
values
)))
(
msg
"inserted a "
type
)
(
entity-reset!
)
r
))
(
else
(
msg
"no values to add as entity!"
)
#f
)))
;; just to be on the safe side
(
entity-reset!
)))
(
let
((
r
(
entity-create!
db
table
type
(
get-current
'entity-values
'
()))))
(
entity-reset!
)
r
)))
(
define
(
entity-create!
db
table
entity-type
ktv-list
)
(
let
((
values
(
append
(
list
(
ktv-create
"user"
"varchar"
(
get-current
'user-id
"none"
))
(
ktv-create
"time"
"varchar"
(
date-time->string
(
date-time
)))
(
ktv-create
"lat"
"real"
(
car
(
get-current
'location
'
(
0
0
))))
(
ktv-create
"lon"
"real"
(
cadr
(
get-current
'location
'
(
0
0
))))
(
ktv-create
"deleted"
"int"
0
))
ktv-list
)))
(
let
((
r
(
insert-entity/get-unique
db
table
entity-type
(
get-current
'user-id
"no id"
)
values
)))
(
msg
"entity-create: "
entity-type
)
r
)))
(
define
(
entity-update-values!
)
(
let
((
db
(
get-current
'db
#f
))
...
...
@@ -603,8 +607,8 @@
(
define
(
do-gps
display-id
key-prepend
)
(
let
((
loc
(
get-current
'location
'
(
0
0
))))
(
entity-
add
-value
-create
!
(
string-append
key-prepend
"-lat"
)
"real"
(
car
loc
))
(
entity-
add
-value
-create
!
(
string-append
key-prepend
"-lon"
)
"real"
(
cadr
loc
))
(
entity-
set
-value!
(
string-append
key-prepend
"-lat"
)
"real"
(
car
loc
))
(
entity-
set
-value!
(
string-append
key-prepend
"-lon"
)
"real"
(
cadr
loc
))
(
list
(
update-widget
'text-view
...
...
@@ -641,9 +645,11 @@
(
mtext-lookup
'add-item-to-list
)
40
(
layout
100
'wrap-content
1
'centre
5
)
(
lambda
()
(
entity-init!
db
table
entity-type
ktv-default
)
(
entity-add-value-create!
"parent"
"varchar"
(
parent-fn
))
(
entity-record-values!
)
(
entity-create!
db
table
entity-type
(
ktvlist-merge
ktv-default
(
list
(
ktv
"parent"
"varchar"
(
parent-fn
)))))
(
list
(
update-list-widget
db
table
entity-type
edit-activity
(
parent-fn
))))))
(
linear-layout
(
make-id
(
string-append
entity-type
"-list"
))
...
...
@@ -686,7 +692,7 @@
(
lambda
(
v
)
(
cond
((
eqv?
v
1
)
(
entity-
add
-value!
"deleted"
"int"
1
)
(
entity-
set
-value!
"deleted"
"int"
1
)
(
entity-update-values!
)
(
list
(
finish-activity
1
)))
(
else
...
...
android/assets/eavdb.scm
View file @
fb4b99fd
...
...
@@ -66,6 +66,21 @@
(
msg
"unsupported ktv type in ktv-eq?: "
(
ktv-type
a
))
#f
))))
;; replace or insert a ktv
(
define
(
ktvlist-replace
ktv
ktvlist
)
(
cond
((
null?
ktvlist
)
(
list
ktv
))
((
equal?
(
ktv-key
(
car
ktvlist
))
(
ktv-key
ktv
))
(
cons
ktv
(
cdr
ktvlist
)))
(
else
(
cons
(
car
ktvlist
)
(
ktvlist-replace
ktv
(
cdr
ktvlist
))))))
(
define
(
ktvlist-merge
a
b
)
(
foldl
(
lambda
(
ktv
r
)
(
ktvlist-replace
ktv
r
))
a
b
))
;; stringify based on type (for url)
(
define
(
stringify-value
ktv
)
(
cond
...
...
android/assets/starwisp.scm
View file @
fb4b99fd
...
...
@@ -85,7 +85,9 @@
(
list
'delete-are-you-sure
(
list
"Are you sure you want to delete this?"
))
(
list
'save-are-you-sure
(
list
"Are you sure you want to save changes?"
))
;; filter
;; individual filter
(
list
'quick-name
(
list
"New person name"
))
(
list
'quick-add
(
list
"Quick add"
))
(
list
'find-individual
(
list
"Find individual"
))
(
list
'filter
(
list
"Filter"
))
(
list
'off
(
list
"Off"
"Off"
"Off"
))
...
...
@@ -249,6 +251,48 @@
(
list
'sex
(
list
"Sex"
))
))
(
define
individual-ktvlist
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-individual-name
))
(
ktv-create
"family"
"varchar"
(
mtext-lookup
'default-family-name
))
(
ktv-create
"photo-id"
"varchar"
(
mtext-lookup
'default-photo-id
))
(
ktv-create
"photo"
"file"
"none"
)
(
ktv-create
"tribe"
"varchar"
"none"
)
(
ktv-create
"subtribe"
"varchar"
"none"
)
(
ktv-create
"child"
"int"
0
)
(
ktv-create
"age"
"int"
0
)
(
ktv-create
"gender"
"varchar"
"Female"
)
(
ktv-create
"education"
"varchar"
"none"
)
(
ktv-create
"head-of-house"
"varchar"
"none"
)
(
ktv-create
"marital-status"
"varchar"
"none"
)
(
ktv-create
"times-married"
"int"
0
)
(
ktv-create
"id-spouse"
"varchar"
"none"
)
(
ktv-create
"children-living"
"int"
0
)
(
ktv-create
"children-dead"
"int"
0
)
(
ktv-create
"children-together"
"int"
0
)
(
ktv-create
"children-apart"
"int"
0
)
(
ktv-create
"residence-after-marriage"
"varchar"
"none"
)
(
ktv-create
"num-siblings"
"int"
0
)
(
ktv-create
"birth-order"
"int"
0
)
(
ktv-create
"length-time"
"int"
0
)
(
ktv-create
"place-of-birth"
"varchar"
"none"
)
(
ktv-create
"num-residence-changes"
"int"
0
)
(
ktv-create
"village-visits-month"
"int"
0
)
(
ktv-create
"village-visits-year"
"int"
0
)
(
ktv-create
"occupation"
"varchar"
"none"
)
(
ktv-create
"contribute"
"int"
0
)
(
ktv-create
"own-land"
"int"
0
)
(
ktv-create
"rent-land"
"int"
0
)
(
ktv-create
"hire-land"
"int"
0
)
(
ktv-create
"house-type"
"varchar"
"none"
)
(
ktv-create
"loan"
"int"
0
)
(
ktv-create
"earning"
"int"
0
)
(
ktv-create
"radio"
"int"
0
)
(
ktv-create
"tv"
"int"
0
)
(
ktv-create
"mobile"
"int"
0
)
(
ktv-create
"visit-market"
"int"
0
)
(
ktv-create
"town-sell"
"int"
0
)
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
...
...
@@ -664,47 +708,7 @@
(
build-list-widget
db
"sync"
'individuals
"individual"
"individual"
(
lambda
()
(
get-current
'household
#f
))
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-individual-name
))
(
ktv-create
"family"
"varchar"
(
mtext-lookup
'default-family-name
))
(
ktv-create
"photo-id"
"varchar"
(
mtext-lookup
'default-photo-id
))
(
ktv-create
"photo"
"file"
"none"
)
(
ktv-create
"tribe"
"varchar"
"none"
)
(
ktv-create
"subtribe"
"varchar"
"none"
)
(
ktv-create
"child"
"int"
0
)
(
ktv-create
"age"
"int"
0
)
(
ktv-create
"gender"
"varchar"
"Female"
)
(
ktv-create
"education"
"varchar"
"none"
)
(
ktv-create
"head-of-house"
"varchar"
"none"
)
(
ktv-create
"marital-status"
"varchar"
"none"
)
(
ktv-create
"times-married"
"int"
0
)
(
ktv-create
"id-spouse"
"varchar"
"none"
)
(
ktv-create
"children-living"
"int"
0
)
(
ktv-create
"children-dead"
"int"
0
)
(
ktv-create
"children-together"
"int"
0
)
(
ktv-create
"children-apart"
"int"
0
)
(
ktv-create
"residence-after-marriage"
"varchar"
"none"
)
(
ktv-create
"num-siblings"
"int"
0
)
(
ktv-create
"birth-order"
"int"
0
)
(
ktv-create
"length-time"
"int"
0
)
(
ktv-create
"place-of-birth"
"varchar"
"none"
)
(
ktv-create
"num-residence-changes"
"int"
0
)
(
ktv-create
"village-visits-month"
"int"
0
)
(
ktv-create
"village-visits-year"
"int"
0
)
(
ktv-create
"occupation"
"varchar"
"none"
)
(
ktv-create
"contribute"
"int"
0
)
(
ktv-create
"own-land"
"int"
0
)
(
ktv-create
"rent-land"
"int"
0
)
(
ktv-create
"hire-land"
"int"
0
)
(
ktv-create
"house-type"
"varchar"
"none"
)
(
ktv-create
"loan"
"int"
0
)
(
ktv-create
"earning"
"int"
0
)
(
ktv-create
"radio"
"int"
0
)
(
ktv-create
"tv"
"int"
0
)
(
ktv-create
"mobile"
"int"
0
)
(
ktv-create
"visit-market"
"int"
0
)
(
ktv-create
"town-sell"
"int"
0
)
))
individual-ktvlist
)
(
delete-button
))
(
lambda
(
activity
arg
)
...
...
@@ -1038,6 +1042,30 @@
"individual-chooser"
(
build-activity
(
vert
(
horiz
(
medit-text
'quick-name
"normal"
(
lambda
(
v
)
(
set-current!
'chooser-quick-name
v
)
'
()))
(
mbutton-scale
'quick-add
(
lambda
()
(
list
(
alert-dialog
"quick-add-check"
(
mtext-lookup
'add-are-you-sure
)
(
lambda
(
v
)
(
cond
((
eqv?
v
1
)
(
set-current!
'choose-result
(
entity-create!
db
"sync"
"individual"
(
ktvlist-merge
individual-ktvlist
(
list
(
ktv
"name"
"varchar"
(
get-current
'chooser-quick-name
(
mtext-lookup
'no-name
)))
(
ktv
"parent"
"varchar"
(
get-current
'household
#f
))))))
(
list
(
finish-activity
0
))))))))))
(
linear-layout
(
make-id
"choose-pics"
)
'vertical
(
layout
'fill-parent
'wrap-content
0.75
'centre
0
)
...
...
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