Commit d4fecbf6 authored by Dave Griffiths's avatar Dave Griffiths

agreements/unlock

parent dd9366ef
...@@ -111,6 +111,8 @@ ...@@ -111,6 +111,8 @@
(ktv "family" "varchar" "") (ktv "family" "varchar" "")
(ktv "photo-id" "varchar" "") (ktv "photo-id" "varchar" "")
(ktv "photo" "file" "") (ktv "photo" "file" "")
(ktv "agreement-photo" "file" "")
(ktv "agreement-general" "file" "")
(ktv "tribe" "varchar" "not-set") (ktv "tribe" "varchar" "not-set")
(ktv "subtribe" "varchar" "not-set") (ktv "subtribe" "varchar" "not-set")
(ktv "child" "int" -1) (ktv "child" "int" -1)
...@@ -234,7 +236,7 @@ ...@@ -234,7 +236,7 @@
;; return last element from comma seperated list ;; return last element from comma seperated list
(define (history-get-last txt) (define (history-get-last txt)
(let ((l (string-split txt '(#\,)))) (let ((l (string-split txt '(#\:))))
(if (null? l) "" (if (null? l) ""
(car (reverse l))))) (car (reverse l)))))
...@@ -273,7 +275,7 @@ ...@@ -273,7 +275,7 @@
(msg "history - setting" type) (msg "history - setting" type)
(if (equal? editors "") (if (equal? editors "")
(update-value db table entity-id (ktv type "varchar" (dbg user-id))) (update-value db table entity-id (ktv type "varchar" (dbg user-id)))
(update-value db table entity-id (ktv type "varchar" (dbg (string-append editors "," user-id))))))))))) (update-value db table entity-id (ktv type "varchar" (dbg (string-append editors ":" user-id)))))))))))
(cdr de))))) (cdr de)))))
(define (debug-timer-cb) (define (debug-timer-cb)
...@@ -1087,7 +1089,17 @@ ...@@ -1087,7 +1089,17 @@
"individual" "individual"
(build-activity (build-activity
(horiz (horiz
(image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10)) (vert
(image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
(mbutton
'change-photo
(lambda ()
(set-current!
'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
(list
(take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
)))
(vert (vert
(mtext 'name-display) (mtext 'name-display)
(spacer 20) (spacer 20)
...@@ -1122,9 +1134,28 @@ ...@@ -1122,9 +1134,28 @@
(set-current! 'activity-title "Individual") (set-current! 'activity-title "Individual")
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg)) (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg))
(set-current! 'individual arg) (set-current! 'individual arg)
(msg "individual on create")
(append (append
(update-top-bar) (update-top-bar)
(list (list
(update-widget 'button (get-id "details-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "family-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "migration-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "income-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "genealogy-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "friendship-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "social-button") 'set-enabled
(if (equal? (entity-get-value "agreement-general") "") 0 1))
(update-widget 'button (get-id "change-photo") 'set-enabled
(if (equal? (entity-get-value "agreement-photo") "") 0 1))
(update-widget 'text-view (get-id "last-editor") 'text (update-widget 'text-view (get-id "last-editor") 'text
(string-append "Last edit by " (history-get-last (entity-get-value "edit-history")))) (string-append "Last edit by " (history-get-last (entity-get-value "edit-history"))))
(update-widget 'text-view (get-id "last-social-editor") 'text (update-widget 'text-view (get-id "last-social-editor") 'text
...@@ -1138,23 +1169,29 @@ ...@@ -1138,23 +1169,29 @@
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity requestcode resultcode) '())) (lambda (activity requestcode resultcode)
(cond
((eqv? requestcode photo-code)
;; todo: means we save when the camera happens
;; need to do this before init is called again in on-start,
;; which happens next
(let ((unique-id (entity-get-value "unique_id")))
(when (eqv? resultcode -1) ;; success!
(entity-set-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
(entity-update-values!))
;; need to reset the individual from the db now (as update reset it)
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
(list
(mupdate 'image-view 'photo "photo")))
(else
'()))))
(activity (activity
"details" "details"
(build-activity (build-activity
(horiz (horiz
(vert (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
(image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
(mbutton
'change-photo
(lambda ()
(set-current!
'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
(list
(take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
)))
(vert (vert
(medit-text 'details-first-name "normal" (lambda (v) (entity-set-value! "first-name" "varchar" v) '())) (medit-text 'details-first-name "normal" (lambda (v) (entity-set-value! "first-name" "varchar" v) '()))
...@@ -1196,22 +1233,7 @@ ...@@ -1196,22 +1233,7 @@
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity requestcode resultcode) (lambda (activity requestcode resultcode) '()))
(cond
((eqv? requestcode photo-code)
;; todo: means we save when the camera happens
;; need to do this before init is called again in on-start,
;; which happens next
(let ((unique-id (entity-get-value "unique_id")))
(when (eqv? resultcode -1) ;; success!
(entity-set-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
(entity-update-values!))
;; need to reset the individual from the db now (as update reset it)
(entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
(list
(mupdate 'image-view 'photo "photo")))
(else
'()))))
(activity (activity
"family" "family"
...@@ -1603,23 +1625,52 @@ ...@@ -1603,23 +1625,52 @@
(activity (activity
"agreement" "agreement"
(build-activity (build-activity
(mtext 'general-agreement-text)
(horiz (horiz
(mtoggle-button-scale (mtoggle-button-scale
'agree-record 'agree-record
(lambda (v) (lambda (v)
(list (list
(if (eqv? v 1) (soundfile-start-recording "/sdcard/symbai/test.3gp") (cond
(soundfile-stop-recording))))) ((eqv? v 1)
(let ((filename (string-append
"sdcard/symbai/files/"
(entity-get-value "unique_id") "-" (get-unique "general") "-record.3gp")))
(entity-set-value! "agreement-general" "file" filename)
(soundfile-start-recording filename)))
(else (soundfile-stop-recording))))))
(mtoggle-button-scale (mtoggle-button-scale
'agree-playback 'agree-playback
(lambda (v) (lambda (v)
(list (list
(if (eqv? v 1) (soundfile-start-playback "/sdcard/symbai/test.3gp") (if (eqv? v 1)
(soundfile-start-playback (entity-get-value "agreement-general"))
(soundfile-stop-playback)))))
)
(spacer 100)
(mtext 'photo-agreement-text)
(horiz
(mtoggle-button-scale
'photo-agree-record
(lambda (v)
(list
(cond
((eqv? v 1)
(let ((filename (string-append
"sdcard/symbai/files/"
(entity-get-value "unique_id") "-" (get-unique "photo") "-record.3gp")))
(entity-set-value! "agreement-photo" "file" filename)
(msg "recording" filename)
(soundfile-start-recording filename)))
(else (soundfile-stop-recording))))))
(mtoggle-button-scale
'photo-agree-playback
(lambda (v)
(list
(if (eqv? v 1)
(soundfile-start-playback (entity-get-value "agreement-photo"))
(soundfile-stop-playback))))) (soundfile-stop-playback)))))
) )
(mbutton 'agreement-next (lambda () (list (start-activity "details" 0 ""))))
(spacer 20)
) )
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Agreement") (set-current! 'activity-title "Agreement")
......
...@@ -6,6 +6,12 @@ ...@@ -6,6 +6,12 @@
(list 'no (list "No" )) (list 'no (list "No" ))
(list 'not-answered (list "Unanswered" )) (list 'not-answered (list "Unanswered" ))
(list 'not-set (list "Not set" )) (list 'not-set (list "Not set" ))
(list 'agree-record (list "Record"))
(list 'agree-playback (list "Play"))
(list 'photo-agree-record (list "Record"))
(list 'photo-agree-playback (list "Play"))
(list 'general-agreement-text (list "Blah blah..."))
(list 'photo-agreement-text (list "Blah blah..."))
(list 'details-next (list "Next" )) (list 'details-next (list "Next" ))
(list 'family-next (list "Next" )) (list 'family-next (list "Next" ))
(list 'migration-next (list "Next" )) (list 'migration-next (list "Next" ))
......
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