Skip to content

GitLab

Commit f2e7fb9e authored by dave griffiths's avatar dave griffiths
Browse files
Options

merged

parents 651e57f3 90a6d104
Hide whitespace changes
Inline Side-by-side
Showing with 7257 additions and 782 deletions
android/AndroidManifest.xml
View file @ f2e7fb9e
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.symbai"
android:versionCode="8"
android:versionCode="10"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
......@@ -26,7 +26,7 @@
<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.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.FriendshipActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.AgreementActivity" android:configChanges="orientation"></activity>
......
android/README.md
View file @ f2e7fb9e
Open Sauces Notebook
====================
A structured notebook for recipes
Symbai android app
==================
android/assets/dbsync.scm
View file @ f2e7fb9e
......@@ -17,6 +17,8 @@
(msg "dbsync.scm")
(define unset-int 2147483647)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
......@@ -88,22 +90,51 @@
(define (entity-get-value 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
(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)))
(if (equal? existing-type type)
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv key type value)))
;;
(begin
(msg "entity-set-value! - adding new " key "of type" type "to entity")
(entity-add-value-create! key type value)))
;; save straight to local db every time
(entity-update-single-value! (list key type value))
))
(cond
((equal? existing-type type)
;; save straight to local db every time (checks for modification)
(entity-update-single-value! (list key type value))
;; then save to memory
(set-current!
'entity-values
(ktv-set
(get-current 'entity-values '())
(ktv 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)
......@@ -163,6 +194,8 @@
(table (get-current 'table #f))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond
((ktv-eq? (ktv-get-whole (get-current 'entity-values '()) (ktv-key ktv)) ktv)
(msg "eusv: no change for" (ktv-key ktv)))
(unique-id
(update-entity db table (entity-id-from-unique db table unique-id) (list ktv)))
(else
......@@ -455,7 +488,7 @@
(list
(network-connect
"network"
"mongoose-web"
"symbai-web"
(lambda (state)
(debug! (string-append "Raspberry Pi connection state now: " state))
(append
......@@ -575,11 +608,25 @@
(layout 'fill-parent 'wrap-content 1 'centre 0)
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)
(vert
(text-view (symbol->id 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"))
(map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0)
......@@ -650,15 +697,19 @@
(define (image-invalid? image-name)
(or (null? 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
;; dispatches based on widget type
(define (mupdate widget-type id-symbol key)
(cond
((or (eq? widget-type 'edit-text) (eq? widget-type 'text-view))
(update-widget widget-type (get-symbol-id id-symbol) 'text
(entity-get-value key)))
(let ((v (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)
(update-widget widget-type (get-symbol-id id-symbol) 'checked
(entity-get-value key)))
......@@ -779,7 +830,7 @@
;; a standard builder for list widgets of entities and a
;; 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
colour-two
(horiz
......@@ -794,7 +845,7 @@
(ktvlist-merge
(ktv-default-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
(make-id (string-append entity-type "-list"))
'vertical
......@@ -802,13 +853,28 @@
(list 0 0 0 0)
(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
(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
(if parent
(db-filter-only db table entity-type
(list (list "parent" "varchar" "=" parent))
(list (list "name" "varchar")))
(map
(lambda (id)
(list id "varchar"))
title-ids))
(db-all db table entity-type))))
(update-widget
'linear-layout
......@@ -820,8 +886,8 @@
(lambda (e)
(button
(make-id (string-append "list-button-" (ktv-get e "unique_id")))
(or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(make-list-widget-title e title-ids)
30 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda ()
(list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results)))))
......@@ -1029,13 +1095,13 @@
(msg "making village" i)
(let ((village (simpsons-village db table village-ktvlist)))
(looper!
3
15
(lambda (i)
(alog "household")
(msg "making household" i)
(let ((household (simpsons-household db table village household-ktvlist)))
(looper!
(random 10)
(+ 2 (random 5))
(lambda (i)
(msg "making individual" i)
(simpsons-individual db table household individual-ktvlist))))))))))
......
android/assets/lib.scm
View file @ f2e7fb9e
......@@ -706,7 +706,7 @@
(define (relative rules colour . l)
(relative-layout
0 (rlayout 'fill-parent 'wrap-content 20 rules)
0 (rlayout 'fill-parent 'wrap-content (list 20 20 20 20) rules)
colour
l))
......@@ -795,7 +795,8 @@
((null? w) #f)
;; drill deeper
((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)))
((eq? (update-widget-token w) 'grid-buttons)
(add-callback! (callback (update-widget-id w)
......@@ -862,6 +863,7 @@
(begin (display "no dialog called ")(display name)(newline))
(let ((events (apply (dialog-fn dialog) args)))
(update-dialogs! events)
(update-callbacks-from-update! events)
(send (scheme->json events))))))
;; called by java
......
android/assets/starwisp.scm
View file @ f2e7fb9e
......@@ -19,7 +19,7 @@
;; colours
(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 colour-one (list 0 0 255 100))
......@@ -41,8 +41,6 @@
(list
(ktv "user-id" "varchar" "not set")
(ktv "language" "int" 0)
(ktv "house-id" "int" 0)
(ktv "photo-id" "int" 0)
(ktv "current-village" "varchar" "none")))
(define (get-setting-value name)
......@@ -62,29 +60,41 @@
;;(display (db-all db "local" "app-settings"))(newline)
(define tribes-list '(khasi other))
(define subtribe-list '(khynriam pnar bhoi war other))
(define education-list '(primary middle high secondary university))
(define married-list '(currently-married currently-single seperated))
(define residence-list '(birthplace spouse-village))
(define gender-list '(male female))
(define house-type-list '(concrete tin thatched other))
(define tribes-list '(not-set khasi no-answered other))
(define subtribe-list '(not-set khynriam pnar bhoi war not-answered other))
(define education-list '(not-set primary middle high secondary university not-answered))
(define married-list '(not-set currently-married currently-single seperated not-answered))
(define residence-list '(not-set birthplace spouse-village not-answered))
(define gender-list '(not-set male female not-answered))
(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-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-residence-list '(same other))
(define social-strength-list '(daily weekly monthly less))
(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 '(not-set same not-answered other))
(define social-strength-list '(not-set daily weekly monthly less not-answered))
(define village-ktvlist
(list
(ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "notes" "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)))
(define household-ktvlist
(list
(ktv "name" "varchar" "")
(ktv "notes" "varchar" "")
(ktv "num-pots" "int" 0)
(ktv "num-children" "int" 0)
(ktv "house-lat" "real" 0) ;; get from current location?
......@@ -94,119 +104,126 @@
(define individual-ktvlist
(list
(ktv "edit-history" "varchar" "")
(ktv "social-edit-history" "varchar" "")
(ktv "name" "varchar" "")
(ktv "notes" "varchar" "")
(ktv "first-name" "varchar" "")
(ktv "family" "varchar" "")
(ktv "photo-id" "varchar" "")
(ktv "photo" "file" "")
(ktv "tribe" "varchar" "")
(ktv "subtribe" "varchar" "")
(ktv "child" "int" 0)
(ktv "age" "int" 0)
(ktv "gender" "varchar" "")
(ktv "literate" "int" 0)
(ktv "education" "varchar" "")
(ktv "agreement-photo" "file" "")
(ktv "agreement-general" "file" "")
(ktv "tribe" "varchar" "not-set")
(ktv "subtribe" "varchar" "not-set")
(ktv "child" "int" -1)
(ktv "age" "int" -1)
(ktv "gender" "varchar" "not-set")
(ktv "literate" "varchar" "not-set")
(ktv "education" "varchar" "not-set")
(ktv "head-of-house" "varchar" "")
(ktv "marital-status" "varchar" "")
(ktv "times-married" "int" 0)
(ktv "marital-status" "varchar" "not-set")
(ktv "times-married" "int" -1)
(ktv "id-spouse" "varchar" "")
(ktv "children-living" "int" 0)
(ktv "children-dead" "int" 0)
(ktv "children-together" "int" 0)
(ktv "children-apart" "int" 0)
(ktv "children-living" "int" -1)
(ktv "children-dead" "int" -1)
(ktv "children-together" "int" -1)
(ktv "children-apart" "int" -1)
(ktv "residence-after-marriage" "varchar" "")
(ktv "num-siblings" "int" 0)
(ktv "birth-order" "int" 0)
(ktv "length-time" "int" 0)
(ktv "num-siblings" "int" -1)
(ktv "birth-order" "int" -1)
(ktv "length-time" "int" -1)
(ktv "place-of-birth" "varchar" "")
(ktv "num-residence-changes" "int" 0)
(ktv "village-visits-month" "int" 0)
(ktv "village-visits-year" "int" 0)
(ktv "occupation-agriculture" "int" 0)
(ktv "occupation-gathering" "int" 0)
(ktv "occupation-labour" "int" 0)
(ktv "occupation-cows" "int" 0)
(ktv "occupation-fishing" "int" 0)
(ktv "num-residence-changes" "int" -1)
(ktv "village-visits-month" "int" -1)
(ktv "village-visits-year" "int" -1)
(ktv "occupation-agriculture" "varchar" "not-set")
(ktv "occupation-gathering" "varchar" "not-set")
(ktv "occupation-labour" "varchar" "not-set")
(ktv "occupation-cows" "varchar" "not-set")
(ktv "occupation-fishing" "varchar" "not-set")
(ktv "occupation-other" "varchar" "")
(ktv "contribute" "int" 0)
(ktv "own-land" "int" 0)
(ktv "rent-land" "int" 0)
(ktv "hire-land" "int" 0)
(ktv "house-type" "varchar" "")
(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)
(ktv "contribute" "varchar" "not-set")
(ktv "own-land" "varchar" "not-set")
(ktv "rent-land" "varchar" "not-set")
(ktv "hire-land" "varchar" "not-set")
(ktv "house-type" "varchar" "not-set")
(ktv "loan" "int" -1)
(ktv "earning" "int" -1)
(ktv "radio" "varchar" "not-set")
(ktv "tv" "varchar" "not-set")
(ktv "mobile" "varchar" "not-set")
(ktv "visit-market" "int" -1)
(ktv "town-sell" "int" -1)
(ktv "social-one" "varchar" "")
(ktv "social-one-nickname" "varchar" "")
(ktv "social-one-relationship" "varchar" "")
(ktv "social-one-residence" "varchar" "")
(ktv "social-one-strength" "varchar" "")
(ktv "social-one-relationship" "varchar" "not-set")
(ktv "social-one-residence" "varchar" "not-set")
(ktv "social-one-strength" "varchar" "not-set")
(ktv "social-two" "varchar" "")
(ktv "social-two-nickname" "varchar" "")
(ktv "social-two-relationship" "varchar" "")
(ktv "social-two-residence" "varchar" "")
(ktv "social-two-strength" "varchar" "")
(ktv "social-two-relationship" "varchar" "not-set")
(ktv "social-two-residence" "varchar" "not-set")
(ktv "social-two-strength" "varchar" "not-set")
(ktv "social-three" "varchar" "")
(ktv "social-three-nickname" "varchar" "")
(ktv "social-three-relationship" "varchar" "")
(ktv "social-three-residence" "varchar" "")
(ktv "social-three-strength" "varchar" "")
(ktv "social-three-relationship" "varchar" "not-set")
(ktv "social-three-residence" "varchar" "not-set")
(ktv "social-three-strength" "varchar" "not-set")
(ktv "social-four" "varchar" "")
(ktv "social-four-nickname" "varchar" "")
(ktv "social-four-relationship" "varchar" "")
(ktv "social-four-residence" "varchar" "")
(ktv "social-four-strength" "varchar" "")
(ktv "social-four-relationship" "varchar" "not-set")
(ktv "social-four-residence" "varchar" "not-set")
(ktv "social-four-strength" "varchar" "not-set")
(ktv "social-five" "varchar" "")
(ktv "social-five-nickname" "varchar" "")
(ktv "social-five-relationship" "varchar" "")
(ktv "social-five-residence" "varchar" "")
(ktv "social-five-strength" "varchar" "")
(ktv "social-five-relationship" "varchar" "not-set")
(ktv "social-five-residence" "varchar" "not-set")
(ktv "social-five-strength" "varchar" "not-set")
(ktv "friendship-one" "varchar" "")
(ktv "friendship-one-nickname" "varchar" "")
(ktv "friendship-one-relationship" "varchar" "")
(ktv "friendship-one-residence" "varchar" "")
(ktv "friendship-one-strength" "varchar" "")
(ktv "friendship-one-relationship" "varchar" "not-set")
(ktv "friendship-one-residence" "varchar" "not-set")
(ktv "friendship-one-strength" "varchar" "not-set")
(ktv "friendship-two" "varchar" "")
(ktv "friendship-two-nickname" "varchar" "")
(ktv "friendship-two-relationship" "varchar" "")
(ktv "friendship-two-residence" "varchar" "")
(ktv "friendship-two-strength" "varchar" "")
(ktv "friendship-two-relationship" "varchar" "not-set")
(ktv "friendship-two-residence" "varchar" "not-set")
(ktv "friendship-two-strength" "varchar" "not-set")
(ktv "friendship-three" "varchar" "")
(ktv "friendship-three-nickname" "varchar" "")
(ktv "friendship-three-relationship" "varchar" "")
(ktv "friendship-three-residence" "varchar" "")
(ktv "friendship-three-strength" "varchar" "")
(ktv "friendship-three-relationship" "varchar" "not-set")
(ktv "friendship-three-residence" "varchar" "not-set")
(ktv "friendship-three-strength" "varchar" "not-set")
(ktv "friendship-four" "varchar" "")
(ktv "friendship-four-nickname" "varchar" "")
(ktv "friendship-four-relationship" "varchar" "")
(ktv "friendship-four-residence" "varchar" "")
(ktv "friendship-four-strength" "varchar" "")
(ktv "friendship-four-relationship" "varchar" "not-set")
(ktv "friendship-four-residence" "varchar" "not-set")
(ktv "friendship-four-strength" "varchar" "not-set")
(ktv "friendship-five" "varchar" "")
(ktv "friendship-five-nickname" "varchar" "")
(ktv "friendship-five-relationship" "varchar" "")
(ktv "friendship-five-residence" "varchar" "")
(ktv "friendship-five-strength" "varchar" "")
(ktv "friendship-five-relationship" "varchar" "not-set")
(ktv "friendship-five-residence" "varchar" "not-set")
(ktv "friendship-five-strength" "varchar" "not-set")
))
(define crop-ktvlist
(list
(ktv "name" "varchar" (mtext-lookup 'default-crop-name))
(ktv "notes" "varchar" "")
(ktv "unit" "varchar" "unit")
(ktv "used" "real" 0)
(ktv "sold" "real" 0)
(ktv "used" "real" -1)
(ktv "sold" "real" -1)
(ktv "seed" "varchar" "")))
(define child-ktvlist
(list
(ktv "name" "varchar" (mtext-lookup 'default-child-name))
(ktv "alive" "int" 1)
(ktv "gender" "varchar" "")
(ktv "age" "int" 0)
(ktv "living-at-home" "int" 0)))
(ktv "notes" "varchar" "")
(ktv "alive" "varchar" "varchar" "not-set")
(ktv "gender" "varchar" "not-set")
(ktv "age" "int" -1)
(ktv "living-at-home" "varchar" "not-set")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -219,21 +236,68 @@
(update-widget 'debug-text-view (get-id "sync-debug") 'text
(get-current 'debug-text "")))
;; return last element from comma seperated list
(define (history-get-last txt)
(let ((l (string-split txt '(#\:))))
(if (null? l) ""
(car (reverse l)))))
(define (contains-social? ktv-list)
(foldl
(lambda (ktv r)
(if (and
(not r)
(> (string-length (ktv-key ktv)) 5)
(or
(equal? (substring (ktv-key ktv) 0 6) "friend")
(equal? (substring (ktv-key ktv) 0 6) "social")))
#t r))
#f ktv-list))
;; go through each dirty entity and stick the user id
;; on the end of the edit history lists - only for individuals
(define (update-edit-history db table user-id)
;; get dirty individual entities
(let ((de (db-select
db (string-append
"select entity_id from "
table "_entity where dirty=1 and entity_type='individual';"))))
(when (not (null? de))
(for-each
(lambda (i)
(let* ((entity-id (vector-ref i 0))
(dirty-items (dbg (get-entity-plain-for-sync db table entity-id))))
(when (not (null? dirty-items))
;; check if social change
(let ((type (if (contains-social? dirty-items) "social-edit-history" "edit-history")))
;; check if last editor is different
(let ((editors (car (get-value db table entity-id (list type "varchar")))))
(when (or (equal? editors "") (not (equal? (history-get-last editors) user-id)))