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
3964b835
Commit
3964b835
authored
Apr 16, 2014
by
Dave Griffiths
Browse files
spinner-other fixed
parent
7783bb0a
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
52 additions
and
49 deletions
+52
-49
android/assets/dbsync.scm
android/assets/dbsync.scm
+36
-22
android/assets/eavdb.scm
android/assets/eavdb.scm
+1
-1
android/assets/starwisp.scm
android/assets/starwisp.scm
+15
-26
No files found.
android/assets/dbsync.scm
View file @
3964b835
...
...
@@ -145,13 +145,11 @@
(
let
((
db
(
get-current
'db
#f
))
(
table
(
get-current
'table
#f
)))
;; standard bits
(
let
((
values
(
get-current
'entity-values
'
()))
(
let
((
values
(
dbg
(
get-current
'entity-values
'
()))
)
(
unique-id
(
ktv-get
(
get-current
'entity-values
'
())
"unique_id"
)))
(
cond
((
and
unique-id
(
not
(
null?
values
)))
(
update-entity
db
table
(
entity-id-from-unique
db
table
unique-id
)
values
)
(
msg
"updated "
unique-id
)
(
msg
values
)
;; removed due to save button no longer exiting activity - need to keep!
;;(entity-reset!)
)
...
...
@@ -177,8 +175,6 @@
(
define
url
"http://192.168.2.1:8889/symbai?"
)
(
msg
"url"
)
(
define
(
build-url-from-ktv
ktv
)
(
string-append
"&"
(
ktv-key
ktv
)
":"
(
ktv-type
ktv
)
":"
(
number->string
(
ktv-version
ktv
))
"="
(
stringify-value-url
ktv
)))
...
...
@@ -517,7 +513,14 @@
(
spinner
(
make-id
(
string-append
(
symbol->string
id
)
"-spinner"
))
(
map
mtext-lookup
types
)
(
layout
'wrap-content
'wrap-content
1
'centre
0
)
(
lambda
(
c
)
(
fn
c
))))
(
lambda
(
c
)
(
msg
"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
)
(
msg
c
)
(
msg
(
length
types
))
;; dont call if set to "other"
(
if
(
<
c
(
-
(
length
types
)
1
))
(
fn
c
)
'
()))))
(
vert
(
mtext-scale
'other
)
(
edit-text
(
make-id
(
string-append
(
symbol->string
id
)
"-edit-text"
))
...
...
@@ -537,7 +540,13 @@
(
spinner
(
make-id
(
string-append
(
symbol->string
id
)
"-spinner"
))
(
map
mtext-lookup
types
)
(
layout
'wrap-content
'wrap-content
1
'centre
0
)
(
lambda
(
c
)
(
fn
c
)))
(
lambda
(
c
)
(
msg
"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
)
(
msg
c
)
(
msg
(
length
types
))
;; dont call if set to "other"
(
if
(
<
c
(
-
(
length
types
)
1
))
(
fn
c
)
'
())))
(
mtext-scale
'other
)
(
edit-text
(
make-id
(
string-append
(
symbol->string
id
)
"-edit-text"
))
""
30
"normal"
...
...
@@ -582,7 +591,9 @@
(
else
(
msg
"mupdate-widget unhandled widget type"
widget-type
))))
(
define
(
spinner-choice
l
i
)
(
symbol->string
(
list-ref
l
i
)))
(
if
(
number?
i
)
(
symbol->string
(
list-ref
l
i
))
i
))
(
define
(
mupdate-spinner
id-symbol
key
choices
)
(
let*
((
val
(
entity-get-value
key
)))
...
...
@@ -602,19 +613,23 @@
'selection
0
)))))))
(
define
(
mupdate-spinner-other
id-symbol
key
choices
)
(
let*
((
val
(
dbg
(
entity-get-value
key
)))
)
(
let*
((
val
(
entity-get-value
key
)))
(
if
(
not
val
)
(
update-widget
'spinner
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-spinner"
))
'selection
0
)
(
list
(
update-widget
'spinner
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-spinner"
))
'selection
0
)
)
(
let
((
index
(
index-find
(
string->symbol
val
)
choices
)))
(
if
index
(
update-widget
'spinner
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-spinner"
))
'selection
index
)
(
update-widget
'edit-text
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-edit-text"
))
'selection
index
))))))
(
list
(
update-widget
'spinner
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-spinner"
))
'selection
index
))
(
list
(
update-widget
'spinner
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-spinner"
))
'selection
(
-
(
length
choices
)
1
))
(
update-widget
'edit-text
(
get-id
(
string-append
(
symbol->string
id-symbol
)
"-edit-text"
))
'text
val
)))))))
;;;;
;; (y m d h m s)
...
...
@@ -712,7 +727,6 @@
(
or
(
ktv-get
e
"name"
)
"Unamed item"
)
40
(
layout
'fill-parent
'wrap-content
1
'centre
5
)
(
lambda
()
(
msg
"sending start act"
(
ktv-get
e
"unique_id"
))
(
list
(
start-activity
edit-activity
0
(
ktv-get
e
"unique_id"
))))))
search-results
)))))
...
...
@@ -738,9 +752,9 @@
(
lambda
(
e
)
(
list
(
ktv-get
e
"name"
)
(
ktv-get
e
"unique_id"
)))
(
dbg
(
db-filter-only
db
table
entity-type
(
list
)
(
list
(
list
"name"
"varchar"
)))))
)
(
db-filter-only
db
table
entity-type
(
list
)
(
list
(
list
"name"
"varchar"
)))))
(
define
vowel
(
map
symbol->string
(
list
'a
'e
'i
'o
'u
)))
...
...
android/assets/eavdb.scm
View file @
3964b835
...
...
@@ -41,7 +41,7 @@
;; basic key/type/value structure
;; used for all data internally, and maps to the eavdb types
(
define
(
ktv
key
type
value
)
(
list
key
type
value
-999
))
(
define
(
ktv
key
type
value
)
(
list
key
type
value
0
))
(
define
(
ktv-with-version
key
type
value
version
)
(
list
key
type
value
version
))
(
define
(
ktv-create
key
type
value
)
(
list
key
type
value
0
))
(
define
ktv-key
car
)
...
...
android/assets/starwisp.scm
View file @
3964b835
...
...
@@ -66,7 +66,7 @@
(
define
residence-list
'
(
birthplace
spouse-village
))
(
define
gender-list
'
(
male
female
))
(
define
occupation-list
'
(
agriculture
gathering
labour
cows
fishing
other
))
(
define
house-type-list
'
(
concrete
tin
thatched
))
(
define
house-type-list
'
(
concrete
tin
thatched
other
))
(
define
social-types-list
'
(
friendship
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
))
...
...
@@ -297,8 +297,6 @@
)
(
msg
"one"
)
(
define
(
build-activity
.
contents
)
(
vert-fill
(
relative
...
...
@@ -444,13 +442,10 @@
;; need to load from across entities, so need db, table
(
define
(
update-person-selector
db
table
id
key
)
(
msg
"update-person-selector"
key
)
(
let
((
entity-id
(
entity-get-value
key
)))
(
msg
"entity-id is"
entity-id
)
(
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"
)
...
...
@@ -501,18 +496,19 @@
(
entity-set-value!
key
"varchar"
(
get-current
'choose-result
"not set"
))))
(
define
(
update-social-connection
db
table
id
key
type
request-code
)
(
msg
"update-social-connection"
)
(
let
((
id-text
(
string-append
(
symbol->string
id
))))
(
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
)
(
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"
)
...
...
@@ -702,7 +698,6 @@
(
set-current!
'activity-title
"Household List"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
msg
"rebuilding household list with"
arg
)
(
list
(
update-list-widget
db
"sync"
"household"
"household"
arg
)))
(
lambda
(
activity
)
'
())
...
...
@@ -837,7 +832,7 @@
(
medit-text
'details-name
"normal"
(
lambda
(
v
)
(
entity-set-value!
"name"
"varchar"
v
)
'
()))
(
medit-text
'details-family
"normal"
(
lambda
(
v
)
(
entity-set-value!
"family"
"varchar"
v
)
'
()))
(
medit-text
'details-photo-id
"normal"
(
lambda
(
v
)
(
entity-set-value!
"photo-id"
"varchar"
v
)
'
()))))
(
mspinner-other
'tribe
tribes-list
(
lambda
(
v
)
(
msg
"tribe now:"
v
)
(
entity-set-value!
"tribe"
"varchar"
(
spinner-choice
tribes-list
v
))
'
()))
(
mspinner-other
'tribe
tribes-list
(
lambda
(
v
)
(
entity-set-value!
"tribe"
"varchar"
(
spinner-choice
tribes-list
v
))
'
()))
(
mspinner-other
'sub-tribe
subtribe-list
(
lambda
(
v
)
(
entity-set-value!
"subtribe"
"varchar"
(
spinner-choice
subtribe-list
v
))
'
()))
(
horiz
(
medit-text
'age
"numeric"
(
lambda
(
v
)
(
entity-set-value!
"age"
"int"
v
)
'
()))
...
...
@@ -850,13 +845,13 @@
(
lambda
(
activity
arg
)
(
append
(
update-top-bar
(
entity-get-value
"name"
)
(
entity-get-value
"photo-id"
))
(
mupdate-spinner-other
'tribe
"tribe"
tribes-list
)
(
mupdate-spinner-other
'sub-tribe
"subtribe"
subtribe-list
)
(
list
(
mupdate
'edit-text
'details-name
"name"
)
(
mupdate
'edit-text
'details-family
"family"
)
(
mupdate
'edit-text
'details-photo-id
"photo-id"
)
(
mupdate
'image-view
'photo
"photo"
)
(
mupdate-spinner-other
'tribe
"tribe"
tribes-list
)
(
mupdate-spinner-other
'sub-tribe
"subtribe"
subtribe-list
)
(
mupdate
'edit-text
'age
"age"
)
(
mupdate-spinner
'gender
"gender"
gender-list
)
(
mupdate-spinner
'education
"education"
education-list
)
...
...
@@ -938,8 +933,7 @@
(
when
(
and
(
eqv?
requestcode
spouse-request-code
)
(
get-current
'choose-result
#f
))
(
update-entity
db
"sync"
(
entity-id-from-unique
db
"sync"
(
get-current
'choose-result
#f
))
(
list
(
ktv
"id-spouse"
"varchar"
(
entity-get-value
"unique_id"
))))
(
msg
"done..."
))
(
list
(
ktv
"id-spouse"
"varchar"
(
entity-get-value
"unique_id"
)))))
;; save and reinit otherwise we can get out of sync here with the spouse :/
(
let
((
unique-id
(
entity-get-value
"unique_id"
)))
...
...
@@ -954,9 +948,6 @@
(
build-activity
(
mspinner
'move-household
'
()
(
lambda
(
v
)
(
msg
v
)
(
msg
(
number?
v
))
(
msg
(
list-ref
(
get-current
'move-household-list
'
())
v
))
(
entity-set-value!
"parent"
"varchar"
(
cadr
(
list-ref
(
get-current
'move-household-list
'
())
v
)))
...
...
@@ -1044,6 +1035,7 @@
(
entity-init!
db
"sync"
"individual"
(
get-entity-by-unique
db
"sync"
(
get-current
'individual
#f
)))
(
append
(
update-top-bar
(
entity-get-value
"name"
)
(
entity-get-value
"photo-id"
))
(
mupdate-spinner-other
'house-type
"house-type"
house-type-list
)
(
list
(
update-list-widget
db
"sync"
"crop"
"crop"
(
get-current
'individual
#f
))
(
mupdate-spinner
'occupation
"occupation"
occupation-list
)
...
...
@@ -1051,7 +1043,6 @@
(
mupdate
'toggle-button
'own-land
"own-land"
)
(
mupdate
'toggle-button
'rent-land
"rent-land"
)
(
mupdate
'toggle-button
'hire-land
"hire-land"
)
(
mupdate-spinner-other
'house-type
"house-type"
house-type-list
)
(
mupdate
'edit-text
'loan
"loan"
)
(
mupdate
'edit-text
'earning
"earning"
)
(
mupdate
'toggle-button
'radio
"radio"
)
...
...
@@ -1178,7 +1169,6 @@
(
set-current!
'activity-title
"Individual social network"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
msg
"wooooop"
)
(
append
(
update-top-bar
(
entity-get-value
"name"
)
(
entity-get-value
"photo-id"
))
(
list
...
...
@@ -1258,7 +1248,6 @@
(
lambda
(
v
)
(
cond
((
eqv?
v
1
)
(
msg
"adding new person quickly"
)
(
set-current!
'choose-result
(
entity-create!
...
...
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