Commit f2e7fb9e authored by dave griffiths's avatar dave griffiths

merged

parents 651e57f3 90a6d104
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" <manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbai" package="foam.symbai"
android:versionCode="8" android:versionCode="10"
android:versionName="1.0"> android:versionName="1.0">
<application android:label="@string/app_name" <application android:label="@string/app_name"
android:icon="@drawable/logo" android:icon="@drawable/logo"
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
<activity android:name="foam.symbai.FamilyActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.FamilyActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.MigrationActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.MigrationActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.IncomeActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.IncomeActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.GeneaologyActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.GenealogyActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.SocialActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.SocialActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.FriendshipActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.FriendshipActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.AgreementActivity" android:configChanges="orientation"></activity> <activity android:name="foam.symbai.AgreementActivity" android:configChanges="orientation"></activity>
......
Open Sauces Notebook Symbai android app
==================== ==================
A structured notebook for recipes
...@@ -17,6 +17,8 @@ ...@@ -17,6 +17,8 @@
(msg "dbsync.scm") (msg "dbsync.scm")
(define unset-int 2147483647)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory ;; stuff in memory
...@@ -88,22 +90,51 @@ ...@@ -88,22 +90,51 @@
(define (entity-get-value key) (define (entity-get-value key)
(ktv-get (get-current 'entity-values '()) key)) (ktv-get (get-current 'entity-values '()) key))
(define (check-type type value)
(cond
((equal? type "varchar")
(string? value))
((equal? type "file")
(string? value))
((equal? type "int")
(number? value))
((equal? type "real")
(number? value))))
;; version to check the entity has the key ;; version to check the entity has the key
(define (entity-set-value! key type value) (define (entity-set-value! key type value)
(when (not (check-type type value))
(msg "INCORRECT TYPE FOR" key ":" type ":" value))
(let ((existing-type (ktv-get-type (get-current 'entity-values '()) key))) (let ((existing-type (ktv-get-type (get-current 'entity-values '()) key)))
(if (equal? existing-type type) (cond
(set-current! ((equal? existing-type type)
'entity-values ;; save straight to local db every time (checks for modification)
(ktv-set (entity-update-single-value! (list key type value))
(get-current 'entity-values '()) ;; then save to memory
(ktv key type value))) (set-current!
;; 'entity-values
(begin (ktv-set
(msg "entity-set-value! - adding new " key "of type" type "to entity") (get-current 'entity-values '())
(entity-add-value-create! key type value))) (ktv key type value))))
;; save straight to local db every time ;;
(entity-update-single-value! (list key type value)) (else
)) (msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value))
)))
;; version to check the entity has the key
(define (entity-set-value-mem! key type value)
(when (not (check-type type value))
(msg "INCORRECT TYPE FOR" key ":" type ":" value))
;; then save to memory
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value))))
(define (date-time->string dt) (define (date-time->string dt)
...@@ -163,6 +194,8 @@ ...@@ -163,6 +194,8 @@
(table (get-current 'table #f)) (table (get-current 'table #f))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id"))) (unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond (cond
((ktv-eq? (ktv-get-whole (get-current 'entity-values '()) (ktv-key ktv)) ktv)
(msg "eusv: no change for" (ktv-key ktv)))
(unique-id (unique-id
(update-entity db table (entity-id-from-unique db table unique-id) (list ktv))) (update-entity db table (entity-id-from-unique db table unique-id) (list ktv)))
(else (else
...@@ -455,7 +488,7 @@ ...@@ -455,7 +488,7 @@
(list (list
(network-connect (network-connect
"network" "network"
"mongoose-web" "symbai-web"
(lambda (state) (lambda (state)
(debug! (string-append "Raspberry Pi connection state now: " state)) (debug! (string-append "Raspberry Pi connection state now: " state))
(append (append
...@@ -575,11 +608,25 @@ ...@@ -575,11 +608,25 @@
(layout 'fill-parent 'wrap-content 1 'centre 0) (layout 'fill-parent 'wrap-content 1 'centre 0)
fn)))) fn))))
(define (medit-text-large id type fn)
(linear-layout
(make-id (string-append (symbol->string id) "-container"))
'vertical
(layout 'fill-parent 'wrap-content 1 'centre 20)
(list 0 0 0 0)
(list
(text-view 0 (mtext-lookup id)
30 (layout 'wrap-content 'wrap-content -1 'centre 0))
(edit-text (symbol->id id) "" 30 type
(layout 'fill-parent 300 -1 'left 0)
fn))))
(define (mspinner id types fn) (define (mspinner id types fn)
(vert (vert
(text-view (symbol->id id) (text-view (symbol->id id)
(mtext-lookup id) (mtext-lookup id)
30 (layout 'wrap-content 'wrap-content 1 'centre 10)) 30 (layout 'wrap-content 'wrap-content 1 'centre 0))
(spinner (make-id (string-append (symbol->string id) "-spinner")) (spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types) (map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0) (layout 'wrap-content 'wrap-content 1 'centre 0)
...@@ -650,15 +697,19 @@ ...@@ -650,15 +697,19 @@
(define (image-invalid? image-name) (define (image-invalid? image-name)
(or (null? image-name) (or (null? image-name)
(not image-name) (not image-name)
(equal? image-name "none"))) (equal? image-name "none")
(equal? image-name "")))
;; fill out the widget from the current entity in the memory store ;; fill out the widget from the current entity in the memory store
;; dispatches based on widget type ;; dispatches based on widget type
(define (mupdate widget-type id-symbol key) (define (mupdate widget-type id-symbol key)
(cond (cond
((or (eq? widget-type 'edit-text) (eq? widget-type 'text-view)) ((or (eq? widget-type 'edit-text) (eq? widget-type 'text-view))
(update-widget widget-type (get-symbol-id id-symbol) 'text (let ((v (entity-get-value key)))
(entity-get-value key))) (update-widget widget-type (get-symbol-id id-symbol) 'text
;; hide -1 as it represents unset
(if (and (number? v) (eqv? v -1))
"" v))))
((eq? widget-type 'toggle-button) ((eq? widget-type 'toggle-button)
(update-widget widget-type (get-symbol-id id-symbol) 'checked (update-widget widget-type (get-symbol-id id-symbol) 'checked
(entity-get-value key))) (entity-get-value key)))
...@@ -779,7 +830,7 @@ ...@@ -779,7 +830,7 @@
;; a standard builder for list widgets of entities and a ;; a standard builder for list widgets of entities and a
;; make new button, to add defaults to the list ;; make new button, to add defaults to the list
(define (build-list-widget db table title entity-type edit-activity parent-fn ktv-default-fn) (define (build-list-widget db table title title-ids entity-type edit-activity parent-fn ktv-default-fn)
(vert-colour (vert-colour
colour-two colour-two
(horiz (horiz
...@@ -794,7 +845,7 @@ ...@@ -794,7 +845,7 @@
(ktvlist-merge (ktvlist-merge
(ktv-default-fn) (ktv-default-fn)
(list (ktv "parent" "varchar" (parent-fn))))) (list (ktv "parent" "varchar" (parent-fn)))))
(list (update-list-widget db table entity-type edit-activity (parent-fn)))))) (list (update-list-widget db table title-ids entity-type edit-activity (parent-fn))))))
(linear-layout (linear-layout
(make-id (string-append entity-type "-list")) (make-id (string-append entity-type "-list"))
'vertical 'vertical
...@@ -802,13 +853,28 @@ ...@@ -802,13 +853,28 @@
(list 0 0 0 0) (list 0 0 0 0)
(list)))) (list))))
(define (make-list-widget-title e title-ids)
(if (eqv? (length title-ids) 1)
(ktv-get e (car title-ids))
(string-append
(ktv-get e (car title-ids)) "\n"
(foldl
(lambda (id r)
(if (equal? r "")
(ktv-get e id)
(string-append r " " (ktv-get e id))))
"" (cdr title-ids)))))
;; pull db data into list of button widgets ;; pull db data into list of button widgets
(define (update-list-widget db table entity-type edit-activity parent) (define (update-list-widget db table title-ids entity-type edit-activity parent)
(let ((search-results (let ((search-results
(if parent (if parent
(db-filter-only db table entity-type (db-filter-only db table entity-type
(list (list "parent" "varchar" "=" parent)) (list (list "parent" "varchar" "=" parent))
(list (list "name" "varchar"))) (map
(lambda (id)
(list id "varchar"))
title-ids))
(db-all db table entity-type)))) (db-all db table entity-type))))
(update-widget (update-widget
'linear-layout 'linear-layout
...@@ -820,8 +886,8 @@ ...@@ -820,8 +886,8 @@
(lambda (e) (lambda (e)
(button (button
(make-id (string-append "list-button-" (ktv-get e "unique_id"))) (make-id (string-append "list-button-" (ktv-get e "unique_id")))
(or (ktv-get e "name") "Unamed item") (make-list-widget-title e title-ids)
40 (layout 'fill-parent 'wrap-content 1 'centre 5) 30 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda () (lambda ()
(list (start-activity edit-activity 0 (ktv-get e "unique_id")))))) (list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results))))) search-results)))))
...@@ -1029,13 +1095,13 @@ ...@@ -1029,13 +1095,13 @@
(msg "making village" i) (msg "making village" i)
(let ((village (simpsons-village db table village-ktvlist))) (let ((village (simpsons-village db table village-ktvlist)))
(looper! (looper!
3 15
(lambda (i) (lambda (i)
(alog "household") (alog "household")
(msg "making household" i) (msg "making household" i)
(let ((household (simpsons-household db table village household-ktvlist))) (let ((household (simpsons-household db table village household-ktvlist)))
(looper! (looper!
(random 10) (+ 2 (random 5))
(lambda (i) (lambda (i)
(msg "making individual" i) (msg "making individual" i)
(simpsons-individual db table household individual-ktvlist)))))))))) (simpsons-individual db table household individual-ktvlist))))))))))
......
...@@ -706,7 +706,7 @@ ...@@ -706,7 +706,7 @@
(define (relative rules colour . l) (define (relative rules colour . l)
(relative-layout (relative-layout
0 (rlayout 'fill-parent 'wrap-content 20 rules) 0 (rlayout 'fill-parent 'wrap-content (list 20 20 20 20) rules)
colour colour
l)) l))
...@@ -795,7 +795,8 @@ ...@@ -795,7 +795,8 @@
((null? w) #f) ((null? w) #f)
;; drill deeper ;; drill deeper
((eq? (update-widget-token w) 'contents) ((eq? (update-widget-token w) 'contents)
(msg "updateing contents from callback") (update-callbacks! (update-widget-value w)))
((eq? (update-widget-token w) 'contents-add)
(update-callbacks! (update-widget-value w))) (update-callbacks! (update-widget-value w)))
((eq? (update-widget-token w) 'grid-buttons) ((eq? (update-widget-token w) 'grid-buttons)
(add-callback! (callback (update-widget-id w) (add-callback! (callback (update-widget-id w)
...@@ -862,6 +863,7 @@ ...@@ -862,6 +863,7 @@
(begin (display "no dialog called ")(display name)(newline)) (begin (display "no dialog called ")(display name)(newline))
(let ((events (apply (dialog-fn dialog) args))) (let ((events (apply (dialog-fn dialog) args)))
(update-dialogs! events) (update-dialogs! events)
(update-callbacks-from-update! events)
(send (scheme->json events)))))) (send (scheme->json events))))))
;; called by java ;; called by java
......
...@@ -19,7 +19,7 @@ ...@@ -19,7 +19,7 @@
;; colours ;; colours
(msg "starting up....") (msg "starting up....")
(define entity-types (list "village" "household" "individual")) (define entity-types (list "village" "household" "individual" "child" "crop"))
(define trans-col (list 0 0 0 0)) (define trans-col (list 0 0 0 0))
(define colour-one (list 0 0 255 100)) (define colour-one (list 0 0 255 100))
...@@ -41,8 +41,6 @@ ...@@ -41,8 +41,6 @@
(list (list
(ktv "user-id" "varchar" "not set") (ktv "user-id" "varchar" "not set")
(ktv "language" "int" 0) (ktv "language" "int" 0)
(ktv "house-id" "int" 0)
(ktv "photo-id" "int" 0)
(ktv "current-village" "varchar" "none"))) (ktv "current-village" "varchar" "none")))
(define (get-setting-value name) (define (get-setting-value name)
...@@ -62,29 +60,41 @@ ...@@ -62,29 +60,41 @@
;;(display (db-all db "local" "app-settings"))(newline) ;;(display (db-all db "local" "app-settings"))(newline)
(define tribes-list '(khasi other)) (define tribes-list '(not-set khasi no-answered other))
(define subtribe-list '(khynriam pnar bhoi war other)) (define subtribe-list '(not-set khynriam pnar bhoi war not-answered other))
(define education-list '(primary middle high secondary university)) (define education-list '(not-set primary middle high secondary university not-answered))
(define married-list '(currently-married currently-single seperated)) (define married-list '(not-set currently-married currently-single seperated not-answered))
(define residence-list '(birthplace spouse-village)) (define residence-list '(not-set birthplace spouse-village not-answered))
(define gender-list '(male female)) (define gender-list '(not-set male female not-answered))
(define house-type-list '(concrete tin thatched other)) (define house-type-list '(not-set concrete tin thatched not-answered other))
(define yesno-list '(not-set yes no not-answered))
(define social-types-list '(knowledge prestige)) (define social-types-list '(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)) (define social-relationship-list '(not-set mother father sister brother spouse children co-wife spouse-mother spouse-father spouse-brother-wife spouse-sister-husband friend neighbour not-answered other))
(define social-residence-list '(same other)) (define social-residence-list '(not-set same not-answered other))
(define social-strength-list '(daily weekly monthly less)) (define social-strength-list '(not-set daily weekly monthly less not-answered))
(define village-ktvlist (define village-ktvlist
(list (list
(ktv "name" "varchar" (mtext-lookup 'default-village-name)) (ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "notes" "varchar" "")
(ktv "block" "varchar" "") (ktv "block" "varchar" "")
(ktv "district" "varchar" "test") (ktv "district" "varchar" "")
(ktv "school-closest-access" "varchar" "")
(ktv "hospital-closest-access" "varchar" "")
(ktv "post-office-closest-access" "varchar" "")
(ktv "railway-station-closest-access" "varchar" "")
(ktv "state-bus-service-closest-access" "varchar" "")
(ktv "district-bus-service-closest-access" "varchar" "")
(ktv "panchayat-closest-access" "varchar" "")
(ktv "ngo-closest-access" "varchar" "")
(ktv "market-closest-access" "varchar" "")
(ktv "car" "int" 0))) (ktv "car" "int" 0)))
(define household-ktvlist (define household-ktvlist
(list (list
(ktv "name" "varchar" "") (ktv "name" "varchar" "")
(ktv "notes" "varchar" "")
(ktv "num-pots" "int" 0) (ktv "num-pots" "int" 0)
(ktv "num-children" "int" 0) (ktv "num-children" "int" 0)
(ktv "house-lat" "real" 0) ;; get from current location? (ktv "house-lat" "real" 0) ;; get from current location?
...@@ -94,119 +104,126 @@ ...@@ -94,119 +104,126 @@
(define individual-ktvlist (define individual-ktvlist
(list (list
(ktv "edit-history" "varchar" "")
(ktv "social-edit-history" "varchar" "")
(ktv "name" "varchar" "") (ktv "name" "varchar" "")
(ktv "notes" "varchar" "")
(ktv "first-name" "varchar" "") (ktv "first-name" "varchar" "")
(ktv "family" "varchar" "") (ktv "family" "varchar" "")
(ktv "photo-id" "varchar" "") (ktv "photo-id" "varchar" "")
(ktv "photo" "file" "") (ktv "photo" "file" "")
(ktv "tribe" "varchar" "") (ktv "agreement-photo" "file" "")
(ktv "subtribe" "varchar" "") (ktv "agreement-general" "file" "")
(ktv "child" "int" 0) (ktv "tribe" "varchar" "not-set")
(ktv "age" "int" 0) (ktv "subtribe" "varchar" "not-set")
(ktv "gender" "varchar" "") (ktv "child" "int" -1)
(ktv "literate" "int" 0) (ktv "age" "int" -1)
(ktv "education" "varchar" "") (ktv "gender" "varchar" "not-set")
(ktv "literate" "varchar" "not-set")
(ktv "education" "varchar" "not-set")
(ktv "head-of-house" "varchar" "") (ktv "head-of-house" "varchar" "")
(ktv "marital-status" "varchar" "") (ktv "marital-status" "varchar" "not-set")
(ktv "times-married" "int" 0) (ktv "times-married" "int" -1)
(ktv "id-spouse" "varchar" "") (ktv "id-spouse" "varchar" "")
(ktv "children-living" "int" 0) (ktv "children-living" "int" -1)
(ktv "children-dead" "int" 0) (ktv "children-dead" "int" -1)
(ktv "children-together" "int" 0) (ktv "children-together" "int" -1)
(ktv "children-apart" "int" 0) (ktv "children-apart" "int" -1)
(ktv "residence-after-marriage" "varchar" "") (ktv "residence-after-marriage" "varchar" "")
(ktv "num-siblings" "int" 0) (ktv "num-siblings" "int" -1)
(ktv "birth-order" "int" 0) (ktv "birth-order" "int" -1)
(ktv "length-time" "int" 0) (ktv "length-time" "int" -1)
(ktv "place-of-birth" "varchar" "") (ktv "place-of-birth" "varchar" "")
(ktv "num-residence-changes" "int" 0) (ktv "num-residence-changes" "int" -1)
(ktv "village-visits-month" "int" 0) (ktv "village-visits-month" "int" -1)
(ktv "village-visits-year" "int" 0) (ktv "village-visits-year" "int" -1)
(ktv "occupation-agriculture" "int" 0) (ktv "occupation-agriculture" "varchar" "not-set")
(ktv "occupation-gathering" "int" 0) (ktv "occupation-gathering" "varchar" "not-set")
(ktv "occupation-labour" "int" 0) (ktv "occupation-labour" "varchar" "not-set")
(ktv "occupation-cows" "int" 0) (ktv "occupation-cows" "varchar" "not-set")
(ktv "occupation-fishing" "int" 0) (ktv "occupation-fishing" "varchar" "not-set")
(ktv "occupation-other" "varchar" "") (ktv "occupation-other" "varchar" "")
(ktv "contribute" "int" 0) (ktv "contribute" "varchar" "not-set")
(ktv "own-land" "int" 0) (ktv "own-land" "varchar" "not-set")
(ktv "rent-land" "int" 0) (ktv "rent-land" "varchar" "not-set")
(ktv "hire-land" "int" 0) (ktv "hire-land" "varchar" "not-set")
(ktv "house-type" "varchar" "") (ktv "house-type" "varchar" "not-set")
(ktv "loan" "int" 0) (ktv "loan" "int" -1)
(ktv "earning" "int" 0) (ktv "earning" "int" -1)
(ktv "radio" "int" 0) (ktv "radio" "varchar" "not-set")
(ktv "tv" "int" 0) (ktv "tv" "varchar" "not-set")
(ktv "mobile" "int" 0) (ktv "mobile" "varchar" "not-set")
(ktv "visit-market" "int" 0) (ktv "visit-market" "int" -1)
(ktv "town-sell" "int" 0) (ktv "town-sell" "int" -1)
(ktv "social-one" "varchar" "") (ktv "social-one" "varchar" "")
(ktv "social-one-nickname" "varchar" "") (ktv "social-one-nickname" "varchar" "")
(ktv "social-one-relationship" "varchar" "") (ktv "social-one-relationship" "varchar" "not-set")
(ktv "social-one-residence" "varchar" "") (ktv "social-one-residence" "varchar" "not-set")
(ktv "social-one-strength" "varchar" "") (ktv "social-one-strength" "varchar" "not-set")
(ktv "social-two" "varchar" "") (ktv "social-two" "varchar" "")
(ktv "social-two-nickname" "varchar" "") (ktv "social-two-nickname" "varchar" "")
(ktv "social-two-relationship" "varchar" "") (ktv "social-two-relationship" "varchar" "not-set")
(ktv "social-two-residence" "varchar" "") (ktv "social-two-residence" "varchar" "not-set")
(ktv "social-two-strength" "varchar" "") (ktv "social-two-strength" "varchar" "not-set")
(ktv "social-three" "varchar" "") (ktv "social-three" "varchar" "")
(ktv "social-three-nickname" "varchar" "") (ktv "social-three-nickname" "varchar" "")
(ktv "social-three-relationship" "varchar" "") (ktv "social-three-relationship" "varchar" "not-set")
(ktv "social-three-residence" "varchar" "") (ktv "social-three-residence" "varchar" "not-set")
(ktv "social-three-strength" "varchar" "") (ktv "social-three-strength" "varchar" "not-set")
(ktv "social-four" "varchar" "") (ktv "social-four" "varchar" "")
(ktv "social-four-nickname" "varchar" "") (ktv "social-four-nickname" "varchar" "")