individual chooser works, image resized on load

android/assets/eavdb.scm

@@ -27,7 +27,6 @@
 ;; entity-attribut-value system for sqlite
 ;;
 
-
 ;; create eav tables (add types as required)
 (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)"))
@@ -265,6 +264,20 @@
 (define (filter-op f) (list-ref f 2))
 (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)
   (string-append
    (foldl
@@ -288,7 +301,7 @@
      "as d on d.entity_id = e.entity_id and d.attribute_id = 'deleted' and "
      "d.value = 0 ")
     filter)
-   "order by n.value"))
+   "where e.entity_type = ? order by n.value"))
 
 (define (build-args filter)
   (map
@@ -301,7 +314,8 @@
             db-select
             (dbg (append
                   (list db (build-query table filter))
-                  (build-args filter))))))
+                  (build-args filter)
+                  (list type))))))
     (msg (db-status db))
     (if (null? s)
         '()

android/assets/lib.scm

@@ -50,6 +50,16 @@
       (insert (car 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)
   (cond
     ((null? l) #f)

android/assets/starwisp.scm

@@ -76,14 +76,21 @@
    (list 'khasi (list "Khasi" "Khasi" "Khasi"))
    (list 'hindi (list "Hindi" "Hindi" "Hindi"))
    (list 'user-id (list "Your user ID" "User ID" "User ID"))
-   (list 'ok (list "Ok" "Ok" "Ok"))
-   (list 'cancel (list "Cancel" "Cancel" "Cancel"))
+   (list 'save (list "Save" "Save" "Save"))
+   (list 'back (list "Back" "Back" "Back"))
+   (list 'off (list "Off" "Off" "Off"))
    (list 'villages (list "Villages" "Villages" "Villages"))
    (list 'list-empty (list "List empty"))
    (list 'delete (list "Delete"))
    (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?"))
 
+   ;; filter
+   (list 'find-individual (list "Find individual"))
+   (list 'filter (list "Filter"))
+   (list 'off (list "Off" "Off" "Off"))
+   (list 'name (list "Name"))
+
    ;; sync
    (list 'sync-all (list "Sync me!"))
    (list 'sync-syncall (list "Sync everything"))
@@ -354,7 +361,7 @@
     (list 0 0 0 0)
     (list
      (mbutton-scale
-      'ok
+      'save
       (lambda ()
         (list
          (alert-dialog
@@ -364,10 +371,10 @@
             (cond
              ((eqv? v 1)
               (entity-update-values!)
-              (list (finish-activity 1)))
+              (list))
              (else
               (list))))))))
-     (mbutton-scale 'cancel (lambda () (list (finish-activity 1))))))
+     (mbutton-scale 'back (lambda () (list (finish-activity 1))))))
    (lambda (fragment arg)
      (activity-layout fragment))
    (lambda (fragment arg)
@@ -401,10 +408,72 @@
      (spacer 5)
      (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
 
 (define photo-code 999)
+(define choose-code 998)
 
 (define-activity-list
 
@@ -416,8 +485,9 @@
      (medit-text 'user-id "normal" (lambda () (list)))
      (mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 "")))))
 
-    (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
-    (mbutton 'find-individual (lambda () (list (start-activity "individual-chooser" 0 ""))))
+    (horiz
+     (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
+     (mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
     (build-list-widget
      db "sync" 'villages "village" "village" (lambda () #f)
      (list
@@ -443,6 +513,8 @@
    (lambda (activity) '())
    (lambda (activity requestcode resultcode)
      (cond
+      ((eqv? requestcode choose-code)
+       (list (start-activity "individual" 0 (get-current 'choose-result 0))))
       ((eqv? requestcode photo-code)
        (msg "camera returned" resultcode)
        (list (update-widget
@@ -666,8 +738,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/" (entity-get-value "unique_id") "-face.jpg") photo-code))
+          (take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
          )))
 
      (vert
@@ -708,7 +782,7 @@
        ;; need to do this before init is called again in on-start,
        ;; which happens next
        (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!)
          ;; 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)))
@@ -742,7 +816,7 @@
     (medit-text 'birth-order "numeric" (lambda (v) (entity-add-value! "birth-order" "int" v) '())))
    (lambda (activity arg)
      (set-current! 'activity-title "Individual family")
-     (activity-layout activity))
+      (activity-layout activity))
    (lambda (activity arg)
      (list
       (mupdate-spinner 'head-of-house "head-of-house" '(male female))
@@ -907,28 +981,29 @@
       (layout 'fill-parent 'wrap-content 0.75 'centre 0)
       (list 0 0 0 0)
       (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)
      (set-current! 'activity-title "Individual chooser")
      (activity-layout activity))
    (lambda (activity arg)
-     (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")))))))
+     (list (update-individual-filter (list))))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())