fixed date entering and female life hist codes

fo-am · Feb 22, 2018 · 63f249c · 63f249c
1 parent afba0d1
commit 63f249c
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 28 deletions.
diff --git a/android/app/src/main/assets/dbsync.scm b/android/app/src/main/assets/dbsync.scm
@@ -727,6 +727,12 @@
       (symbol->string (car (list-ref l i)))
       i))
 
+(define (symbol-list-to-names l)
+  (map 
+   (lambda (n) 
+     (cadr n))
+   l))
+
 (define (spinner-index l s)
   (define (_ l n s)
     (cond

diff --git a/android/app/src/main/assets/life-history.scm b/android/app/src/main/assets/life-history.scm
@@ -46,16 +46,18 @@
    (else "female")))  
 
 (define (update-lifehist gender)
-  (msg "update-lifehist: " gender)
-  (msg (string? gender))
-  (update-widget 'spinner (get-id "lifehist-types") 'array
-		 (lifehist-types (if (string=? gender " female") 'female 'male))))
-
+  (list
+   (update-widget 
+    'spinner (get-id "lifehist-type") 'array
+    (symbol-list-to-names
+     (lifehist-types (if (equal? gender "female") 'female 'male))))
+   (update-widget 'text-view (get-id "lifehist-title") 'text
+		  (string-append "New life history event for this " (lifehist-text gender)))))
 (define (build-lifehist type)
   (linear-layout
    (make-id "") 'vertical fillwrap lh-bgcol
    (list
-    (text-view 0 (string-append "New life history event for this " (lifehist-text type)) 30 fillwrap)
+    (text-view (make-id "lifehist-title") (string-append "New life history event for this " (lifehist-text type)) 30 fillwrap)
     (horiz
      (vert
       (horiz
@@ -67,12 +69,12 @@
 	 (list (date-picker-dialog
 		"lifehist-date"
 		(lambda (day month year)
-		  (let ((datestring (date-time->string (list year (+ month 1) day))))			
+		  (let ((datestring (date->string (list year (+ month 1) day))))
 		    (set-current! 'lifehist-date datestring)
 		    (list
 		     (update-widget
-		      'text-view
-		      (get-id "lifehist-date-view") 'text datestring)))))))))
+		      'text-view (get-id "lifehist-date-view") 
+		      'text datestring)))))))))
      (vert
       (mtext 0 "Code")
       (mspinner "lifehist-type" 

diff --git a/android/app/src/main/assets/starwisp.scm b/android/app/src/main/assets/starwisp.scm
@@ -717,26 +717,27 @@
    (lambda (activity arg)
      (entity-init! db "sync" "individual" (get-current 'individual #f))
      (let ((individual (get-current 'individual '())))
-       (list
+       (append
 	(update-lifehist (ktv-get individual "gender"))
-        (update-widget 'edit-text (get-id "update-individual-name") 'text
-                       (ktv-get individual "name"))
-        (update-widget 'text-view (get-id "update-individual-dob") 'text
-                       (ktv-get individual "dob"))
-        (update-widget 'spinner (get-id "update-individual-gender") 'selection
-                       (spinner-index list-gender (ktv-get individual "gender")))
-        (update-widget 'edit-text (get-id "update-individual-litter-code") 'text
-                       (ktv-get individual "litter-code"))
-        (update-widget 'edit-text (get-id "update-individual-chip-code") 'text
-                       (ktv-get individual "chip-code"))
-        (update-widget 'edit-text (get-id "update-individual-collar-weight") 'text
-                       (let ((v (ktv-get individual "collar-weight"))) (if v v 0)))
-
-        (update-widget 'toggle-button (get-id "update-individual-delete") 'checked
-                       (if (eqv? (ktv-get individual "deleted") 1) 1 0))
-        (update-widget 'toggle-button (get-id "update-individual-died") 'checked
-                       (if (eqv? (ktv-get individual "deleted") 2) 1 0))
-        )))
+	(list
+	 (update-widget 'edit-text (get-id "update-individual-name") 'text
+			(ktv-get individual "name"))
+	 (update-widget 'text-view (get-id "update-individual-dob") 'text
+			(ktv-get individual "dob"))
+	 (update-widget 'spinner (get-id "update-individual-gender") 'selection
+			(spinner-index list-gender (ktv-get individual "gender")))
+	 (update-widget 'edit-text (get-id "update-individual-litter-code") 'text
+			(ktv-get individual "litter-code"))
+	 (update-widget 'edit-text (get-id "update-individual-chip-code") 'text
+			(ktv-get individual "chip-code"))
+	 (update-widget 'edit-text (get-id "update-individual-collar-weight") 'text
+			(let ((v (ktv-get individual "collar-weight"))) (if v v 0)))
+
+	 (update-widget 'toggle-button (get-id "update-individual-delete") 'checked
+			(if (eqv? (ktv-get individual "deleted") 1) 1 0))
+	 (update-widget 'toggle-button (get-id "update-individual-died") 'checked
+			(if (eqv? (ktv-get individual "deleted") 2) 1 0))
+	 ))))
    (lambda (activity) '())
    (lambda (activity) '())
    (lambda (activity) '())