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
7a96f055
Commit
7a96f055
authored
Apr 03, 2014
by
Dave Griffiths
Browse files
individual chooser works, image resized on load
parent
8acd93a7
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
130 additions
and
31 deletions
+130
-31
android/assets/eavdb.scm
android/assets/eavdb.scm
+17
-3
android/assets/lib.scm
android/assets/lib.scm
+10
-0
android/assets/starwisp.scm
android/assets/starwisp.scm
+103
-28
No files found.
android/assets/eavdb.scm
View file @
7a96f055
...
...
@@ -27,7 +27,6 @@
;; entity-attribut-value system for sqlite
;;
;; create eav tables (add types as required)
(
define
(
setup
db
table
)
(
db-exec
db
(
string-append
"create table "
table
"_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"
))
...
...
@@ -265,6 +264,20 @@
(
define
(
filter-op
f
)
(
list-ref
f
2
))
(
define
(
filter-arg
f
)
(
list-ref
f
3
))
(
define
(
merge-filter
f
fl
)
(
cond
((
null?
fl
)
(
list
f
))
((
equal?
(
filter-key
(
car
fl
))
(
filter-key
f
))
(
cons
f
(
cdr
fl
)))
(
else
(
cons
(
car
fl
)
(
merge-filter
f
(
cdr
fl
))))))
(
define
(
delete-filter
key
fl
)
(
cond
((
null?
fl
)
'
())
((
equal?
(
filter-key
(
car
fl
))
key
)
(
cdr
fl
))
(
else
(
cons
(
car
fl
)
(
delete-filter
key
(
cdr
fl
))))))
(
define
(
build-query
table
filter
)
(
string-append
(
foldl
...
...
@@ -288,7 +301,7 @@
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 "
)
filter
)
"order by n.value"
))
"
where e.entity_type = ?
order by n.value"
))
(
define
(
build-args
filter
)
(
map
...
...
@@ -301,7 +314,8 @@
db-select
(
dbg
(
append
(
list
db
(
build-query
table
filter
))
(
build-args
filter
))))))
(
build-args
filter
)
(
list
type
))))))
(
msg
(
db-status
db
))
(
if
(
null?
s
)
'
()
...
...
android/assets/lib.scm
View file @
7a96f055
...
...
@@ -50,6 +50,16 @@
(
insert
(
car
lst
)
fn
(
sort
(
cdr
lst
)
fn
))))
;; (chop (1 2 3 4) 2) -> ((1 2) (3 4))
(
define
(
chop
l
n
)
(
define
(
_
in
out
c
)
(
display
c
)(
newline
)
(
cond
((
null?
in
)
out
)
((
zero?
c
)
(
_
(
cdr
in
)
(
cons
(
list
(
car
in
))
out
)
(
-
n
1
)))
(
else
(
_
(
cdr
in
)
(
cons
(
cons
(
car
in
)
(
car
out
))
(
cdr
out
))
(
-
c
1
)))))
(
reverse
(
map
reverse
(
_
l
'
(())
n
))))
(
define
(
find
n
l
)
(
cond
((
null?
l
)
#f
)
...
...
android/assets/starwisp.scm
View file @
7a96f055
...
...
@@ -76,14 +76,21 @@
(
list
'khasi
(
list
"Khasi"
"Khasi"
"Khasi"
))
(
list
'hindi
(
list
"Hindi"
"Hindi"
"Hindi"
))
(
list
'user-id
(
list
"Your user ID"
"User ID"
"User ID"
))
(
list
'ok
(
list
"Ok"
"Ok"
"Ok"
))
(
list
'cancel
(
list
"Cancel"
"Cancel"
"Cancel"
))
(
list
'save
(
list
"Save"
"Save"
"Save"
))
(
list
'back
(
list
"Back"
"Back"
"Back"
))
(
list
'off
(
list
"Off"
"Off"
"Off"
))
(
list
'villages
(
list
"Villages"
"Villages"
"Villages"
))
(
list
'list-empty
(
list
"List empty"
))
(
list
'delete
(
list
"Delete"
))
(
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
(
list
'find-individual
(
list
"Find individual"
))
(
list
'filter
(
list
"Filter"
))
(
list
'off
(
list
"Off"
"Off"
"Off"
))
(
list
'name
(
list
"Name"
))
;; sync
(
list
'sync-all
(
list
"Sync me!"
))
(
list
'sync-syncall
(
list
"Sync everything"
))
...
...
@@ -354,7 +361,7 @@
(
list
0
0
0
0
)
(
list
(
mbutton-scale
'
ok
'
save
(
lambda
()
(
list
(
alert-dialog
...
...
@@ -364,10 +371,10 @@
(
cond
((
eqv?
v
1
)
(
entity-update-values!
)
(
list
(
finish-activity
1
)
))
(
list
))
(
else
(
list
))))))))
(
mbutton-scale
'
cancel
(
lambda
()
(
list
(
finish-activity
1
))))))
(
mbutton-scale
'
back
(
lambda
()
(
list
(
finish-activity
1
))))))
(
lambda
(
fragment
arg
)
(
activity-layout
fragment
))
(
lambda
(
fragment
arg
)
...
...
@@ -401,10 +408,72 @@
(
spacer
5
)
(
build-fragment
"bottom"
(
make-id
"bottom"
)
fillwrap
)))))
(
define
(
grid-ify
widgets
n
)
(
map
(
lambda
(
w
)
(
linear-layout
0
'horizontal
(
layout
'wrap-content
'wrap-content
1
'left
0
)
(
list
0
0
0
0
)
w
))
(
chop
widgets
n
)))
(
define
(
filter-set!
l
)
(
set-current!
'individual-filter
l
))
(
define
(
filter-clear!
)
(
filter-set!
'
()))
(
define
(
filter-add!
f
)
(
set-current!
'individual-filter
(
merge-filter
f
(
get-current
'individual-filter
'
()))))
(
define
(
filter-remove!
key
)
(
set-current!
'individual-filter
(
delete-filter
key
(
get-current
'individual-filter
'
()))))
(
define
(
filter-get
)
(
get-current
'individual-filter
'
()))
(
define
button-size
(
list
(
inexact->exact
(
round
(
*
192
0.9
)))
(
inexact->exact
(
round
(
*
256
0.9
)))))
(
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
(
or
(
null?
image-name
)
(
not
image-name
)
(
equal?
image-name
"none"
))
"face"
(
string-append
"/sdcard/symbai/files/"
image-name
))))
(
if
(
equal?
image
"face"
)
(
button
(
make-id
(
string-append
"chooser-"
id
))
(
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
))))
(
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
)))))))
(
db-filter
db
"sync"
"individual"
(
filter-get
)))
3
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities
(
define
photo-code
999
)
(
define
choose-code
998
)
(
define-activity-list
...
...
@@ -416,8 +485,9 @@
(
medit-text
'user-id
"normal"
(
lambda
()
(
list
)))
(
mbutton-scale
'sync
(
lambda
()
(
list
(
start-activity
"sync"
0
""
)))))
(
mspinner
'languages
(
list
'english
'khasi
'hindi
)
(
lambda
(
c
)
(
list
)))
(
mbutton
'find-individual
(
lambda
()
(
list
(
start-activity
"individual-chooser"
0
""
))))
(
horiz
(
mspinner
'languages
(
list
'english
'khasi
'hindi
)
(
lambda
(
c
)
(
list
)))
(
mbutton-scale
'find-individual
(
lambda
()
(
list
(
start-activity
"individual-chooser"
choose-code
""
)))))
(
build-list-widget
db
"sync"
'villages
"village"
"village"
(
lambda
()
#f
)
(
list
...
...
@@ -443,6 +513,8 @@
(
lambda
(
activity
)
'
())
(
lambda
(
activity
requestcode
resultcode
)
(
cond
((
eqv?
requestcode
choose-code
)
(
list
(
start-activity
"individual"
0
(
get-current
'choose-result
0
))))
((
eqv?
requestcode
photo-code
)
(
msg
"camera returned"
resultcode
)
(
list
(
update-widget
...
...
@@ -666,8 +738,10 @@
(
mbutton
'change-photo
(
lambda
()
(
set-current!
'photo-name
(
string-append
(
entity-get-value
"unique_id"
)
"-"
(
get-unique
"p"
)
"-face.jpg"
))
(
list
(
take-photo
(
string-append
dirname
"files/"
(
entity-get-value
"unique_id"
)
"-face.jpg"
)
photo-code
))
(
take-photo
(
string-append
dirname
"files/"
(
get-current
'photo-name
""
)
)
photo-code
))
)))
(
vert
...
...
@@ -708,7 +782,7 @@
;; need to do this before init is called again in on-start,
;; which happens next
(
let
((
unique-id
(
entity-get-value
"unique_id"
)))
(
entity-add-value!
"photo"
"file"
(
string-append
unique-id
"-face.jpg
"
))
(
entity-add-value!
"photo"
"file"
(
get-current
'photo-name
"error no photo name!!
"
))
(
entity-update-values!
)
;; need to reset the individual from the db now (as update reset it)
(
entity-init!
db
"sync"
"individual"
(
get-entity-by-unique
db
"sync"
unique-id
)))
...
...
@@ -742,7 +816,7 @@
(
medit-text
'birth-order
"numeric"
(
lambda
(
v
)
(
entity-add-value!
"birth-order"
"int"
v
)
'
())))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Individual family"
)
(
activity-layout
activity
))
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
list
(
mupdate-spinner
'head-of-house
"head-of-house"
'
(
male
female
))
...
...
@@ -907,28 +981,29 @@
(
layout
'fill-parent
'wrap-content
0.75
'centre
0
)
(
list
0
0
0
0
)
(
list
))
(
mtext
'filter-stuff
))
)
(
mtitle
'filter
)
(
horiz
(
mspinner
'gender
'
(
off
female
male
)
(
lambda
(
v
)
(
if
(
equal?
v
(
mtext-lookup
'off
))
(
filter-remove!
"gender"
)
(
filter-add!
(
make-filter
"gender"
"varchar"
"="
v
)))
(
list
(
update-individual-filter
))
))
(
medit-text
'name
"normal"
(
lambda
(
v
)
(
if
(
equal?
v
""
)
(
filter-remove!
"name"
)
(
filter-add!
(
make-filter
"name"
"varchar"
"like"
(
string-append
v
"%"
))))
(
list
(
update-individual-filter
))
))
)))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Individual chooser"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
list
(
update-widget
'linear-layout
(
get-id
"choose-pics"
)
'contents
(
map
(
lambda
(
e
)
(
msg
(
ktv-get
e
"gender"
))
(
let*
((
image-name
(
ktv-get
e
"photo"
))
(
image
(
if
(
or
(
not
image-name
)
(
equal?
image-name
"none"
))
"face"
(
string-append
"/sdcard/symbai/files/"
image-name
))))
(
msg
image
)
(
image-button
(
make-id
(
string-append
"chooser-"
(
ktv-get
e
"unique_id"
)))
image
(
layout
'wrap-content
'wrap-content
1
'centre
5
)
(
lambda
()
'
()))))
(
db-filter
db
"sync"
"individual"
(
list
(
make-filter
"gender"
"varchar"
"="
"female"
)))))))
(
list
(
update-individual-filter
(
list
))))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
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