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

connected up more stuff

parent d1ff640e
...@@ -422,12 +422,15 @@ ...@@ -422,12 +422,15 @@
(define (mtoggle-button id fn) (define (mtoggle-button id fn)
(toggle-button (symbol->id id) (toggle-button (symbol->id id)
(mtext-lookup id) (mtext-lookup id)
30 (layout 'fill-parent 'wrap-content -1 'centre 0) "fancy" fn)) 30 (layout 'fill-parent 'wrap-content -1 'centre 0) "fancy"
;; convert to 0/1 for easier db storage
(lambda (v) (fn (if v 1 0)))))
(define (mtoggle-button-scale id fn) (define (mtoggle-button-scale id fn)
(toggle-button (symbol->id id) (toggle-button (symbol->id id)
(mtext-lookup id) (mtext-lookup id)
30 (layout 'fill-parent 'wrap-content 1 'centre 0) "fancy" fn)) 30 (layout 'fill-parent 'wrap-content 1 'centre 0) "fancy"
(lambda (v) (fn (if v 1 0)))))
(define (mtext id) (define (mtext id)
(text-view (symbol->id id) (text-view (symbol->id id)
...@@ -525,7 +528,7 @@ ...@@ -525,7 +528,7 @@
(update-widget widget-type (get-symbol-id id-symbol) 'text (update-widget widget-type (get-symbol-id id-symbol) 'text
(entity-get-value key))) (entity-get-value key)))
((eq? widget-type 'toggle-button) ((eq? widget-type 'toggle-button)
(update-widget widget-type (get-symbol-id id-symbol) 'selected (update-widget widget-type (get-symbol-id id-symbol) 'checked
(entity-get-value key))) (entity-get-value key)))
((eq? widget-type 'image-view) ((eq? widget-type 'image-view)
(let ((image-name (entity-get-value key))) (let ((image-name (entity-get-value key)))
...@@ -543,7 +546,11 @@ ...@@ -543,7 +546,11 @@
(update-widget 'spinner (update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner")) (get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection index) 'selection index)
(msg "spinner item in db " val " not found in list of items")))) (begin
(msg "spinner item in db " val " not found in list of items")
(update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection 0)))))
(define (mupdate-spinner-other id-symbol key choices) (define (mupdate-spinner-other id-symbol key choices)
(msg "update spinner other...") (msg "update spinner other...")
......
...@@ -42,6 +42,10 @@ ...@@ -42,6 +42,10 @@
;;(display (db-all db "local" "app-settings"))(newline) ;;(display (db-all db "local" "app-settings"))(newline)
(define tribes-list '(khasi other))
(define subtribe-list '(khynriam pnar bhoi war other))
(define education-list '(illiterate literate primary middle high secondary university))
(define married-list '(ever-married currently-married currently-single seperated))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; user interface abstraction ;; user interface abstraction
...@@ -148,10 +152,23 @@ ...@@ -148,10 +152,23 @@
(list 'details-family (list "Family")) (list 'details-family (list "Family"))
(list 'tribe (list "Tribe")) (list 'tribe (list "Tribe"))
(list 'sub-tribe (list "Sub tribe")) (list 'sub-tribe (list "Sub tribe"))
(list 'khasi (list "Khasi"))
(list 'khynriam (list "Khynriam"))
(list 'pnar (list "Pnar"))
(list 'bhoi (list "Bhoi"))
(list 'war (list "War"))
(list 'other (list "Other")) (list 'other (list "Other"))
(list 'age (list "Age")) (list 'age (list "Age"))
(list 'gender (list "Gender")) (list 'gender (list "Gender"))
(list 'education (list "Education")) (list 'education (list "Education"))
(list 'illiterate (list "Illiterate"))
(list 'literate (list "Literate"))
(list 'primary (list "Primary 1-5"))
(list 'middle (list "Middle 6-8"))
(list 'high (list "High 9-10"))
(list 'secondary (list "Higher Secondary"))
(list 'university (list "University"))
;; family ;; family
(list 'spouse (list "Spouse")) (list 'spouse (list "Spouse"))
...@@ -163,10 +180,10 @@ ...@@ -163,10 +180,10 @@
(list 'seperated (list "Seperated/divorced")) (list 'seperated (list "Seperated/divorced"))
(list 'times-married (list "How many times married")) (list 'times-married (list "How many times married"))
(list 'change-spouse (list "Change/add spouse")) (list 'change-spouse (list "Change/add spouse"))
(list 'living (list "Living")) (list 'children-living (list "Living"))
(list 'dead (list "Dead")) (list 'children-dead (list "Dead"))
(list 'together (list "Living together")) (list 'children-together (list "Living together"))
(list 'apart (list "Living apart")) (list 'children-apart (list "Living apart"))
(list 'residence-after-marriage (list "Residence after marriage")) (list 'residence-after-marriage (list "Residence after marriage"))
(list 'birthplace (list "Birthplace")) (list 'birthplace (list "Birthplace"))
(list 'spouse-village (list "Spouses natal village")) (list 'spouse-village (list "Spouses natal village"))
...@@ -188,11 +205,11 @@ ...@@ -188,11 +205,11 @@
(list 'labour (list "Labour")) (list 'labour (list "Labour"))
(list 'cows (list "Cows")) (list 'cows (list "Cows"))
(list 'fishing (list "Fishing")) (list 'fishing (list "Fishing"))
(list 'num-people-in-house (list "Number of people living in this house")) (list 'num-people-in-house (list "People living in house"))
(list 'contribute (list "Do you contribute to the family earnings?")) (list 'contribute (list "Contribute to family earnings?"))
(list 'own-land (list "Do you own land?")) (list 'own-land (list "Own land?"))
(list 'rent-land (list "Do you rent out your land?")) (list 'rent-land (list "Rent out your land?"))
(list 'hire-land (list "Do you hire someone else's land?")) (list 'hire-land (list "Hire land?"))
(list 'crops (list "Crops")) (list 'crops (list "Crops"))
(list 'crop (list "Crop")) (list 'crop (list "Crop"))
(list 'unit (list "Unit")) (list 'unit (list "Unit"))
...@@ -204,14 +221,14 @@ ...@@ -204,14 +221,14 @@
(list 'concrete (list "Concrete")) (list 'concrete (list "Concrete"))
(list 'tin (list "Tin")) (list 'tin (list "Tin"))
(list 'thatched (list "Thatched")) (list 'thatched (list "Thatched"))
(list 'loan (list "How much outstanding loan money have you taken in all from any source at this time?")) (list 'loan (list "Outstanding loans"))
(list 'earning (list "How much do you earn for one day's labour?")) (list 'earning (list "One day's earnings"))
(list 'in-the-home (list "In the home")) (list 'in-the-home (list "In the home"))
(list 'radio (list "Radio")) (list 'radio (list "Radio"))
(list 'tv (list "TV")) (list 'tv (list "TV"))
(list 'mobile (list "Mobile phone")) (list 'mobile (list "Mobile phone"))
(list 'visit-market (list "How many times a month do you visit the tribal market?")) (list 'visit-market (list "Tribal market visits"))
(list 'town-sell (list "How many times a month do you visit the local town or city to sell something?")) (list 'town-sell (list "Town or city visits"))
;; geneaology ;; geneaology
...@@ -612,7 +629,8 @@ ...@@ -612,7 +629,8 @@
(build-list-widget (build-list-widget
db "sync" 'individuals "individual" "individual" (lambda () (get-current 'household #f)) db "sync" 'individuals "individual" "individual"
(lambda () (get-current 'household #f))
(list (list
(ktv "name" "varchar" (mtext-lookup 'default-individual-name)) (ktv "name" "varchar" (mtext-lookup 'default-individual-name))
(ktv "family" "varchar" (mtext-lookup 'default-family-name)) (ktv "family" "varchar" (mtext-lookup 'default-family-name))
...@@ -622,7 +640,38 @@ ...@@ -622,7 +640,38 @@
(ktv "subtribe" "varchar" "none") (ktv "subtribe" "varchar" "none")
(ktv "age" "int" 0) (ktv "age" "int" 0)
(ktv "gender" "varchar" "female") (ktv "gender" "varchar" "female")
(ktv "education" "varchar" "none"))) (ktv "education" "varchar" "none")
(ktv "head-of-house" "varchar" "none")
(ktv "marital-status" "varchar" "none")
(ktv "times-married" "int" 0)
(ktv "id-spouse" "varchar" "none")
(ktv "children-living" "int" 0)
(ktv "children-dead" "int" 0)
(ktv "children-together" "int" 0)
(ktv "children-apart" "int" 0)
(ktv "residence-after-marriage" "varchar" "none")
(ktv "num-siblings" "int" 0)
(ktv "birth-order" "int" 0)
(ktv "length-time" "int" 0)
(ktv "place-of-birth" "varchar" "none")
(ktv "num-residence-changes" "int" 0)
(ktv "village-visits-month" "int" 0)
(ktv "village-visits-year" "int" 0)
(ktv "occupation" "varchar" "none")
(ktv "contribute" "int" 0)
(ktv "own-land" "int" 0)
(ktv "rent-land" "int" 0)
(ktv "hire-land" "int" 0)
(ktv "house-type" "varchar" "none")
(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)
))
(delete-button)) (delete-button))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Household") (set-current! 'activity-title "Household")
...@@ -701,12 +750,12 @@ ...@@ -701,12 +750,12 @@
(medit-text 'details-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '())) (medit-text 'details-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(medit-text 'details-family "normal" (lambda (v) (entity-add-value! "family" "varchar" v) '())) (medit-text 'details-family "normal" (lambda (v) (entity-add-value! "family" "varchar" v) '()))
(medit-text 'details-photo-id "normal" (lambda (v) (entity-add-value! "photo-id" "varchar" v) '())))) (medit-text 'details-photo-id "normal" (lambda (v) (entity-add-value! "photo-id" "varchar" v) '()))))
(mspinner-other 'tribe '(one two three) (lambda (v) (msg "tribe now:" v) (entity-add-value! "tribe" "varchar" v) '())) (mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-add-value! "tribe" "varchar" v) '()))
(mspinner-other 'sub-tribe '(one two three) (lambda (v) (entity-add-value! "subtribe" "varchar" v) '())) (mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-add-value! "subtribe" "varchar" v) '()))
(horiz (horiz
(medit-text 'age "numeric" (lambda (v) (entity-add-value! "age" "int" v) '())) (medit-text 'age "numeric" (lambda (v) (entity-add-value! "age" "int" v) '()))
(mspinner 'gender '(male female) (lambda (v) (entity-add-value! "gender" "varchar" v) '())) (mspinner 'gender '(male female) (lambda (v) (entity-add-value! "gender" "varchar" v) '()))
(mspinner 'education '(one two three) (lambda (v) (entity-add-value! "education" "varchar" v) '()))) (mspinner 'education education-list (lambda (v) (entity-add-value! "education" "varchar" v) '())))
) )
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual details") (set-current! 'activity-title "Individual details")
...@@ -717,11 +766,11 @@ ...@@ -717,11 +766,11 @@
(mupdate 'edit-text 'details-family "family") (mupdate 'edit-text 'details-family "family")
(mupdate 'edit-text 'details-photo-id "photo-id") (mupdate 'edit-text 'details-photo-id "photo-id")
(mupdate 'image-view 'photo "photo") (mupdate 'image-view 'photo "photo")
(mupdate-spinner-other 'tribe "tribe" '(one two three)) (mupdate-spinner-other 'tribe "tribe" tribes-list)
(mupdate-spinner-other 'sub-tribe "subtribe" '(one two three)) (mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
(mupdate 'edit-text 'age "age") (mupdate 'edit-text 'age "age")
(mupdate-spinner 'gender "gender" '(male female)) (mupdate-spinner 'gender "gender" '(male female))
(mupdate-spinner 'education "education" '(one two three)) (mupdate-spinner 'education "education" education-list)
)) ))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -749,9 +798,9 @@ ...@@ -749,9 +798,9 @@
(build-activity (build-activity
(horiz (horiz
(vert (vert
(mspinner 'head-of-house '(male female) (lambda (v) '())) (mspinner 'head-of-house '(male female) (lambda (v) (entity-add-value! "head-of-house" "varchar" v) '()))
(mspinner 'marital-status '(ever-married currently-married currently-single seperated) (lambda (v) '())) (mspinner 'marital-status married-list (lambda (v) (entity-add-value! "marital-status" "varchar" v) '()))
(medit-text 'times-married "numeric" (lambda (v) '()))) (medit-text 'times-married "numeric" (lambda (v) (entity-add-value! "times-married" "int" v) '())))
(vert (vert
(mtitle 'spouse) (mtitle 'spouse)
(image-view (make-id "spouse-image") "face" (layout 240 320 -1 'centre 0)) (image-view (make-id "spouse-image") "face" (layout 240 320 -1 'centre 0))
...@@ -759,18 +808,30 @@ ...@@ -759,18 +808,30 @@
(mtitle 'children) (mtitle 'children)
(horiz (horiz
(medit-text 'living "numeric" (lambda (v) '())) (medit-text 'children-living "numeric" (lambda (v) (entity-add-value! "children-living" "int" v) '()))
(medit-text 'dead "numeric" (lambda (v) '()))) (medit-text 'children-dead "numeric" (lambda (v) (entity-add-value! "children-dead" "int" v) '())))
(horiz (horiz
(medit-text 'together "numeric" (lambda (v) '())) (medit-text 'children-together "numeric" (lambda (v) (entity-add-value! "children-together" "int" v) '()))
(medit-text 'apart "numeric" (lambda (v) '()))) (medit-text 'children-apart "numeric" (lambda (v) (entity-add-value! "children-apart" "int" v) '())))
(mspinner-other 'residence-after-marriage '(birthplace spouse-village) (lambda (v) '())) (mspinner-other 'residence-after-marriage '(birthplace spouse-village) (lambda (v) '()))
(medit-text 'num-siblings "numeric" (lambda (v) '())) (medit-text 'num-siblings "numeric" (lambda (v) (entity-add-value! "num-siblings" "int" v) '()))
(medit-text 'birth-order "numeric" (lambda (v) '()))) (medit-text 'birth-order "numeric" (lambda (v) (entity-add-value! "birth-order" "int" v) '())))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual family") (set-current! 'activity-title "Individual family")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) '()) (lambda (activity arg)
(list
(mupdate-spinner 'head-of-house "head-of-house" '(male female))
(mupdate-spinner 'marital-status "marital-status" married-list)
(mupdate 'edit-text 'times-married "times-married")
;;(mupdate 'id-spouse "id-spouse")
(mupdate 'edit-text 'children-living "children-living")
(mupdate 'edit-text 'children-dead "children-dead")
(mupdate 'edit-text 'children-together "children-together")
(mupdate 'edit-text 'children-apart "children-apart")
(mupdate-spinner 'residence-after-marriage "residence-after-marriage" '(birthplace spouse-village))
(mupdate 'edit-text 'num-siblings "num-siblings")
(mupdate 'edit-text 'birth-order "birth-order")))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -781,16 +842,22 @@ ...@@ -781,16 +842,22 @@
(activity (activity
"migration" "migration"
(build-activity (build-activity
(medit-text 'length-time "numeric" (lambda (v) '())) (medit-text 'length-time "numeric" (lambda (v) (entity-add-value! "length-time" "int" v) '()))
(medit-text 'place-of-birth "normal" (lambda (v) '())) (medit-text 'place-of-birth "normal" (lambda (v) (entity-add-value! "place-of-birth" "varchar" v) '()))
(medit-text 'num-residence-changes "numeric" (lambda (v) '())) (medit-text 'num-residence-changes "numeric" (lambda (v) (entity-add-value! "num-residence-changes" "int" v) '()))
(medit-text 'village-visits-month "numeric" (lambda (v) '())) (medit-text 'village-visits-month "numeric" (lambda (v) (entity-add-value! "village-visits-month" "int" v) '()))
(medit-text 'village-visits-year "numeric" (lambda (v) '())) (medit-text 'village-visits-year "numeric" (lambda (v) (entity-add-value! "village-visits-year" "int" v) '()))
) )
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual migration") (set-current! 'activity-title "Individual migration")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) '()) (lambda (activity arg)
(list
(mupdate 'edit-text 'length-time "length-time")
(mupdate 'edit-text 'place-of-birth "place-of-birth")
(mupdate 'edit-text 'num-residence-changes "num-residence-changes")
(mupdate 'edit-text 'village-visits-month "village-visits-month")
(mupdate 'edit-text 'village-visits-year "village-visits-year")))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -800,37 +867,50 @@ ...@@ -800,37 +867,50 @@
(activity (activity
"income" "income"
(build-activity (build-activity
(horiz
(mspinner 'occupation '(agriculture gathering labour cows fishing other) (mspinner 'occupation '(agriculture gathering labour cows fishing other)
(lambda (v) '())) (lambda (v) (entity-add-value! "occupation" "varchar" v) '()))
(medit-text 'num-people-in-house "numeric" (lambda (v) '())))
(horiz (horiz
(mtoggle-button-scale 'contribute (lambda (v) '())) (mtoggle-button-scale 'contribute (lambda (v) (entity-add-value! "contribute" "int" v) '()))
(mtoggle-button-scale 'own-land (lambda (v) '()))) (mtoggle-button-scale 'own-land (lambda (v) (entity-add-value! "own-land" "int" v) '())))
(horiz (horiz
(mtoggle-button-scale 'rent-land (lambda (v) '())) (mtoggle-button-scale 'rent-land (lambda (v) (entity-add-value! "rent-land" "int" v) '()))
(mtoggle-button-scale 'hire-land (lambda (v) '()))) (mtoggle-button-scale 'hire-land (lambda (v) (entity-add-value! "hire-land" "int" v) '())))
(mtitle 'crops) (mtitle 'crops)
(horiz ;; todo ->
(mtext-scale 'crop) (mtext-scale 'unit) (mtext-scale 'quantity) ;; (horiz
(mtext-scale 'used-or-eaten) (mtext-scale 'sold) (mtext-scale 'seed)) ;; (mtext-scale 'crop) (mtext-scale 'unit) (mtext-scale 'quantity)
;; (mtext-scale 'used-or-eaten) (mtext-scale 'sold) (mtext-scale 'seed))
(mspinner-other 'house-type '(concrete tin thatched) (lambda (v) '())) (mspinner-other 'house-type '(concrete tin thatched) (lambda (v) '()))
(horiz (horiz
(medit-text 'loan "numeric" (lambda (v) '())) (medit-text 'loan "numeric" (lambda (v) (entity-add-value! "loan" "int" v) '()))
(medit-text 'earning "numeric" (lambda (v) '()))) (medit-text 'earning "numeric" (lambda (v) (entity-add-value! "earning" "int" v) '())))
(mtext 'in-the-home) (mtext 'in-the-home)
(horiz (horiz
(mtoggle-button-scale 'radio (lambda (v) '())) (mtoggle-button-scale 'radio (lambda (v) (entity-add-value! "radio" "int" v) '()))
(mtoggle-button-scale 'tv (lambda (v) '())) (mtoggle-button-scale 'tv (lambda (v) (entity-add-value! "tv" "int" v) '()))
(mtoggle-button-scale 'mobile (lambda (v) '()))) (mtoggle-button-scale 'mobile (lambda (v) (entity-add-value! "mobile" "int" v) '())))
(horiz (horiz
(medit-text 'visit-market "numeric" (lambda (v) '())) (medit-text 'visit-market "numeric" (lambda (v) (entity-add-value! "visit-market" "int" v) '()))
(medit-text 'town-sell "numeric" (lambda (v) '()))) (medit-text 'town-sell "numeric" (lambda (v) (entity-add-value! "town-sell" "int" v) '())))
) )
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual income") (set-current! 'activity-title "Individual income")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) '()) (lambda (activity arg)
(list
(mupdate-spinner 'occupation "occupation" '(agriculture gathering labour cows fishing other))
(mupdate 'toggle-button 'contribute "contribute")
(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" '(concrete tin thatched))
(mupdate 'edit-text 'loan "loan")
(mupdate 'edit-text 'earning "earning")
(mupdate 'toggle-button 'radio "radio")
(mupdate 'toggle-button 'tv "tv")
(mupdate 'toggle-button 'mobile "mobile")
(mupdate 'edit-text 'visit-market "visit-market")
(mupdate 'edit-text 'town-sell "town-sell")))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
......
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