Commit 3964b835 authored by Dave Griffiths's avatar Dave Griffiths

spinner-other fixed

parent 7783bb0a
......@@ -145,13 +145,11 @@
(let ((db (get-current 'db #f))
(table (get-current 'table #f)))
;; standard bits
(let ((values (get-current 'entity-values '()))
(let ((values (dbg (get-current 'entity-values '())))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond
((and unique-id (not (null? values)))
(update-entity db table (entity-id-from-unique db table unique-id) values)
(msg "updated " unique-id)
(msg values)
;; removed due to save button no longer exiting activity - need to keep!
;;(entity-reset!)
)
......@@ -177,8 +175,6 @@
(define url "http://192.168.2.1:8889/symbai?")
(msg "url")
(define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) ":" (number->string (ktv-version ktv)) "=" (stringify-value-url ktv)))
......@@ -517,7 +513,14 @@
(spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0)
(lambda (c) (fn c))))
(lambda (c)
(msg "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
(msg c)
(msg (length types))
;; dont call if set to "other"
(if (< c (- (length types) 1))
(fn c)
'()))))
(vert
(mtext-scale 'other)
(edit-text (make-id (string-append (symbol->string id) "-edit-text"))
......@@ -537,7 +540,13 @@
(spinner (make-id (string-append (symbol->string id) "-spinner"))
(map mtext-lookup types)
(layout 'wrap-content 'wrap-content 1 'centre 0)
(lambda (c) (fn c)))
(lambda (c)
(msg "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
(msg c)
(msg (length types))
;; dont call if set to "other"
(if (< c (- (length types) 1))
(fn c) '())))
(mtext-scale 'other)
(edit-text (make-id (string-append (symbol->string id) "-edit-text"))
"" 30 "normal"
......@@ -582,7 +591,9 @@
(else (msg "mupdate-widget unhandled widget type" widget-type))))
(define (spinner-choice l i)
(symbol->string (list-ref l i)))
(if (number? i)
(symbol->string (list-ref l i))
i))
(define (mupdate-spinner id-symbol key choices)
(let* ((val (entity-get-value key)))
......@@ -602,19 +613,23 @@
'selection 0)))))))
(define (mupdate-spinner-other id-symbol key choices)
(let* ((val (dbg (entity-get-value key))))
(let* ((val (entity-get-value key)))
(if (not val)
(update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection 0)
(list (update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection 0))
(let ((index (index-find (string->symbol val) choices)))
(if index
(update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection index)
(update-widget 'edit-text
(get-id (string-append (symbol->string id-symbol) "-edit-text"))
'selection index))))))
(list (update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection index))
(list
(update-widget 'spinner
(get-id (string-append (symbol->string id-symbol) "-spinner"))
'selection (- (length choices) 1))
(update-widget 'edit-text
(get-id (string-append (symbol->string id-symbol) "-edit-text"))
'text val)))))))
;;;;
;; (y m d h m s)
......@@ -712,7 +727,6 @@
(or (ktv-get e "name") "Unamed item")
40 (layout 'fill-parent 'wrap-content 1 'centre 5)
(lambda ()
(msg "sending start act" (ktv-get e "unique_id"))
(list (start-activity edit-activity 0 (ktv-get e "unique_id"))))))
search-results)))))
......@@ -738,9 +752,9 @@
(lambda (e)
(list (ktv-get e "name")
(ktv-get e "unique_id")))
(dbg (db-filter-only db table entity-type
(list)
(list (list "name" "varchar"))))))
(db-filter-only db table entity-type
(list)
(list (list "name" "varchar")))))
(define vowel (map symbol->string (list 'a 'e 'i 'o 'u)))
......
......@@ -41,7 +41,7 @@
;; basic key/type/value structure
;; used for all data internally, and maps to the eavdb types
(define (ktv key type value) (list key type value -999))
(define (ktv key type value) (list key type value 0))
(define (ktv-with-version key type value version) (list key type value version))
(define (ktv-create key type value) (list key type value 0))
(define ktv-key car)
......
......@@ -66,7 +66,7 @@
(define residence-list '(birthplace spouse-village))
(define gender-list '(male female))
(define occupation-list '(agriculture gathering labour cows fishing other))
(define house-type-list '(concrete tin thatched))
(define house-type-list '(concrete tin thatched other))
(define social-types-list '(friendship 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))
......@@ -297,8 +297,6 @@
)
(msg "one")
(define (build-activity . contents)
(vert-fill
(relative
......@@ -444,13 +442,10 @@
;; need to load from across entities, so need db, table
(define (update-person-selector db table id key)
(msg "update-person-selector" key)
(let ((entity-id (entity-get-value key)))
(msg "entity-id is" entity-id)
(let ((image-name (image/name-from-unique-id db table entity-id))
(id (get-id (string-append (symbol->string id) "-image")))
(text-id (get-id (string-append (symbol->string id) "-text"))))
(msg "image-name is" (cadr image-name) (image-invalid? (cadr image-name)))
(if (image-invalid? (cadr image-name))
(list
(update-widget 'image-view id 'image "face")
......@@ -501,18 +496,19 @@
(entity-set-value! key "varchar" (get-current 'choose-result "not set"))))
(define (update-social-connection db table id key type request-code)
(msg "update-social-connection")
(let ((id-text (string-append (symbol->string id))))
(append
(update-person-selector db table id key)
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(list
(mupdate-spinner-other
(string->symbol (string-append id-text "-relationship"))
(string-append key "-relationship")
social-relationship-list)
(mupdate-spinner-other
(string->symbol (string-append id-text "-residence"))
(string-append key "-residence")
social-residence-list)
(mupdate-spinner
(string->symbol (dbg (string-append id-text "-strength")))
(string-append key "-strength")
......@@ -702,7 +698,6 @@
(set-current! 'activity-title "Household List")
(activity-layout activity))
(lambda (activity arg)
(msg "rebuilding household list with" arg)
(list (update-list-widget
db "sync" "household" "household" arg)))
(lambda (activity) '())
......@@ -837,7 +832,7 @@
(medit-text 'details-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
(medit-text 'details-family "normal" (lambda (v) (entity-set-value! "family" "varchar" v) '()))
(medit-text 'details-photo-id "normal" (lambda (v) (entity-set-value! "photo-id" "varchar" v) '()))))
(mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '()))
(mspinner-other 'tribe tribes-list (lambda (v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '()))
(mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '()))
(horiz
(medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '()))
......@@ -850,13 +845,13 @@
(lambda (activity arg)
(append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(mupdate-spinner-other 'tribe "tribe" tribes-list)
(mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
(list
(mupdate 'edit-text 'details-name "name")
(mupdate 'edit-text 'details-family "family")
(mupdate 'edit-text 'details-photo-id "photo-id")
(mupdate 'image-view 'photo "photo")
(mupdate-spinner-other 'tribe "tribe" tribes-list)
(mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
(mupdate 'edit-text 'age "age")
(mupdate-spinner 'gender "gender" gender-list)
(mupdate-spinner 'education "education" education-list)
......@@ -938,8 +933,7 @@
(when (and (eqv? requestcode spouse-request-code)
(get-current 'choose-result #f))
(update-entity db "sync" (entity-id-from-unique db "sync" (get-current 'choose-result #f))
(list (ktv "id-spouse" "varchar" (entity-get-value "unique_id"))))
(msg "done..."))
(list (ktv "id-spouse" "varchar" (entity-get-value "unique_id")))))
;; save and reinit otherwise we can get out of sync here with the spouse :/
(let ((unique-id (entity-get-value "unique_id")))
......@@ -954,9 +948,6 @@
(build-activity
(mspinner 'move-household '()
(lambda (v)
(msg v)
(msg (number? v))
(msg (list-ref (get-current 'move-household-list '()) v))
(entity-set-value!
"parent" "varchar"
(cadr (list-ref (get-current 'move-household-list '()) v)))
......@@ -1044,6 +1035,7 @@
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" (get-current 'individual #f)))
(append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(mupdate-spinner-other 'house-type "house-type" house-type-list)
(list
(update-list-widget db "sync" "crop" "crop" (get-current 'individual #f))
(mupdate-spinner 'occupation "occupation" occupation-list)
......@@ -1051,7 +1043,6 @@
(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" house-type-list)
(mupdate 'edit-text 'loan "loan")
(mupdate 'edit-text 'earning "earning")
(mupdate 'toggle-button 'radio "radio")
......@@ -1178,7 +1169,6 @@
(set-current! 'activity-title "Individual social network")
(activity-layout activity))
(lambda (activity arg)
(msg "wooooop")
(append
(update-top-bar (entity-get-value "name") (entity-get-value "photo-id"))
(list
......@@ -1258,7 +1248,6 @@
(lambda (v)
(cond
((eqv? v 1)
(msg "adding new person quickly")
(set-current!
'choose-result
(entity-create!
......
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