Commit 7a96f055 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

individual chooser works, image resized on load

parent 8acd93a7
...@@ -27,7 +27,6 @@ ...@@ -27,7 +27,6 @@
;; entity-attribut-value system for sqlite ;; entity-attribut-value system for sqlite
;; ;;
;; create eav tables (add types as required) ;; create eav tables (add types as required)
(define (setup db table) (define (setup db table)
(db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)")) (db-exec db (string-append "create table " table "_entity ( entity_id integer primary key autoincrement, entity_type varchar(256), unique_id varchar(256), dirty integer, version integer)"))
...@@ -265,6 +264,20 @@ ...@@ -265,6 +264,20 @@
(define (filter-op f) (list-ref f 2)) (define (filter-op f) (list-ref f 2))
(define (filter-arg f) (list-ref f 3)) (define (filter-arg f) (list-ref f 3))
(define (merge-filter f fl)
(cond
((null? fl) (list f))
((equal? (filter-key (car fl)) (filter-key f))
(cons f (cdr fl)))
(else (cons (car fl) (merge-filter f (cdr fl))))))
(define (delete-filter key fl)
(cond
((null? fl) '())
((equal? (filter-key (car fl)) key)
(cdr fl))
(else (cons (car fl) (delete-filter key (cdr fl))))))
(define (build-query table filter) (define (build-query table filter)
(string-append (string-append
(foldl (foldl
...@@ -288,7 +301,7 @@ ...@@ -288,7 +301,7 @@
"as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and " "as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
"d.value = 0 ") "d.value = 0 ")
filter) filter)
"order by n.value")) "where e.entity_type = ? order by n.value"))
(define (build-args filter) (define (build-args filter)
(map (map
...@@ -301,7 +314,8 @@ ...@@ -301,7 +314,8 @@
db-select db-select
(dbg (append (dbg (append
(list db (build-query table filter)) (list db (build-query table filter))
(build-args filter)))))) (build-args filter)
(list type))))))
(msg (db-status db)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
......
...@@ -50,6 +50,16 @@ ...@@ -50,6 +50,16 @@
(insert (car lst) fn (insert (car lst) fn
(sort (cdr lst) fn)))) (sort (cdr lst) fn))))
;; (chop (1 2 3 4) 2) -> ((1 2) (3 4))
(define (chop l n)
(define (_ in out c)
(display c)(newline)
(cond
((null? in) out)
((zero? c) (_ (cdr in) (cons (list (car in)) out) (- n 1)))
(else (_ (cdr in) (cons (cons (car in) (car out)) (cdr out)) (- c 1)))))
(reverse (map reverse (_ l '(()) n))))
(define (find n l) (define (find n l)
(cond (cond
((null? l) #f) ((null? l) #f)
......
...@@ -76,14 +76,21 @@ ...@@ -76,14 +76,21 @@
(list 'khasi (list "Khasi" "Khasi" "Khasi")) (list 'khasi (list "Khasi" "Khasi" "Khasi"))
(list 'hindi (list "Hindi" "Hindi" "Hindi")) (list 'hindi (list "Hindi" "Hindi" "Hindi"))
(list 'user-id (list "Your user ID" "User ID" "User ID")) (list 'user-id (list "Your user ID" "User ID" "User ID"))
(list 'ok (list "Ok" "Ok" "Ok")) (list 'save (list "Save" "Save" "Save"))
(list 'cancel (list "Cancel" "Cancel" "Cancel")) (list 'back (list "Back" "Back" "Back"))
(list 'off (list "Off" "Off" "Off"))
(list 'villages (list "Villages" "Villages" "Villages")) (list 'villages (list "Villages" "Villages" "Villages"))
(list 'list-empty (list "List empty")) (list 'list-empty (list "List empty"))
(list 'delete (list "Delete")) (list 'delete (list "Delete"))
(list 'delete-are-you-sure (list "Are you sure you want to delete this?")) (list 'delete-are-you-sure (list "Are you sure you want to delete this?"))
(list 'save-are-you-sure (list "Are you sure you want to save changes?")) (list 'save-are-you-sure (list "Are you sure you want to save changes?"))
;; filter
(list 'find-individual (list "Find individual"))
(list 'filter (list "Filter"))
(list 'off (list "Off" "Off" "Off"))
(list 'name (list "Name"))
;; sync ;; sync
(list 'sync-all (list "Sync me!")) (list 'sync-all (list "Sync me!"))
(list 'sync-syncall (list "Sync everything")) (list 'sync-syncall (list "Sync everything"))
...@@ -354,7 +361,7 @@ ...@@ -354,7 +361,7 @@
(list 0 0 0 0) (list 0 0 0 0)
(list (list
(mbutton-scale (mbutton-scale
'ok 'save
(lambda () (lambda ()
(list (list
(alert-dialog (alert-dialog
...@@ -364,10 +371,10 @@ ...@@ -364,10 +371,10 @@
(cond (cond
((eqv? v 1) ((eqv? v 1)
(entity-update-values!) (entity-update-values!)
(list (finish-activity 1))) (list))
(else (else
(list)))))))) (list))))))))
(mbutton-scale 'cancel (lambda () (list (finish-activity 1)))))) (mbutton-scale 'back (lambda () (list (finish-activity 1))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -401,10 +408,72 @@ ...@@ -401,10 +408,72 @@
(spacer 5) (spacer 5)
(build-fragment "bottom" (make-id "bottom") fillwrap))))) (build-fragment "bottom" (make-id "bottom") fillwrap)))))
(define (grid-ify widgets n)
(map
(lambda (w)
(linear-layout
0 'horizontal
(layout 'wrap-content 'wrap-content 1 'left 0)
(list 0 0 0 0)
w))
(chop widgets n)))
(define (filter-set! l)
(set-current! 'individual-filter l))
(define (filter-clear!)
(filter-set! '()))
(define (filter-add! f)
(set-current!
'individual-filter
(merge-filter f (get-current 'individual-filter '()))))
(define (filter-remove! key)
(set-current!
'individual-filter
(delete-filter key (get-current 'individual-filter '()))))
(define (filter-get)
(get-current 'individual-filter '()))
(define button-size (list (inexact->exact (round (* 192 0.9)))
(inexact->exact (round (* 256 0.9)))))
(define (update-individual-filter)
(update-widget
'linear-layout (get-id "choose-pics") 'contents
(grid-ify
(map
(lambda (e)
(let* ((id (ktv-get e "unique_id"))
(image-name (ktv-get e "photo"))
(image (if (or (null? image-name)
(not image-name)
(equal? image-name "none"))
"face" (string-append "/sdcard/symbai/files/" image-name))))
(if (equal? image "face")
(button
(make-id (string-append "chooser-" id))
(ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0))))
(image-button
(make-id (string-append "chooser-" id))
image (layout (car button-size) (cadr button-size) 1 'centre 5)
(lambda ()
(set-current! 'choose-result id)
(list (finish-activity 0)))))))
(db-filter db "sync" "individual" (filter-get)))
3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities ;; activities
(define photo-code 999) (define photo-code 999)
(define choose-code 998)
(define-activity-list (define-activity-list
...@@ -416,8 +485,9 @@ ...@@ -416,8 +485,9 @@
(medit-text 'user-id "normal" (lambda () (list))) (medit-text 'user-id "normal" (lambda () (list)))
(mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 ""))))) (mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 "")))))
(mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list))) (horiz
(mbutton 'find-individual (lambda () (list (start-activity "individual-chooser" 0 "")))) (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
(mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
(build-list-widget (build-list-widget
db "sync" 'villages "village" "village" (lambda () #f) db "sync" 'villages "village" "village" (lambda () #f)
(list (list
...@@ -443,6 +513,8 @@ ...@@ -443,6 +513,8 @@
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity requestcode resultcode) (lambda (activity requestcode resultcode)
(cond (cond
((eqv? requestcode choose-code)
(list (start-activity "individual" 0 (get-current 'choose-result 0))))
((eqv? requestcode photo-code) ((eqv? requestcode photo-code)
(msg "camera returned" resultcode) (msg "camera returned" resultcode)
(list (update-widget (list (update-widget
...@@ -666,8 +738,10 @@ ...@@ -666,8 +738,10 @@
(mbutton (mbutton
'change-photo 'change-photo
(lambda () (lambda ()
(set-current!
'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
(list (list
(take-photo (string-append dirname "files/" (entity-get-value "unique_id") "-face.jpg") photo-code)) (take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
))) )))
(vert (vert
...@@ -708,7 +782,7 @@ ...@@ -708,7 +782,7 @@
;; need to do this before init is called again in on-start, ;; need to do this before init is called again in on-start,
;; which happens next ;; which happens next
(let ((unique-id (entity-get-value "unique_id"))) (let ((unique-id (entity-get-value "unique_id")))
(entity-add-value! "photo" "file" (string-append unique-id "-face.jpg")) (entity-add-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
(entity-update-values!) (entity-update-values!)
;; need to reset the individual from the db now (as update reset it) ;; 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))) (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
...@@ -742,7 +816,7 @@ ...@@ -742,7 +816,7 @@
(medit-text 'birth-order "numeric" (lambda (v) (entity-add-value! "birth-order" "int" 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 (list
(mupdate-spinner 'head-of-house "head-of-house" '(male female)) (mupdate-spinner 'head-of-house "head-of-house" '(male female))
...@@ -907,28 +981,29 @@ ...@@ -907,28 +981,29 @@
(layout 'fill-parent 'wrap-content 0.75 'centre 0) (layout 'fill-parent 'wrap-content 0.75 'centre 0)
(list 0 0 0 0) (list 0 0 0 0)
(list)) (list))
(mtext 'filter-stuff)) (mtitle 'filter)
) (horiz
(mspinner 'gender '(off female male)
(lambda (v)
(if (equal? v (mtext-lookup 'off))
(filter-remove! "gender")
(filter-add! (make-filter "gender" "varchar" "=" v)))
(list (update-individual-filter))
))
(medit-text
'name "normal"
(lambda (v)
(if (equal? v "")
(filter-remove! "name")
(filter-add! (make-filter "name" "varchar" "like" (string-append v "%"))))
(list (update-individual-filter))
))
)))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Individual chooser") (set-current! 'activity-title "Individual chooser")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(list (list (update-individual-filter (list))))
(update-widget
'linear-layout (get-id "choose-pics") 'contents
(map
(lambda (e)
(msg (ktv-get e "gender"))
(let* ((image-name (ktv-get e "photo"))
(image (if (or (not image-name) (equal? image-name "none"))
"face" (string-append "/sdcard/symbai/files/" image-name))))
(msg image)
(image-button
(make-id (string-append "chooser-" (ktv-get e "unique_id")))
image (layout 'wrap-content 'wrap-content 1 'centre 5)
(lambda () '()))))
(db-filter db "sync" "individual"
(list (make-filter "gender" "varchar" "=" "female")))))))
(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