Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
S
symbai
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
citizen-science
symbai
Commits
f2e7fb9e
Commit
f2e7fb9e
authored
Jul 11, 2014
by
dave griffiths
Browse files
Options
Browse Files
Download
Plain Diff
merged
parents
651e57f3
90a6d104
Changes
80
Hide whitespace changes
Inline
Side-by-side
Showing
80 changed files
with
7482 additions
and
791 deletions
+7482
-791
android/AndroidManifest.xml
android/AndroidManifest.xml
+2
-2
android/README.md
android/README.md
+2
-4
android/assets/dbsync.scm
android/assets/dbsync.scm
+92
-26
android/assets/lib.scm
android/assets/lib.scm
+4
-2
android/assets/starwisp.scm
android/assets/starwisp.scm
+463
-261
android/assets/translations.csv
android/assets/translations.csv
+266
-223
android/assets/translations.scm
android/assets/translations.scm
+279
-257
android/src/foam/symbai/starwisp.java
android/src/foam/symbai/starwisp.java
+3
-1
eavdb/eavdb.ss
eavdb/eavdb.ss
+7
-0
eavdb/entity-filter.ss
eavdb/entity-filter.ss
+40
-1
eavdb/entity-insert.ss
eavdb/entity-insert.ss
+1
-1
eavdb/entity-sync.ss
eavdb/entity-sync.ss
+2
-1
eavdb/entity-values.ss
eavdb/entity-values.ss
+3
-3
eavdb/ktv-list.ss
eavdb/ktv-list.ss
+7
-0
symbaidb/.dump
symbaidb/.dump
+0
-0
symbaidb/AndroidManifest.xml
symbaidb/AndroidManifest.xml
+36
-0
symbaidb/README.md
symbaidb/README.md
+2
-0
symbaidb/ant.properties
symbaidb/ant.properties
+7
-0
symbaidb/assets/.#dbsync.scm
symbaidb/assets/.#dbsync.scm
+1
-0
symbaidb/assets/dbsync.scm
symbaidb/assets/dbsync.scm
+1141
-0
symbaidb/assets/eavdb
symbaidb/assets/eavdb
+1
-0
symbaidb/assets/eavdb.scm
symbaidb/assets/eavdb.scm
+765
-0
symbaidb/assets/eavdb_/eavdb.ss
symbaidb/assets/eavdb_/eavdb.ss
+81
-0
symbaidb/assets/eavdb_/entity-csv.ss
symbaidb/assets/eavdb_/entity-csv.ss
+71
-0
symbaidb/assets/eavdb_/entity-filter.ss
symbaidb/assets/eavdb_/entity-filter.ss
+97
-0
symbaidb/assets/eavdb_/entity-get.ss
symbaidb/assets/eavdb_/entity-get.ss
+178
-0
symbaidb/assets/eavdb_/entity-insert.ss
symbaidb/assets/eavdb_/entity-insert.ss
+62
-0
symbaidb/assets/eavdb_/entity-sync.ss
symbaidb/assets/eavdb_/entity-sync.ss
+169
-0
symbaidb/assets/eavdb_/entity-update.ss
symbaidb/assets/eavdb_/entity-update.ss
+159
-0
symbaidb/assets/eavdb_/entity-values.ss
symbaidb/assets/eavdb_/entity-values.ss
+123
-0
symbaidb/assets/eavdb_/ktv-list.ss
symbaidb/assets/eavdb_/ktv-list.ss
+40
-0
symbaidb/assets/eavdb_/ktv.ss
symbaidb/assets/eavdb_/ktv.ss
+66
-0
symbaidb/assets/fonts/DejaVuSans.ttf
symbaidb/assets/fonts/DejaVuSans.ttf
+0
-0
symbaidb/assets/fonts/DejaVuSerif.ttf
symbaidb/assets/fonts/DejaVuSerif.ttf
+0
-0
symbaidb/assets/fonts/Ginger-Light.otf
symbaidb/assets/fonts/Ginger-Light.otf
+0
-0
symbaidb/assets/fonts/Ginger-Regular.otf
symbaidb/assets/fonts/Ginger-Regular.otf
+0
-0
symbaidb/assets/fonts/Pfennig.ttf
symbaidb/assets/fonts/Pfennig.ttf
+0
-0
symbaidb/assets/fonts/RobotoCondensed-Regular.ttf
symbaidb/assets/fonts/RobotoCondensed-Regular.ttf
+0
-0
symbaidb/assets/fonts/grobold.ttf
symbaidb/assets/fonts/grobold.ttf
+0
-0
symbaidb/assets/fonts/grstylus.ttf
symbaidb/assets/fonts/grstylus.ttf
+0
-0
symbaidb/assets/fonts/starwisp.ttf
symbaidb/assets/fonts/starwisp.ttf
+0
-0
symbaidb/assets/init.scm
symbaidb/assets/init.scm
+700
-0
symbaidb/assets/json.scm
symbaidb/assets/json.scm
+41
-0
symbaidb/assets/lib.scm
symbaidb/assets/lib.scm
+948
-0
symbaidb/assets/racket-fix.scm
symbaidb/assets/racket-fix.scm
+28
-0
symbaidb/assets/starwisp.scm
symbaidb/assets/starwisp.scm
+246
-0
symbaidb/assets/test.scm
symbaidb/assets/test.scm
+100
-0
symbaidb/assets/testing.scm
symbaidb/assets/testing.scm
+1
-0
symbaidb/assets/translations.csv
symbaidb/assets/translations.csv
+266
-0
symbaidb/assets/translations.scm
symbaidb/assets/translations.scm
+281
-0
symbaidb/assets/unit-tests.scm
symbaidb/assets/unit-tests.scm
+189
-0
symbaidb/build.xml
symbaidb/build.xml
+92
-0
symbaidb/local.properties
symbaidb/local.properties
+10
-0
symbaidb/proguard-project.txt
symbaidb/proguard-project.txt
+20
-0
symbaidb/project.properties
symbaidb/project.properties
+15
-0
symbaidb/res/animator/card_flip_left_in.xml
symbaidb/res/animator/card_flip_left_in.xml
+24
-0
symbaidb/res/animator/card_flip_left_out.xml
symbaidb/res/animator/card_flip_left_out.xml
+17
-0
symbaidb/res/animator/card_flip_right_in.xml
symbaidb/res/animator/card_flip_right_in.xml
+24
-0
symbaidb/res/animator/card_flip_right_out.xml
symbaidb/res/animator/card_flip_right_out.xml
+17
-0
symbaidb/res/drawable-hdpi/ic_launcher.png
symbaidb/res/drawable-hdpi/ic_launcher.png
+0
-0
symbaidb/res/drawable-ldpi/ic_launcher.png
symbaidb/res/drawable-ldpi/ic_launcher.png
+0
-0
symbaidb/res/drawable-mdpi/ic_launcher.png
symbaidb/res/drawable-mdpi/ic_launcher.png
+0
-0
symbaidb/res/drawable-xhdpi/ic_launcher.png
symbaidb/res/drawable-xhdpi/ic_launcher.png
+0
-0
symbaidb/res/drawable/bg.png
symbaidb/res/drawable/bg.png
+0
-0
symbaidb/res/drawable/bg_style.xml
symbaidb/res/drawable/bg_style.xml
+5
-0
symbaidb/res/drawable/bgpaw.png
symbaidb/res/drawable/bgpaw.png
+0
-0
symbaidb/res/drawable/cross.png
symbaidb/res/drawable/cross.png
+0
-0
symbaidb/res/drawable/face.png
symbaidb/res/drawable/face.png
+0
-0
symbaidb/res/drawable/logo.png
symbaidb/res/drawable/logo.png
+0
-0
symbaidb/res/drawable/swarmbutton.xml
symbaidb/res/drawable/swarmbutton.xml
+40
-0
symbaidb/res/drawable/swarmspinner.xml
symbaidb/res/drawable/swarmspinner.xml
+15
-0
symbaidb/res/drawable/tick.png
symbaidb/res/drawable/tick.png
+0
-0
symbaidb/res/layout/spinner_item.xml
symbaidb/res/layout/spinner_item.xml
+8
-0
symbaidb/res/raw/active.wav
symbaidb/res/raw/active.wav
+0
-0
symbaidb/res/raw/ping.wav
symbaidb/res/raw/ping.wav
+0
-0
symbaidb/res/values/strings.xml
symbaidb/res/values/strings.xml
+4
-0
symbaidb/res/values/styles.xml
symbaidb/res/values/styles.xml
+84
-0
symbaidb/src/foam/symbaidb/ReviewItemActivity.java
symbaidb/src/foam/symbaidb/ReviewItemActivity.java
+3
-3
symbaidb/src/foam/symbaidb/starwisp.java
symbaidb/src/foam/symbaidb/starwisp.java
+118
-0
translations.csv
translations.csv
+16
-6
No files found.
android/AndroidManifest.xml
View file @
f2e7fb9e
<?xml version="1.0" encoding="utf-8"?>
<manifest
xmlns:android=
"http://schemas.android.com/apk/res/android"
package=
"foam.symbai"
android:versionCode=
"
8
"
android:versionCode=
"
10
"
android:versionName=
"1.0"
>
<application
android:label=
"@string/app_name"
android:icon=
"@drawable/logo"
...
...
@@ -26,7 +26,7 @@
<activity
android:name=
"foam.symbai.FamilyActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.MigrationActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.IncomeActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.Genea
o
logyActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.GenealogyActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.SocialActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.FriendshipActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.AgreementActivity"
android:configChanges=
"orientation"
></activity>
...
...
android/README.md
View file @
f2e7fb9e
Open Sauces Notebook
====================
A structured notebook for recipes
Symbai android app
==================
android/assets/dbsync.scm
View file @
f2e7fb9e
...
...
@@ -17,6 +17,8 @@
(
msg
"dbsync.scm"
)
(
define
unset-int
2147483647
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
...
...
@@ -88,22 +90,51 @@
(
define
(
entity-get-value
key
)
(
ktv-get
(
get-current
'entity-values
'
())
key
))
(
define
(
check-type
type
value
)
(
cond
((
equal?
type
"varchar"
)
(
string?
value
))
((
equal?
type
"file"
)
(
string?
value
))
((
equal?
type
"int"
)
(
number?
value
))
((
equal?
type
"real"
)
(
number?
value
))))
;; version to check the entity has the key
(
define
(
entity-set-value!
key
type
value
)
(
when
(
not
(
check-type
type
value
))
(
msg
"INCORRECT TYPE FOR"
key
":"
type
":"
value
))
(
let
((
existing-type
(
ktv-get-type
(
get-current
'entity-values
'
())
key
)))
(
if
(
equal?
existing-type
type
)
(
set-current!
'entity-values
(
ktv-set
(
get-current
'entity-values
'
())
(
ktv
key
type
value
)))
;;
(
begin
(
msg
"entity-set-value! - adding new "
key
"of type"
type
"to entity"
)
(
entity-add-value-create!
key
type
value
)))
;; save straight to local db every time
(
entity-update-single-value!
(
list
key
type
value
))
))
(
cond
((
equal?
existing-type
type
)
;; save straight to local db every time (checks for modification)
(
entity-update-single-value!
(
list
key
type
value
))
;; then save to memory
(
set-current!
'entity-values
(
ktv-set
(
get-current
'entity-values
'
())
(
ktv
key
type
value
))))
;;
(
else
(
msg
"entity-set-value! - adding new "
key
"of type"
type
"to entity"
)
(
entity-add-value-create!
key
type
value
))
)))
;; version to check the entity has the key
(
define
(
entity-set-value-mem!
key
type
value
)
(
when
(
not
(
check-type
type
value
))
(
msg
"INCORRECT TYPE FOR"
key
":"
type
":"
value
))
;; then save to memory
(
set-current!
'entity-values
(
ktv-set
(
get-current
'entity-values
'
())
(
ktv
key
type
value
))))
(
define
(
date-time->string
dt
)
...
...
@@ -163,6 +194,8 @@
(
table
(
get-current
'table
#f
))
(
unique-id
(
ktv-get
(
get-current
'entity-values
'
())
"unique_id"
)))
(
cond
((
ktv-eq?
(
ktv-get-whole
(
get-current
'entity-values
'
())
(
ktv-key
ktv
))
ktv
)
(
msg
"eusv: no change for"
(
ktv-key
ktv
)))
(
unique-id
(
update-entity
db
table
(
entity-id-from-unique
db
table
unique-id
)
(
list
ktv
)))
(
else
...
...
@@ -455,7 +488,7 @@
(
list
(
network-connect
"network"
"
mongoose
-web"
"
symbai
-web"
(
lambda
(
state
)
(
debug!
(
string-append
"Raspberry Pi connection state now: "
state
))
(
append
...
...
@@ -575,11 +608,25 @@
(
layout
'fill-parent
'wrap-content
1
'centre
0
)
fn
))))
(
define
(
medit-text-large
id
type
fn
)
(
linear-layout
(
make-id
(
string-append
(
symbol->string
id
)
"-container"
))
'vertical
(
layout
'fill-parent
'wrap-content
1
'centre
20
)
(
list
0
0
0
0
)
(
list
(
text-view
0
(
mtext-lookup
id
)
30
(
layout
'wrap-content
'wrap-content
-1
'centre
0
))
(
edit-text
(
symbol->id
id
)
""
30
type
(
layout
'fill-parent
300
-1
'left
0
)
fn
))))
(
define
(
mspinner
id
types
fn
)
(
vert
(
text-view
(
symbol->id
id
)
(
mtext-lookup
id
)
30
(
layout
'wrap-content
'wrap-content
1
'centre
1
0
))
30
(
layout
'wrap-content
'wrap-content
1
'centre
0
))
(
spinner
(
make-id
(
string-append
(
symbol->string
id
)
"-spinner"
))
(
map
mtext-lookup
types
)
(
layout
'wrap-content
'wrap-content
1
'centre
0
)
...
...
@@ -650,15 +697,19 @@
(
define
(
image-invalid?
image-name
)
(
or
(
null?
image-name
)
(
not
image-name
)
(
equal?
image-name
"none"
)))
(
equal?
image-name
"none"
)
(
equal?
image-name
""
)))
;; fill out the widget from the current entity in the memory store
;; dispatches based on widget type
(
define
(
mupdate
widget-type
id-symbol
key
)
(
cond
((
or
(
eq?
widget-type
'edit-text
)
(
eq?
widget-type
'text-view
))
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'text
(
entity-get-value
key
)))
(
let
((
v
(
entity-get-value
key
)))
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'text
;; hide -1 as it represents unset
(
if
(
and
(
number?
v
)
(
eqv?
v
-1
))
""
v
))))
((
eq?
widget-type
'toggle-button
)
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'checked
(
entity-get-value
key
)))
...
...
@@ -779,7 +830,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
...
...
@@ -794,7 +845,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
...
...
@@ -802,13 +853,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
...
...
@@ -820,8 +886,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
)))))
...
...
@@ -1029,13 +1095,13 @@
(
msg
"making village"
i
)
(
let
((
village
(
simpsons-village
db
table
village-ktvlist
)))
(
looper!
3
15
(
lambda
(
i
)
(
alog
"household"
)
(
msg
"making household"
i
)
(
let
((
household
(
simpsons-household
db
table
village
household-ktvlist
)))
(
looper!
(
random
10
)
(
+
2
(
random
5
)
)
(
lambda
(
i
)
(
msg
"making individual"
i
)
(
simpsons-individual
db
table
household
individual-ktvlist
))))))))))
...
...
android/assets/lib.scm
View file @
f2e7fb9e
...
...
@@ -706,7 +706,7 @@
(
define
(
relative
rules
colour
.
l
)
(
relative-layout
0
(
rlayout
'fill-parent
'wrap-content
20
rules
)
0
(
rlayout
'fill-parent
'wrap-content
(
list
20
20
20
20
)
rules
)
colour
l
))
...
...
@@ -795,7 +795,8 @@
((
null?
w
)
#f
)
;; drill deeper
((
eq?
(
update-widget-token
w
)
'contents
)
(
msg
"updateing contents from callback"
)
(
update-callbacks!
(
update-widget-value
w
)))
((
eq?
(
update-widget-token
w
)
'contents-add
)
(
update-callbacks!
(
update-widget-value
w
)))
((
eq?
(
update-widget-token
w
)
'grid-buttons
)
(
add-callback!
(
callback
(
update-widget-id
w
)
...
...
@@ -862,6 +863,7 @@
(
begin
(
display
"no dialog called "
)(
display
name
)(
newline
))
(
let
((
events
(
apply
(
dialog-fn
dialog
)
args
)))
(
update-dialogs!
events
)
(
update-callbacks-from-update!
events
)
(
send
(
scheme->json
events
))))))
;; called by java
...
...
android/assets/starwisp.scm
View file @
f2e7fb9e
...
...
@@ -19,7 +19,7 @@
;; colours
(
msg
"starting up...."
)
(
define
entity-types
(
list
"village"
"household"
"individual"
))
(
define
entity-types
(
list
"village"
"household"
"individual"
"child"
"crop"
))
(
define
trans-col
(
list
0
0
0
0
))
(
define
colour-one
(
list
0
0
255
100
))
...
...
@@ -41,8 +41,6 @@
(
list
(
ktv
"user-id"
"varchar"
"not set"
)
(
ktv
"language"
"int"
0
)
(
ktv
"house-id"
"int"
0
)
(
ktv
"photo-id"
"int"
0
)
(
ktv
"current-village"
"varchar"
"none"
)))
(
define
(
get-setting-value
name
)
...
...
@@ -62,29 +60,41 @@
;;(display (db-all db "local" "app-settings"))(newline)
(
define
tribes-list
'
(
khasi
other
))
(
define
subtribe-list
'
(
khynriam
pnar
bhoi
war
other
))
(
define
education-list
'
(
primary
middle
high
secondary
university
))
(
define
married-list
'
(
currently-married
currently-single
seperat
ed
))
(
define
residence-list
'
(
birthplace
spouse-village
))
(
define
gender-list
'
(
male
female
))
(
define
house-type-list
'
(
concrete
tin
thatch
ed
other
))
(
define
tribes-list
'
(
not-set
khasi
no-answered
other
))
(
define
subtribe-list
'
(
not-set
khynriam
pnar
bhoi
war
not-answered
other
))
(
define
education-list
'
(
not-set
primary
middle
high
secondary
university
not-answered
))
(
define
married-list
'
(
not-set
currently-married
currently-single
seperated
not-answer
ed
))
(
define
residence-list
'
(
not-set
birthplace
spouse-village
not-answered
))
(
define
gender-list
'
(
not-set
male
female
not-answered
))
(
define
house-type-list
'
(
not-set
concrete
tin
thatched
not-answer
ed
other
))
(
define
yesno-list
'
(
not-set
yes
no
not-answered
))
(
define
social-types-list
'
(
knowledge
prestige
))
(
define
social-relationship-list
'
(
mother
father
sister
brother
spouse
children
co-wife
spouse-mother
spouse-father
spouse-brother-wife
spouse-sister-husband
friend
neighbour
other
))
(
define
social-residence-list
'
(
same
other
))
(
define
social-strength-list
'
(
daily
weekly
monthly
less
))
(
define
social-relationship-list
'
(
not-set
mother
father
sister
brother
spouse
children
co-wife
spouse-mother
spouse-father
spouse-brother-wife
spouse-sister-husband
friend
neighbour
not-answered
other
))
(
define
social-residence-list
'
(
not-set
same
not-answered
other
))
(
define
social-strength-list
'
(
not-set
daily
weekly
monthly
less
not-answered
))
(
define
village-ktvlist
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-village-name
))
(
ktv
"notes"
"varchar"
""
)
(
ktv
"block"
"varchar"
""
)
(
ktv
"district"
"varchar"
"test"
)
(
ktv
"district"
"varchar"
""
)
(
ktv
"school-closest-access"
"varchar"
""
)
(
ktv
"hospital-closest-access"
"varchar"
""
)
(
ktv
"post-office-closest-access"
"varchar"
""
)
(
ktv
"railway-station-closest-access"
"varchar"
""
)
(
ktv
"state-bus-service-closest-access"
"varchar"
""
)
(
ktv
"district-bus-service-closest-access"
"varchar"
""
)
(
ktv
"panchayat-closest-access"
"varchar"
""
)
(
ktv
"ngo-closest-access"
"varchar"
""
)
(
ktv
"market-closest-access"
"varchar"
""
)
(
ktv
"car"
"int"
0
)))
(
define
household-ktvlist
(
list
(
ktv
"name"
"varchar"
""
)
(
ktv
"notes"
"varchar"
""
)
(
ktv
"num-pots"
"int"
0
)
(
ktv
"num-children"
"int"
0
)
(
ktv
"house-lat"
"real"
0
)
;; get from current location?
...
...
@@ -94,119 +104,126 @@
(
define
individual-ktvlist
(
list
(
ktv
"edit-history"
"varchar"
""
)
(
ktv
"social-edit-history"
"varchar"
""
)
(
ktv
"name"
"varchar"
""
)
(
ktv
"notes"
"varchar"
""
)
(
ktv
"first-name"
"varchar"
""
)
(
ktv
"family"
"varchar"
""
)
(
ktv
"photo-id"
"varchar"
""
)
(
ktv
"photo"
"file"
""
)
(
ktv
"tribe"
"varchar"
""
)
(
ktv
"subtribe"
"varchar"
""
)
(
ktv
"child"
"int"
0
)
(
ktv
"age"
"int"
0
)
(
ktv
"gender"
"varchar"
""
)
(
ktv
"literate"
"int"
0
)
(
ktv
"education"
"varchar"
""
)
(
ktv
"agreement-photo"
"file"
""
)
(
ktv
"agreement-general"
"file"
""
)
(
ktv
"tribe"
"varchar"
"not-set"
)
(
ktv
"subtribe"
"varchar"
"not-set"
)
(
ktv
"child"
"int"
-1
)
(
ktv
"age"
"int"
-1
)
(
ktv
"gender"
"varchar"
"not-set"
)
(
ktv
"literate"
"varchar"
"not-set"
)
(
ktv
"education"
"varchar"
"not-set"
)
(
ktv
"head-of-house"
"varchar"
""
)
(
ktv
"marital-status"
"varchar"
""
)
(
ktv
"times-married"
"int"
0
)
(
ktv
"marital-status"
"varchar"
"
not-set
"
)
(
ktv
"times-married"
"int"
-1
)
(
ktv
"id-spouse"
"varchar"
""
)
(
ktv
"children-living"
"int"
0
)
(
ktv
"children-dead"
"int"
0
)
(
ktv
"children-together"
"int"
0
)
(
ktv
"children-apart"
"int"
0
)
(
ktv
"children-living"
"int"
-1
)
(
ktv
"children-dead"
"int"
-1
)
(
ktv
"children-together"
"int"
-1
)
(
ktv
"children-apart"
"int"
-1
)
(
ktv
"residence-after-marriage"
"varchar"
""
)
(
ktv
"num-siblings"
"int"
0
)
(
ktv
"birth-order"
"int"
0
)
(
ktv
"length-time"
"int"
0
)
(
ktv
"num-siblings"
"int"
-1
)
(
ktv
"birth-order"
"int"
-1
)
(
ktv
"length-time"
"int"
-1
)
(
ktv
"place-of-birth"
"varchar"
""
)
(
ktv
"num-residence-changes"
"int"
0
)
(
ktv
"village-visits-month"
"int"
0
)
(
ktv
"village-visits-year"
"int"
0
)
(
ktv
"occupation-agriculture"
"
int"
0
)
(
ktv
"occupation-gathering"
"
int"
0
)
(
ktv
"occupation-labour"
"
int"
0
)
(
ktv
"occupation-cows"
"
int"
0
)
(
ktv
"occupation-fishing"
"
int"
0
)
(
ktv
"num-residence-changes"
"int"
-1
)
(
ktv
"village-visits-month"
"int"
-1
)
(
ktv
"village-visits-year"
"int"
-1
)
(
ktv
"occupation-agriculture"
"
varchar"
"not-set"
)
(
ktv
"occupation-gathering"
"
varchar"
"not-set"
)
(
ktv
"occupation-labour"
"
varchar"
"not-set"
)
(
ktv
"occupation-cows"
"
varchar"
"not-set"
)
(
ktv
"occupation-fishing"
"
varchar"
"not-set"
)
(
ktv
"occupation-other"
"varchar"
""
)
(
ktv
"contribute"
"
int"
0
)
(
ktv
"own-land"
"
int"
0
)
(
ktv
"rent-land"
"
int"
0
)
(
ktv
"hire-land"
"
int"
0
)
(
ktv
"house-type"
"varchar"
""
)
(
ktv
"loan"
"int"
0
)
(
ktv
"earning"
"int"
0
)
(
ktv
"radio"
"
int"
0
)
(
ktv
"tv"
"
int"
0
)
(
ktv
"mobile"
"
int"
0
)
(
ktv
"visit-market"
"int"
0
)
(
ktv
"town-sell"
"int"
0
)
(
ktv
"contribute"
"
varchar"
"not-set"
)
(
ktv
"own-land"
"
varchar"
"not-set"
)
(
ktv
"rent-land"
"
varchar"
"not-set"
)
(
ktv
"hire-land"
"
varchar"
"not-set"
)
(
ktv
"house-type"
"varchar"
"
not-set
"
)
(
ktv
"loan"
"int"
-1
)
(
ktv
"earning"
"int"
-1
)
(
ktv
"radio"
"
varchar"
"not-set"
)
(
ktv
"tv"
"
varchar"
"not-set"
)
(
ktv
"mobile"
"
varchar"
"not-set"
)
(
ktv
"visit-market"
"int"
-1
)
(
ktv
"town-sell"
"int"
-1
)
(
ktv
"social-one"
"varchar"
""
)
(
ktv
"social-one-nickname"
"varchar"
""
)
(
ktv
"social-one-relationship"
"varchar"
""
)
(
ktv
"social-one-residence"
"varchar"
""
)
(
ktv
"social-one-strength"
"varchar"
""
)
(
ktv
"social-one-relationship"
"varchar"
"
not-set
"
)
(
ktv
"social-one-residence"
"varchar"
"
not-set
"
)
(
ktv
"social-one-strength"
"varchar"
"
not-set
"
)
(
ktv
"social-two"
"varchar"
""
)
(
ktv
"social-two-nickname"
"varchar"
""
)
(
ktv
"social-two-relationship"
"varchar"
""
)
(
ktv
"social-two-residence"
"varchar"
""
)
(
ktv
"social-two-strength"
"varchar"
""
)
(
ktv
"social-two-relationship"
"varchar"
"
not-set
"
)
(
ktv
"social-two-residence"
"varchar"
"
not-set
"
)
(
ktv
"social-two-strength"
"varchar"
"
not-set
"
)
(
ktv
"social-three"
"varchar"
""
)
(
ktv
"social-three-nickname"
"varchar"
""
)
(
ktv
"social-three-relationship"
"varchar"
""
)
(
ktv
"social-three-residence"
"varchar"
""
)
(
ktv
"social-three-strength"
"varchar"
""
)
(
ktv
"social-three-relationship"
"varchar"
"
not-set
"
)
(
ktv
"social-three-residence"
"varchar"
"
not-set
"
)
(
ktv
"social-three-strength"
"varchar"
"
not-set
"
)
(
ktv
"social-four"
"varchar"
""
)
(
ktv
"social-four-nickname"
"varchar"
""
)
(
ktv
"social-four-relationship"
"varchar"
""
)
(
ktv
"social-four-residence"
"varchar"
""
)
(
ktv
"social-four-strength"
"varchar"
""
)
(
ktv
"social-four-relationship"
"varchar"
"
not-set
"
)
(
ktv
"social-four-residence"
"varchar"
"
not-set
"
)
(
ktv
"social-four-strength"
"varchar"
"
not-set
"
)
(
ktv
"social-five"
"varchar"
""
)
(
ktv
"social-five-nickname"
"varchar"
""
)
(
ktv
"social-five-relationship"
"varchar"
""
)
(
ktv
"social-five-residence"
"varchar"
""
)
(
ktv
"social-five-strength"
"varchar"
""
)
(
ktv
"social-five-relationship"
"varchar"
"
not-set
"
)
(
ktv
"social-five-residence"
"varchar"
"
not-set
"
)
(
ktv
"social-five-strength"
"varchar"
"
not-set
"
)
(
ktv
"friendship-one"
"varchar"
""
)
(
ktv
"friendship-one-nickname"
"varchar"
""
)
(
ktv
"friendship-one-relationship"
"varchar"
""
)
(
ktv
"friendship-one-residence"
"varchar"
""
)
(
ktv
"friendship-one-strength"
"varchar"
""
)
(
ktv
"friendship-one-relationship"
"varchar"
"
not-set
"
)
(
ktv
"friendship-one-residence"
"varchar"
"
not-set
"
)
(
ktv
"friendship-one-strength"
"varchar"
"
not-set
"
)
(
ktv
"friendship-two"
"varchar"
""
)
(
ktv
"friendship-two-nickname"
"varchar"
""
)
(
ktv
"friendship-two-relationship"
"varchar"
""
)
(
ktv
"friendship-two-residence"
"varchar"
""
)
(
ktv
"friendship-two-strength"
"varchar"
""
)
(
ktv
"friendship-two-relationship"
"varchar"
"
not-set
"
)
(
ktv
"friendship-two-residence"
"varchar"
"
not-set
"
)
(
ktv
"friendship-two-strength"
"varchar"
"
not-set
"
)
(
ktv
"friendship-three"
"varchar"
""
)
(
ktv
"friendship-three-nickname"
"varchar"
""
)
(
ktv
"friendship-three-relationship"
"varchar"
""
)
(
ktv
"friendship-three-residence"
"varchar"
""
)
(
ktv
"friendship-three-strength"
"varchar"
""
)
(
ktv
"friendship-three-relationship"
"varchar"
"
not-set
"
)
(
ktv
"friendship-three-residence"
"varchar"
"
not-set
"
)
(
ktv
"friendship-three-strength"
"varchar"
"
not-set
"
)
(
ktv
"friendship-four"
"varchar"
""
)
(
ktv
"friendship-four-nickname"
"varchar"
""
)
(
ktv
"friendship-four-relationship"
"varchar"
""
)
(
ktv
"friendship-four-residence"
"varchar"
""
)
(
ktv
"friendship-four-strength"
"varchar"
""
)
(
ktv
"friendship-four-relationship"
"varchar"
"
not-set
"
)
(
ktv
"friendship-four-residence"
"varchar"
"
not-set
"
)
(
ktv
"friendship-four-strength"
"varchar"
"
not-set
"
)
(
ktv
"friendship-five"
"varchar"
""
)
(
ktv
"friendship-five-nickname"
"varchar"
""
)
(
ktv
"friendship-five-relationship"
"varchar"
""
)
(
ktv
"friendship-five-residence"
"varchar"
""
)
(
ktv
"friendship-five-strength"
"varchar"
""
)
(
ktv
"friendship-five-relationship"
"varchar"
"
not-set
"
)
(
ktv
"friendship-five-residence"
"varchar"
"
not-set
"
)
(
ktv
"friendship-five-strength"
"varchar"
"
not-set
"
)
))
(
define
crop-ktvlist
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-crop-name
))
(
ktv
"notes"
"varchar"
""
)
(
ktv
"unit"
"varchar"
"unit"
)
(
ktv
"used"
"real"
0
)
(
ktv
"sold"
"real"
0
)
(
ktv
"used"
"real"
-1
)
(
ktv
"sold"
"real"
-1
)
(
ktv
"seed"
"varchar"
""
)))
(
define
child-ktvlist
(
list
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-child-name
))
(
ktv
"alive"
"int"
1
)
(
ktv
"gender"
"varchar"
""
)
(
ktv
"age"
"int"
0
)
(
ktv
"living-at-home"
"int"
0
)))
(
ktv
"notes"
"varchar"
""
)
(
ktv
"alive"
"varchar"
"varchar"
"not-set"
)
(
ktv
"gender"
"varchar"
"not-set"
)
(
ktv
"age"
"int"
-1
)
(
ktv
"living-at-home"
"varchar"
"not-set"
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...
...
@@ -219,21 +236,68 @@
(
update-widget
'debug-text-view
(
get-id
"sync-debug"
)
'text
(
get-current
'debug-text
""
)))
;; return last element from comma seperated list
(
define
(
history-get-last
txt
)
(
let
((
l
(
string-split
txt
'
(
#
\
:
))))
(
if
(
null?
l
)
""
(
car
(
reverse
l
)))))
(
define
(
contains-social?
ktv-list
)
(
foldl
(
lambda
(
ktv
r
)
(
if
(
and
(
not
r
)
(
>
(
string-length
(
ktv-key
ktv
))
5
)
(
or
(
equal?
(
substring
(
ktv-key
ktv
)
0
6
)
"friend"
)
(
equal?
(
substring
(
ktv-key
ktv
)
0
6
)
"social"
)))
#t
r
))
#f
ktv-list
))
;; go through each dirty entity and stick the user id
;; on the end of the edit history lists - only for individuals
(
define
(
update-edit-history
db
table
user-id
)
;; get dirty individual entities
(
let
((
de
(
db-select
db
(
string-append
"select entity_id from "
table
"_entity where dirty=1 and entity_type='individual';"
))))
(
when
(
not
(
null?
de
))
(
for-each
(
lambda
(
i
)
(
let*
((
entity-id
(
vector-ref
i
0
))
(
dirty-items
(
dbg
(
get-entity-plain-for-sync
db
table
entity-id
))))
(
when
(
not
(
null?
dirty-items
))
;; check if social change
(
let
((
type
(
if
(
contains-social?
dirty-items
)
"social-edit-history"
"edit-history"
)))
;; check if last editor is different
(
let
((
editors
(
car
(
get-value
db
table
entity-id
(
list
type
"varchar"
)))))
(
when
(
or
(
equal?
editors
""
)
(
not
(
equal?
(
history-get-last
editors
)
user-id
)))
;; append user id
(
msg
"history - setting"
type
)
(
if
(
equal?
editors
""
)
(
update-value
db
table
entity-id
(
ktv
type
"varchar"
(
dbg
user-id
)))
(
update-value
db
table
entity-id
(
ktv
type
"varchar"
(
dbg
(
string-append
editors
":"
user-id
)))))))))))
(
cdr
de
)))))
(
define
(
debug-timer-cb
)
(
alog
"debug timer cb"
)
(
append
(
cond
((
get-current
'sync-on
#f
)
; (when (zero? (random 10))
; (msg "mangling...")
; (mangle-test! db "sync" entity-types))
(
msg
"one"
)
;(when (zero? (random 10))
; (msg "mangling...")
; (mangle-test! db "sync" entity-types))
(
set-current!
'upload
0
)