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
12d0b3bf
Commit
12d0b3bf
authored
Apr 14, 2014
by
Dave Griffiths
Browse files
social type added
parent
ae2d3a9f
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
72 additions
and
35 deletions
+72
-35
android/assets/dbsync.scm
android/assets/dbsync.scm
+11
-9
android/assets/starwisp.scm
android/assets/starwisp.scm
+61
-26
No files found.
android/assets/dbsync.scm
View file @
12d0b3bf
...
...
@@ -640,15 +640,17 @@
(
number->string
(
cadr
loc
))))))
(
define
(
mupdate-gps
display-id
key-prepend
)
(
list
(
update-widget
'text-view
(
get-id
(
string-append
(
symbol->string
display-id
)
"-lat"
))
'text
(
number->string
(
entity-get-value
(
string-append
key-prepend
"-lat"
))
"real"
0
))
(
update-widget
'text-view
(
get-id
(
string-append
(
symbol->string
display-id
)
"-lon"
))
'text
(
number->string
(
entity-get-value
(
string-append
key-prepend
"-lon"
))
"real"
0
))))
(
let
((
lat
(
entity-get-value
(
string-append
key-prepend
"-lat"
)))
(
lon
(
entity-get-value
(
string-append
key-prepend
"-lon"
))))
(
if
(
or
(
not
lat
)
(
not
lon
))
'
()
(
list
(
update-widget
'text-view
(
get-id
(
string-append
(
symbol->string
display-id
)
"-lat"
))
'text
(
number->string
lat
))
(
update-widget
'text-view
(
get-id
(
string-append
(
symbol->string
display-id
)
"-lon"
))
'text
(
number->string
lon
))))))
;; a standard builder for list widgets of entities and a
...
...
android/assets/starwisp.scm
View file @
12d0b3bf
...
...
@@ -38,7 +38,7 @@
(
list
(
ktv
"user-id"
"varchar"
"No name yet..."
)))
(
define
entity-types
(
list
"village"
))
(
define
entity-types
(
list
"village"
"household"
"individual"
))
;;(display (db-all db "local" "app-settings"))(newline)
...
...
@@ -648,6 +648,40 @@
social-strength-list
)
)))
(
define
(
build-amenity-widgets
id
shade
)
(
let
((
id-text
(
symbol->string
id
)))
(
horiz-colour
(
if
shade
colour-one
colour-two
)
(
mtoggle-button-scale
id
(
lambda
(
v
)
(
entity-set-value!
id-text
"int"
v
)
'
()))
(
medit-text-scale
(
string->symbol
(
string-append
id-text
"-closest-access"
))
"normal"
(
lambda
(
v
)
(
entity-set-value!
(
string-append
id-text
"-closest-access"
)
"varchar"
v
)
'
()))
(
vert
(
mbutton-scale
(
string->symbol
(
string-append
id-text
"-gps"
))
(
lambda
()
(
do-gps
(
string->symbol
(
string-append
id-text
"-gps"
))
(
string-append
id-text
"-gps"
))))
(
mtext-small
(
string->symbol
(
string-append
id-text
"-lat"
)))
(
mtext-small
(
string->symbol
(
string-append
id-text
"-lat"
)))))))
(
define
(
update-amenity-widgets
id
)
(
let
((
id-text
(
symbol->string
id
)))
(
append
(
list
(
mupdate
'toggle-button
id
id-text
)
(
mupdate
'edit-text
(
string->symbol
(
string-append
id-text
"-closest-access"
))
(
string-append
id-text
"-closest-access"
)))
(
mupdate-gps
(
string->symbol
(
string-append
id-text
"-gps"
))
(
string-append
id-text
"-gps"
)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities
...
...
@@ -714,16 +748,6 @@
(
activity
"village"
(
let
((
place-widgets
(
lambda
(
id
shade
)
(
horiz-colour
(
if
shade
colour-one
colour-two
)
(
mtoggle-button-scale
id
(
lambda
(
v
)
'
()))
(
medit-text-scale
'closest-access
"normal"
(
lambda
(
v
)
'
()))
(
vert
(
mbutton-scale
'gps
(
lambda
()
'
()))
(
mtext-small
'test-num
)
(
mtext-small
'test-num
))))))
(
build-activity
(
horiz
(
medit-text
'village-name
"normal"
(
lambda
(
v
)
(
entity-set-value!
"name"
"varchar"
v
)
'
()))
...
...
@@ -738,27 +762,38 @@
(
get-current
'village
#f
)))))
(
mtitle
'amenities
)
(
place
-widgets
'school
#t
)
(
place
-widgets
'hospital
#f
)
(
place
-widgets
'post-office
#t
)
(
place
-widgets
'railway-station
#f
)
(
place
-widgets
'state-bus-service
#t
)
(
place
-widgets
'district-bus-service
#f
)
(
place
-widgets
'panchayat
#t
)
(
place
-widgets
'NGO
#f
)
(
place
-widgets
'market
#t
)
(
delete-button
))
)
(
build-amenity
-widgets
'school
#t
)
(
build-amenity
-widgets
'hospital
#f
)
(
build-amenity
-widgets
'post-office
#t
)
(
build-amenity
-widgets
'railway-station
#f
)
(
build-amenity
-widgets
'state-bus-service
#t
)
(
build-amenity
-widgets
'district-bus-service
#f
)
(
build-amenity
-widgets
'panchayat
#t
)
(
build-amenity
-widgets
'NGO
#f
)
(
build-amenity
-widgets
'market
#t
)
(
delete-button
))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Village"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
entity-init!
db
"sync"
"village"
(
get-entity-by-unique
db
"sync"
arg
))
(
set-current!
'village
arg
)
(
list
(
mupdate
'edit-text
'village-name
"name"
)
(
mupdate
'edit-text
'block
"block"
)
(
mupdate
'edit-text
'district
"district"
)
(
mupdate
'toggle-button
'car
"car"
)))
(
append
(
list
(
mupdate
'edit-text
'village-name
"name"
)
(
mupdate
'edit-text
'block
"block"
)
(
mupdate
'edit-text
'district
"district"
)
(
mupdate
'toggle-button
'car
"car"
))
(
update-amenity-widgets
'school
)
(
update-amenity-widgets
'hospital
)
(
update-amenity-widgets
'post-office
)
(
update-amenity-widgets
'railway-station
)
(
update-amenity-widgets
'state-bus-service
)
(
update-amenity-widgets
'district-bus-service
)
(
update-amenity-widgets
'panchayat
)
(
update-amenity-widgets
'NGO
)
(
update-amenity-widgets
'market
)))
(
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