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
nebogeo
symbai
Commits
526b6b82
Commit
526b6b82
authored
Apr 15, 2014
by
Dave Griffiths
Browse files
big sync fixed
parent
9cbd5a22
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
346 additions
and
86 deletions
+346
-86
android/assets/dbsync.scm
android/assets/dbsync.scm
+197
-1
android/assets/eavdb.scm
android/assets/eavdb.scm
+42
-19
android/assets/lib.scm
android/assets/lib.scm
+3
-0
android/assets/starwisp.scm
android/assets/starwisp.scm
+104
-66
No files found.
android/assets/dbsync.scm
View file @
526b6b82
...
...
@@ -334,7 +334,9 @@
(
get-entity-id
db
table
unique-id
))))
;; if we don't have this entity or the version on the server is newer
(
if
(
or
(
not
exists
)
old
)
(
if
(
and
(
or
(
not
exists
)
old
)
;; limit this to 5 a time
(
<
(
length
r
)
5
))
(
cons
(
suck-entity-from-server
db
table
unique-id
)
r
)
r
)))
'
()
...
...
@@ -723,3 +725,197 @@
(
list
(
finish-activity
1
)))
(
else
(
list
)))))))))
(
define
vowel
(
map
symbol->string
(
list
'a
'e
'i
'o
'u
)))
(
define
consonant
(
map
symbol->string
(
list
'b
'c
'd
'f
'g
'h
'j
'k
'l
'm
'n
'p
'q
'r
's
't
'v
'w
'x
'y
'z
)))
(
define
(
word-gen
)
(
define
(
_
s
vowel-prob
)
(
cond
((
zero?
s
)
'
())
((
<
(
random
)
vowel-prob
)
(
cons
(
choose
vowel
)
(
_
(
-
s
1
)
(
/
vowel-prob
2
))))
(
else
(
cons
(
choose
consonant
)
(
_
(
-
s
1
)
(
*
vowel-prob
2
))))))
(
apply
string-append
(
_
(
+
3
(
random-int
8
))
0.5
)))
(
define
(
simpsons-village
db
table
default-ktvlist
)
(
entity-create!
db
table
"village"
(
ktvlist-merge
default-ktvlist
(
list
(
ktv
"name"
"varchar"
(
word-gen
))
(
ktv
"block"
"varchar"
(
word-gen
))
(
ktv
"district"
"varchar"
(
word-gen
))
(
ktv
"car"
"int"
(
random-int
2
))))))
(
define
(
simpsons-household
db
table
parent
default-ktvlist
)
(
entity-create!
db
table
"household"
(
ktvlist-merge
default-ktvlist
(
list
(
ktv
"name"
"varchar"
(
word-gen
))
(
ktv
"num-pots"
"int"
(
random-int
10
))
(
ktv
"parent"
"varchar"
parent
)))))
(
define
(
simpsons-individual
db
table
parent
default-ktvlist
)
(
let
((
n
(
random-int
1000
)))
(
entity-create!
db
table
"individual"
(
ktvlist-merge
default-ktvlist
(
append
(
list
(
ktv
"parent"
"varchar"
parent
))
(
choose
(
list
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Abe-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"abe.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Akira-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"akira.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Apu-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"apu.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Barney-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"barney.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Bart-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"bartsimpson.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Billy-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"billy.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Carl-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"carl.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Cletus-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"cletus.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"ComicBookGuy-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"comicbookguy.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Homer-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"homersimpson.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Jasper-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"jasper.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Kent-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"kentbrockman.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Kodos-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"kodos.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Lenny-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"lenny.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Lisa-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Female"
)
(
ktv-create
"photo"
"file"
"lisasimpson.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Marge-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Female"
)
(
ktv-create
"photo"
"file"
"margesimpson.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Martin-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"martinprince.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Milhouse-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"milhouse.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"MrBurns-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"mrburns.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Ned-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"nedflanders.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Nelson-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"nelson.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Otto-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"otto.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Ralph-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"ralphwiggum.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"Santaslittlehelper-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"santaslittlehelper.jpg"
))
(
list
(
ktv-create
"name"
"varchar"
(
string-append
"SideshowBob-"
(
number->string
n
)))
(
ktv-create
"gender"
"varchar"
"Male"
)
(
ktv-create
"photo"
"file"
"sideshowbob.jpg"
)))))))))
(
define
(
looper!
n
fn
)
(
when
(
not
(
zero?
n
))
(
fn
n
)
(
looper!
(
-
n
1
)
fn
)))
(
msg
(
random-int
100
))
(
define
(
build-test!
db
table
village-ktvlist
household-ktvlist
individual-ktvlist
)
(
looper!
3
(
lambda
(
i
)
(
msg
"making village"
i
)
(
let
((
village
(
simpsons-village
db
table
village-ktvlist
)))
(
looper!
8
(
lambda
(
i
)
(
alog
"household"
)
(
msg
"making household"
i
)
(
let
((
household
(
simpsons-household
db
table
village
household-ktvlist
)))
(
looper!
(
random-int
30
)
(
lambda
(
i
)
(
msg
"making individual"
i
)
(
simpsons-individual
db
table
household
individual-ktvlist
))))))))))
android/assets/eavdb.scm
View file @
526b6b82
...
...
@@ -185,7 +185,6 @@
;; update the value given an entity type, a attribute type and it's key (= attriute_id)
;; creates the value if it doesn't already exist, updates it otherwise if it's different
(
define
(
update-value
db
table
entity-id
ktv
)
(
msg
"update-value"
)
(
let
((
s
(
select-first
db
(
string-append
"select value from "
table
"_value_"
(
ktv-type
ktv
)
" where entity_id = ? and attribute_id = ?"
)
...
...
@@ -195,7 +194,6 @@
;; only update if they are different
(
if
(
not
(
ktv-eq?
ktv
(
list
(
ktv-key
ktv
)
(
ktv-type
ktv
)
s
)))
(
begin
(
msg
"incrementing value version in update-value"
)
(
db-exec
db
(
string-append
"update "
table
"_value_"
(
ktv-type
ktv
)
" set value=?, dirty=1, version=version+1 where entity_id = ? and attribute_id = ?"
)
...
...
@@ -211,7 +209,7 @@
(
if
(
null?
s
)
(
insert-value
db
table
entity-id
ktv
#t
)
(
begin
(
msg
"actually updating (fs)"
(
ktv-key
ktv
)
"to"
(
ktv-value
ktv
))
;;
(msg "actually updating (fs)" (ktv-key ktv) "to" (ktv-value ktv))
(
db-exec
db
(
string-append
"update "
table
"_value_"
(
ktv-type
ktv
)
" set value=?, dirty=0, version=? where entity_id = ? and attribute_id = ?"
)
...
...
@@ -270,7 +268,7 @@
(
let
((
vdv
(
get-value
db
table
entity-id
kt
)))
(
if
(
null?
vdv
)
(
begin
(
msg
"ERROR: get-entity-plain: no value found for "
entity-id
" "
(
ktv-key
kt
))
;;
(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r
)
(
cons
(
list
(
ktv-key
kt
)
(
ktv-type
kt
)
(
list-ref
vdv
0
)
(
list-ref
vdv
2
))
r
))))
...
...
@@ -279,23 +277,19 @@
;; get an entire entity, as a list of key/value pairs, only dirty values
(
define
(
get-entity-plain-for-sync
db
table
entity-id
)
(
msg
"gepfs"
)
(
let*
((
entity-type
(
get-entity-type
db
table
entity-id
)))
(
cond
((
null?
entity-type
)
(
msg
"entity"
entity-id
"not found!"
)
'
())
(
else
(
foldl
(
lambda
(
kt
r
)
(
msg
kt
)
(
let
((
vdv
(
get-value
db
table
entity-id
kt
)))
(
msg
vdv
)
(
cond
((
null?
vdv
)
(
msg
"ERROR: get-entity-plain-for-sync: no value found for "
entity-id
" "
(
ktv-key
kt
))
;;
(msg "ERROR: get-entity-plain-for-sync: no value found for " entity-id " " (ktv-key kt))
r
)
;; only return if dirty
((
not
(
zero?
(
cadr
vdv
)))
(
msg
"value-dirty-version found"
vdv
)
(
cons
(
list
(
ktv-key
kt
)
(
ktv-type
kt
)
(
list-ref
vdv
0
)
(
list-ref
vdv
2
))
r
))
...
...
@@ -310,6 +304,24 @@
(
list
"unique_id"
"varchar"
unique-id
)
(
get-entity-plain
db
table
entity-id
))))
;; like get-entity-plain, but only look for specific key/types - for speed
(
define
(
get-entity-only
db
table
entity-id
kt-list
)
(
let
((
unique-id
(
get-unique-id
db
table
entity-id
)))
(
cons
(
list
"unique_id"
"varchar"
unique-id
)
(
foldl
(
lambda
(
kt
r
)
(
let
((
vdv
(
get-value
db
table
entity-id
kt
)))
(
if
(
null?
vdv
)
(
begin
;;(msg "ERROR: get-entity-plain: no value found for " entity-id " " (ktv-key kt))
r
)
(
cons
(
list
(
ktv-key
kt
)
(
ktv-type
kt
)
(
list-ref
vdv
0
)
(
list-ref
vdv
2
))
r
))))
'
()
kt-list
))))
(
define
(
all-entities
db
table
type
)
(
let
((
s
(
db-select
db
(
string-append
"select e.entity_id from "
table
"_entity as e "
...
...
@@ -468,6 +480,13 @@
(
get-entity
db
table
i
))
(
filter-entities
db
table
type
filter
)))
;; only return name and photo
(
define
(
db-filter-only
db
table
type
filter
kt-list
)
(
map
(
lambda
(
i
)
(
get-entity-only
db
table
i
kt-list
))
(
filter-entities
db
table
type
filter
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
...
...
@@ -479,7 +498,6 @@
;; auto update version
(
define
(
update-entity
db
table
entity-id
ktvlist
)
(
msg
"update-entity"
)
;; dirty
(
update-entity-changed
db
table
entity-id
)
(
update-entity-values
db
table
entity-id
ktvlist
#t
))
...
...
@@ -490,7 +508,6 @@
entity-id
(
ktv-key
kt
)))
(
define
(
clean-entity-values
db
table
entity-id
)
(
msg
"clean-entity-values"
)
(
let*
((
entity-type
(
get-entity-type
db
table
entity-id
)))
(
cond
((
null?
entity-type
)
...
...
@@ -498,14 +515,13 @@
(
else
(
for-each
(
lambda
(
kt
)
(
msg
"cleaning"
kt
)
(
clean-value
db
table
entity-id
(
list
(
ktv-key
kt
)
(
ktv-type
kt
))))
(
get-attribute-ids/types
db
table
entity-type
))))))
;; update an entity, via a (possibly partial) list of key/value pairs
;; if dirty is not true, this is coming from a sync
(
define
(
update-entity-values
db
table
entity-id
ktvlist
dirty
)
(
msg
"update-entity-values"
)
;;
(msg "update-entity-values")
(
let*
((
entity-type
(
get-entity-type
db
table
entity-id
)))
(
cond
((
null?
entity-type
)
(
msg
"entity"
entity-id
"not found!"
)
'
())
...
...
@@ -568,15 +584,21 @@
version
entity-id
))
(
define
(
update-entity-clean
db
table
unique-id
)
(
msg
"cleaning"
)
;;
(msg "cleaning")
;; clean entity table
(
db-exec
db
(
string-append
"update "
table
"_entity set dirty=? where unique_id = ?"
)
0
unique-id
)
;; clean value tables for this entity
(
msg
"cleaning values"
)
;;
(msg "cleaning values")
(
clean-entity-values
db
table
(
entity-id-from-unique
db
table
unique-id
))
)
(
define
(
have-dirty?
db
table
)
(
not
(
zero?
(
select-first
db
(
string-append
"select count(entity_id) from "
table
"_entity where dirty=1"
)))))
(
define
(
get-dirty-stats
db
table
)
(
list
(
select-first
...
...
@@ -589,17 +611,18 @@
(
define
(
dirty-entities
db
table
)
(
let
((
de
(
db-select
db
(
string-append
"select entity_id, entity_type, unique_id, dirty, version from "
table
"_entity where dirty=1;"
))))
"select entity_id, entity_type, unique_id, dirty, version from "
table
"_entity where dirty=1 limit 5;"
))))
(
msg
de
)
(
if
(
null?
de
)
'
()
(
map
(
lambda
(
i
)
(
msg
"dirty
-entities"
)
(
msg
"dirty
:"
(
vector-ref
i
2
)
)
(
list
;; build according to url ([table] entity-type unique-id dirty version)
(
cdr
(
vector->list
i
))
;; data entries (todo - only dirty values!)
(
dbg
(
get-entity-plain-for-sync
db
table
(
vector-ref
i
0
)))))
(
get-entity-plain-for-sync
db
table
(
vector-ref
i
0
))))
(
cdr
de
)))))
;; todo: BROKEN...
...
...
android/assets/lib.scm
View file @
526b6b82
...
...
@@ -269,6 +269,9 @@
(
define
random
(
random-maker
19781116
))
;; another arbitrarily chosen birthday
(
define
(
random-int
n
)
(
abs
(
random
n
)))
(
define
rndf
random
)
(
define
(
rndvec
)
(
vector
(
rndf
)
(
rndf
)
(
rndf
)))
...
...
android/assets/starwisp.scm
View file @
526b6b82
...
...
@@ -303,9 +303,24 @@
(
list
'weekly
(
list
"Weekly"
))
(
list
'monthly
(
list
"Monthly"
))
(
list
'less
(
list
"Less"
))
))
(
define
village-ktvlist
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-village-name
))
(
ktv-create
"block"
"varchar"
""
)
(
ktv-create
"district"
"varchar"
"test"
)
(
ktv-create
"car"
"int"
0
)))
(
define
household-ktvlist
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-household-name
))
(
ktv-create
"num-pots"
"int"
0
)
(
ktv-create
"house-lat"
"real"
0
)
;; get from current location?
(
ktv-create
"house-lon"
"real"
0
)
(
ktv-create
"toilet-lat"
"real"
0
)
(
ktv-create
"toilet-lon"
"real"
0
)))
(
define
individual-ktvlist
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-individual-name
))
...
...
@@ -371,10 +386,10 @@
(
append
(
list
(
toast
"sync-cb"
))
(
upload-dirty
db
)
(
suck-new
db
"sync"
)))))
(
if
(
have-dirty?
db
"sync"
)
'
()
(
suck-new
db
"sync"
)))))
)
(
else
'
()))
(
list
(
delayed
"debug-timer"
(
+
1
0000
(
random
5000
))
debug-timer-cb
)
(
delayed
"debug-timer"
(
+
3
0000
(
random
5000
))
debug-timer-cb
)
(
update-debug
))))
...
...
@@ -544,40 +559,61 @@
(
define
(
update-individual-filter
)
(
update-widget
'linear-layout
(
get-id
"choose-pics"
)
'contents
(
grid-ify
(
map
(
lambda
(
e
)
(
let*
((
id
(
ktv-get
e
"unique_id"
))
(
image-name
(
ktv-get
e
"photo"
))
(
image
(
if
(
image-invalid?
image-name
)
"face"
(
string-append
"/sdcard/symbai/files/"
image-name
))))
(
if
(
equal?
image
"face"
)
(
let
((
search
(
db-filter-only
db
"sync"
"individual"
(
filter-get
)
(
list
(
list
"photo"
"file"
)
(
list
"name"
"varchar"
)))))
(
update-widget
'linear-layout
(
get-id
"choose-pics"
)
'contents
(
grid-ify
(
map
(
lambda
(
e
)
(
let*
((
id
(
ktv-get
e
"unique_id"
))
(
image-name
(
ktv-get
e
"photo"
))
(
image
(
if
(
image-invalid?
image-name
)
"face"
(
string-append
"/sdcard/symbai/files/"
image-name
))))
(
cond
((
>
(
length
search
)
50
)
(
button
(
make-id
(
string-append
"chooser-"
id
))
(
ktv-get
e
"name"
)
30
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
ktv-get
e
"name"
)
30
(
layout
(
car
button-size
)
(
/
(
cadr
button-size
)
3
)
1
'centre
5
)
(
lambda
()
(
set-current!
'choose-result
id
)
(
list
(
finish-activity
0
))))
(
image-button
(
list
(
finish-activity
0
)))))
((
equal?
image
"face"
)
(
button
(
make-id
(
string-append
"chooser-"
id
))
image
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
ktv-get
e
"name"
)
30
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
lambda
()
(
set-current!
'choose-result
id
)
(
list
(
finish-activity
0
)))))))
(
db-filter
db
"sync"
"individual"
(
filter-get
)))
3
)))
(
list
(
finish-activity
0
)))))
(
define
(
image-from-unique-id
db
table
unique-id
)
(
else
(
vert
(
image-button
(
make-id
(
string-append
"chooser-"
id
))
image
(
layout
(
car
button-size
)
(
cadr
button-size
)
1
'centre
5
)
(
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
)))
))))
search
)
3
))))
(
define
(
image/name-from-unique-id
db
table
unique-id
)
(
let
((
e
(
get-entity-by-unique
db
table
unique-id
)))
(
ktv-get
e
"photo"
)))
(
list
(
ktv-get
e
"name"
)
(
ktv-get
e
"photo"
))))
(
define
(
build-person-selector
id
key
filter
request-code
)
(
vert
(
mtitle
id
)
(
image-view
(
make-id
(
string-append
(
symbol->string
id
)
"-image"
))
"face"
(
layout
240
320
-1
'centre
0
))
(
mtext-small
(
string->symbol
(
string-append
(
symbol->string
id
)
"-text"
)))
(
button
(
make-id
(
string-append
"change-"
(
symbol->string
id
)))
(
mtext-lookup
'change-id
)
...
...
@@ -591,6 +627,7 @@
(
mtitle
id
)
(
image-view
(
make-id
(
string-append
(
symbol->string
id
)
"-image"
))
"face"
(
layout
120
160
-1
'centre
0
))
(
mtext-small
(
string->symbol
(
string-append
(
symbol->string
id
)
"-text"
)))
(
button
(
make-id
(
string-append
"change-"
(
symbol->string
id
)))
(
mtext-lookup
'change-id
)
...
...
@@ -611,12 +648,18 @@
(
msg
"update-person-selector"
key
)
(
let
((
entity-id
(
entity-get-value
key
)))
(
msg
"entity-id is"
entity-id
)
(
let
((
image-name
(
image-from-unique-id
db
table
entity-id
))
(
id
(
get-id
(
string-append
(
symbol->string
id
)
"-image"
))))
(
msg
"image-name is"
image-name
)
(
if
(
image-invalid?
image-name
)
(
update-widget
'image-view
id
'image
"face"
)
(
update-widget
'image-view
id
'external-image
(
string-append
dirname
"files/"
image-name
))))))
(
let
((
image-name
(
image/name-from-unique-id
db
table
entity-id
))
(
id
(
get-id
(
string-append
(
symbol->string
id
)
"-image"
)))
(
text-id
(
get-id
(
string-append
(
symbol->string
id
)
"-text"
))))
(
msg
"image-name is"
(
cadr
image-name
)
(
image-invalid?
(
cadr
image-name
)))
(
if
(
image-invalid?
(
cadr
image-name
))
(
list
(
update-widget
'image-view
id
'image
"face"
)
(
update-widget
'text-view
text-id
'text
(
car
image-name
)))
(
list
(
update-widget
'text-view
text-id
'text
(
car
image-name
))
(
update-widget
'image-view
id
'external-image
(
string-append
dirname
"files/"
(
cadr
image-name
))))))))
(
define
(
build-social-connection
id
key
type
request-code
)
(
let
((
id-text
(
string-append
(
symbol->string
id
))))
...
...
@@ -650,20 +693,21 @@
(
define
(
update-social-connection
db
table
id
key
type
request-code
)
(
let
((
id-text
(
string-append
(
symbol->string
id
))))
(
list
(
append
(
update-person-selector
db
table
id
key
)
(
mupdate-spinner-other
(
string->symbol
(
string-append
id-text
"-relationship"
))
(
string-append
key
"-relationship"
)
social-relationship-list
)
(
mupdate-spinner-other
(
string->symbol
(
string-append
id-text
"-residence"
))
(
string-append
key
"-residence"
)
social-residence-list
)
(
mupdate-spinner
(
string->symbol
(
dbg
(
string-append
id-text
"-strength"
)))
(
string-append
key
"-strength"
)
social-strength-list
)
(
list
(
mupdate-spinner-other
(
string->symbol
(
string-append
id-text
"-relationship"
))
(
string-append
key
"-relationship"
)
social-relationship-list
)
(
mupdate-spinner-other
(
string->symbol
(
string-append
id-text
"-residence"
))
(
string-append
key
"-residence"
)
social-residence-list
)
(
mupdate-spinner
(
string->symbol
(
dbg
(
string-append
id-text
"-strength"
)))
(
string-append
key
"-strength"
)
social-strength-list
))
)))
(
define
(
build-amenity-widgets
id
shade
)
...
...
@@ -730,11 +774,7 @@
(
mbutton-scale
'find-individual
(
lambda
()
(
list
(
start-activity
"individual-chooser"
choose-code
""
)))))
(
build-list-widget
db
"sync"
'villages
"village"
"village"
(
lambda
()
#f
)
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-village-name
))
(
ktv-create
"block"
"varchar"
""
)
(
ktv-create
"district"
"varchar"
"test"
)
(
ktv-create
"car"
"int"
0
))))
village-ktvlist
))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Main screen"
)
...
...
@@ -824,13 +864,7 @@
(
build-activity
(
build-list-widget
db
"sync"
'households
"household"
"household"
(
lambda
()
(
get-current
'village
#f
))
(
list
(
ktv-create
"name"
"varchar"
(
mtext-lookup
'default-household-name
))
(
ktv-create
"num-pots"
"int"
0
)
(
ktv-create
"house-lat"
"real"
0
)
;; get from current location?
(
ktv-create
"house-lon"
"real"
0
)
(
ktv-create
"toilet-lat"
"real"
0
)
(
ktv-create
"toilet-lon"
"real"
0
))))
household-ktvlist
))
(
lambda
(
activity
arg
)