Commit d6caa023 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

added village activity

parent 3b6fd96a
...@@ -58,6 +58,10 @@ ...@@ -58,6 +58,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; db abstraction ;; db abstraction
(define (entity-init! ktv-list)
(entity-reset!)
(entity-set! ktv-list))
;; store a ktv, replaces existing with same key ;; store a ktv, replaces existing with same key
(define (entity-add-value! key type value) (define (entity-add-value! key type value)
(set-current! (set-current!
......
...@@ -625,6 +625,13 @@ ...@@ -625,6 +625,13 @@
(list 0 0 0 0) (list 0 0 0 0)
l)) l))
(define (horiz-colour col . l)
(linear-layout
0 'horizontal
(layout 'fill-parent 'wrap-content -1 'left 0)
col
l))
(define (vert . l) (define (vert . l)
(linear-layout (linear-layout
0 'vertical 0 'vertical
......
...@@ -48,6 +48,8 @@ ...@@ -48,6 +48,8 @@
(define i18n-text (define i18n-text
(list (list
(list 'test-num (list "1.0000000" "1.0000000" "1.0000000"))
(list 'title (list "Symbai" "Symbai" "Symbai")) (list 'title (list "Symbai" "Symbai" "Symbai"))
(list 'sync (list "Sync" "Sync" "Sync")) (list 'sync (list "Sync" "Sync" "Sync"))
(list 'languages (list "Choose language" "Choose language" "Choose language")) (list 'languages (list "Choose language" "Choose language" "Choose language"))
...@@ -57,7 +59,32 @@ ...@@ -57,7 +59,32 @@
(list 'user-id (list "User ID" "User ID" "User ID")) (list 'user-id (list "User ID" "User ID" "User ID"))
(list 'ok (list "Ok" "Ok" "Ok")) (list 'ok (list "Ok" "Ok" "Ok"))
(list 'cancel (list "Cancel" "Cancel" "Cancel")) (list 'cancel (list "Cancel" "Cancel" "Cancel"))
(list '+ (list "+" "+" "+")) (list 'new-village (list "+" "+" "+"))
(list 'villages (list "Villages" "Villages" "Villages"))
;; village screen
(list 'name (list "Village name" "Village name" "Village name"))
(list 'block (list "Block" "Block" "Block"))
(list 'district (list "District" "District" "District"))
(list 'car (list "Accessible by car"))
(list 'household-list (list "Household list"))
(list 'amenities (list "Amenities"))
(list 'school (list "School"))
(list 'present (list "Present"))
(list 'closest-access (list "Closest access"))
(list 'gps (list "GPS"))
(list 'school (list "School"))
(list 'hospital (list "Hospital/Health care centre"))
(list 'post-office (list "Post Office"))
(list 'railway-station (list "Railway station"))
(list 'state-bus-service (list "Inter-state bus service"))
(list 'district-bus-service (list "Inter-village/district bus service"))
(list 'panchayat (list "Village Panchayat Office"))
(list 'NGO (list "Presence of NGO's working with them"))
(list 'market (list "Market"))
)) ))
(define (mtext-lookup id) (define (mtext-lookup id)
...@@ -65,74 +92,93 @@ ...@@ -65,74 +92,93 @@
(define (_ l) (define (_ l)
(cond (cond
((null? l) (string-append (symbol->string id) " not translated")) ((null? l) (string-append (symbol->string id) " not translated"))
((eq? (car (car l)) id) (list-ref (cadr (car l)) i18n-lang)) ((eq? (car (car l)) id)
(let ((translations (cadr (car l))))
(if (<= (length translations) i18n-lang)
(string-append (symbol->string id) " not translated")
(list-ref translations i18n-lang))))
(else (_ (cdr l))))) (else (_ (cdr l)))))
(_ i18n-text)) (_ i18n-text))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (mbutton id title fn) (define (symbol->id id)
(button (make-id id) (when (not (symbol? id))
(mtext-lookup title) (msg "symbol->id: [" id "] is not a symbol"))
40 (layout 'fill-parent 'wrap-content -1 'left 5) fn)) (make-id (symbol->string id)))
(define (mbutton-scale id title fn)
(button (make-id id) (define (mbutton id fn)
(mtext-lookup title) (button (symbol->id id)
40 (layout 'fill-parent 'wrap-content 1 'left 5) fn)) (mtext-lookup id)
40 (layout 'fill-parent 'wrap-content -1 'centre 5) fn))
(define (mtoggle-button id title fn)
(toggle-button (make-id id) (define (mbutton-scale id fn)
(mtext-lookup title) (button (symbol->id id)
30 (layout 'fill-parent 'wrap-content 1 'left 0) "fancy" fn)) (mtext-lookup id)
40 (layout 'fill-parent 'wrap-content 1 'centre 5) fn))
(define (mtoggle-button-yes id title fn)
(toggle-button (make-id id) (define (mtoggle-button id fn)
(mtext-lookup title) (toggle-button (symbol->id id)
30 (layout 49 43 1 'left 0) "yes" fn)) (mtext-lookup id)
30 (layout 'fill-parent 'wrap-content -1 'centre 0) "fancy" fn))
(define (mtoggle-button-maybe id title fn)
(toggle-button (make-id id) (define (mtoggle-button-scale id fn)
(mtext-lookup title) (toggle-button (symbol->id id)
30 (layout 49 43 1 'left 0) "maybe" fn)) (mtext-lookup id)
30 (layout 'fill-parent 'wrap-content 1 'centre 0) "fancy" fn))
(define (mtoggle-button-no id title fn)
(toggle-button (make-id id) (define (mtext id)
(mtext-lookup title) (text-view (symbol->id id)
30 (layout 49 43 1 'left 0) "no" fn)) (mtext-lookup id)
30 (layout 'wrap-content 'wrap-content -1 'centre 0)))
(define (mtext id text)
(text-view (make-id id) (define (mtext-fixed w id)
(mtext-lookup text) (text-view (symbol->id id)
30 (layout 'wrap-content 'wrap-content -1 'left 0))) (mtext-lookup id)
30 (layout w 'wrap-content -1 'centre 0)))
(define (mtext-scale id text)
(text-view (make-id id)
(mtext-lookup text) (define (mtext-scale id)
30 (layout 'wrap-content 'wrap-content 1 'left 0))) (text-view (symbol->id id)
(mtext-lookup id)
(define (mtitle id text) 30 (layout 'wrap-content 'wrap-content 1 'centre 0)))
(text-view (make-id id)
(mtext-lookup text) (define (mtitle id)
50 (layout 'fill-parent 'wrap-content -1 'left 0))) (text-view (symbol->id id)
(mtext-lookup id)
(define (medit-text id text type fn) 50 (layout 'fill-parent 'wrap-content -1 'centre 0)))
(define (medit-text id type fn)
(vert (vert
(mtext (string-append id "-title") text) (mtext id)
(edit-text (make-id id) "" 30 type fillwrap fn))) (edit-text (symbol->id id) "" 30 type
(layout 'fill-parent 'wrap-content -1 'centre 0)
fn)))
(define (mspinner id name types fn) (define (medit-text-scale id type fn)
(vert (vert
(mtext "" name) (mtext id)
(spinner (make-id (string-append id "-spinner")) (map mtext-lookup types) fillwrap (edit-text (symbol->id id) "" 30 type
(lambda (c) (fn c))))) (layout 'fill-parent 'wrap-content 1 'centre 0)
fn)))
(define (mspinner-other id name types fn) (define (mspinner id types fn)
(horiz (horiz
(mspinner id name types fn (lambda (c) (fn c))) (text-view (symbol->id id)
(mtext-lookup id)
30 (layout 'wrap-content 'wrap-content -1 'centre 10))
(spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types) fillwrap
(lambda (c) (fn c)))))
(define (mspinner-other id types fn)
(horiz
(mspinner id types fn (lambda (c) (fn c)))
(vert (vert
(mtext "" 'other) (mtext 'other)
(edit-text (make-id (string-append id "-edit-text")) "" 30 "normal" fillwrap (edit-text (make-id (string-append (symbol->string id) "-edit-text"))
"" 30 "normal" fillwrap
(lambda (t) (fn t)))))) (lambda (t) (fn t))))))
...@@ -272,20 +318,20 @@ ...@@ -272,20 +318,20 @@
(fragment (fragment
"top" "top"
(horiz (horiz
(image-view 0 "face" (layout 48 64 -1 'left 0)) (image-view 0 "face" (layout 48 64 -1 'centre 0))
(text-view (make-id "") 'title 30 (text-view (make-id "title") "Insert title here" 30
(layout 'fill-parent 'fill-parent 0.25 'centre 10)) (layout 'fill-parent 'fill-parent 0.25 'centre 10))
(linear-layout (linear-layout
0 'vertical 0 'vertical
(layout 'fill-parent 'wrap-content 0.75 'left 0) (layout 'fill-parent 'wrap-content 0.75 'centre 0)
(list 0 0 0 0) (list 0 0 0 0)
(list (list
(text-view (make-id "") 'name 20 (text-view (make-id "") 'name 20
(layout 'fill-parent 'wrap-content 1 'left 0)) (layout 'fill-parent 'wrap-content 1 'centre 0))
(text-view (make-id "") 'photoid 20 (text-view (make-id "") 'photoid 20
(layout 'fill-parent 'wrap-content 1 'left 0))))) (layout 'fill-parent 'wrap-content 1 'centre 0)))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -300,11 +346,11 @@ ...@@ -300,11 +346,11 @@
"bottom" "bottom"
(linear-layout (linear-layout
0 'horizontal 0 'horizontal
(layout 'fill-parent 'fill-parent 1 'left 0) (layout 'fill-parent 'fill-parent 1 'centre 0)
(list 0 0 0 0) (list 0 0 0 0)
(list (list
(mbutton-scale "cancel" 'cancel (lambda () (list))) (mbutton-scale 'cancel (lambda () (list)))
(mbutton-scale "ok" 'ok (lambda () (list))))) (mbutton-scale 'ok (lambda () (list)))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -319,6 +365,26 @@ ...@@ -319,6 +365,26 @@
(msg "one") (msg "one")
(define (build-activity . contents)
(vert-fill
(relative
'(("parent-top"))
(list 100 100 255 127)
(build-fragment "top" (make-id "top") fillwrap))
(scroll-view-vert
0 (layout 'fill-parent 'fill-parent 1 'centre 0)
(list
(apply vert-fill contents)))
(relative
'(("parent-bottom"))
(list 100 100 255 127)
(vert
(spacer 5)
(build-fragment "bottom" (make-id "bottom") fillwrap)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities ;; activities
...@@ -335,21 +401,23 @@ ...@@ -335,21 +401,23 @@
(build-fragment "top" (make-id "top") fillwrap)) (build-fragment "top" (make-id "top") fillwrap))
(scroll-view-vert (scroll-view-vert
0 (layout 'fill-parent 'fill-parent 1 'left 0) 0 (layout 'fill-parent 'fill-parent 1 'centre 0)
(list (list
(vert-fill (vert-fill
(mtitle "" 'title) (mtitle 'title)
(horiz (horiz
(medit-text "user-id" 'user-id "normal" (lambda () (list))) (medit-text 'user-id "normal" (lambda () (list)))
(mbutton-scale "sync-button" 'sync (lambda () (list)))) (mbutton-scale 'sync (lambda () (list))))
(mspinner "languages" 'languages (list 'english 'khasi 'hindi) (lambda (c) (list))) (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
(horiz (horiz
(mtext "" 'villages) (mtext 'villages)
(mbutton "new-village" '+ (mbutton 'new-village
(lambda () (lambda ()
(list (start-activity "village" 0 "")))))))) (list (start-activity "village" 0 ""))))))))
;; village list here
(relative (relative
'(("parent-bottom")) '(("parent-bottom"))
(list 100 100 255 127) (list 100 100 255 127)
...@@ -371,31 +439,34 @@ ...@@ -371,31 +439,34 @@
(activity (activity
"village" "village"
(let ((place-widgets
(vert-fill (lambda (id shade)
(relative (horiz-colour
'(("parent-top")) (if shade (list 0 0 255 100) (list 127 127 255 100))
(list 100 100 255 127) (mtoggle-button-scale id (lambda (v) '()))
(build-fragment "top" (make-id "top") fillwrap)) (medit-text-scale 'closest-access "normal" (lambda (v) '()))
(vert
(scroll-view-vert (mbutton-scale 'gps (lambda () '()))
0 (layout 'fill-parent 'fill-parent 1 'left 0) (mtext 'test-num)
(list (mtext 'test-num))))))
(vert-fill (build-activity
;;(image-view (make-id "face") "face" (layout 640 470 1 'left 0)) (horiz
(mtitle "" 'title) (medit-text 'name "normal" (lambda () '()))
(mtext "" 'database) (medit-text 'block "normal" (lambda () '())))
(mbutton "main-sync" 'sync (lambda () (list (start-activity "sync" 0 "")))) (horiz
(mspinner-other "test" 'test (list 'one 'two 'three) (lambda (c) (list))) (medit-text 'district "normal" (lambda () '()))
))) (mtoggle-button-scale 'car (lambda () '())))
(mbutton 'household-list (lambda () '()))
(relative (mtitle 'amenities)
'(("parent-bottom")) (place-widgets 'school #t)
(list 100 100 255 127) (place-widgets 'hospital #f)
(vert (place-widgets 'post-office #t)
(spacer 5) (place-widgets 'railway-station #f)
(build-fragment "bottom" (make-id "bottom") fillwrap))) (place-widgets 'state-bus-service #t)
) (place-widgets 'district-bus-service #f)
(place-widgets 'panchayat #t)
(place-widgets 'NGO #f)
(place-widgets 'market #t)))
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment