From bfed910f5d6c1e22c747eef794a5f0d3ba7139cc Mon Sep 17 00:00:00 2001 From: dave griffiths Date: Mon, 26 Feb 2018 16:01:47 +0000 Subject: [PATCH] creating litters and moving packs --- android/app/src/main/assets/group-comp.scm | 22 ++- android/app/src/main/assets/litter.scm | 10 +- android/app/src/main/assets/mongoose.scm | 8 +- android/app/src/main/assets/starwisp.scm | 165 ++++++++++++--------- eavdb/entity-filter.ss | 2 +- 5 files changed, 128 insertions(+), 79 deletions(-) diff --git a/android/app/src/main/assets/group-comp.scm b/android/app/src/main/assets/group-comp.scm index ac2cef2..a6c73f0 100644 --- a/android/app/src/main/assets/group-comp.scm +++ b/android/app/src/main/assets/group-comp.scm @@ -203,9 +203,25 @@ (db-mongooses-by-pack-female) #f (lambda (individuals) (set-current! 'entity-type "group-comp") - (entity-update-single-value! (ktv "pregnant" "varchar" (assemble-array individuals))) - (list))) - ) + (entity-update-single-value! (ktv "pregnant" "varchar" (assemble-array individuals))) + (let ((litter (db-current-litter))) + (msg litter) + (cond + ((null? litter) + ;; create a new litter for this pack! + (entity-create! db "sync" "litter" (init-litter (ktv-get (get-current 'pack '()) "unique_id"))) + (set-current! 'entity-type "group-comp") + (list + (if (null? (db-current-litter)) + (ok-dialog "litter-create-prob" + "Tried to create new litter and failed..." + (lambda () '())) + (ok-dialog "litter-create-prob" + (string-append + "Created new litter for pack " + (ktv-get (get-current 'pack '()) "name")) + (lambda () '()))))) + (else (list))))))) (update-grid-selector-enabled "gc-preg-choose" (get-current 'gc-not-present '())) (update-grid-selector-checked "gc-preg-choose" "pregnant"))) (lambda (fragment) '()) diff --git a/android/app/src/main/assets/litter.scm b/android/app/src/main/assets/litter.scm index cb2dc21..aa1d596 100644 --- a/android/app/src/main/assets/litter.scm +++ b/android/app/src/main/assets/litter.scm @@ -13,9 +13,11 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . -(define (init-litter) +(define (init-litter pack-id) ;; retreve (and increment) the pack's id info - (set-current! 'entity-type "pack") + (entity-init! db "sync" "pack" (dbg (get-entity-by-unique db "sync" pack-id))) + (msg (entity-get-value "unique_id")) + (let ((letter (entity-get-value "litter-code-letter")) (number (entity-get-value "litter-code-number")) (parent (entity-get-value "unique_id"))) @@ -35,7 +37,7 @@ (db-filter db "sync" "litter" (list - (list "pack-id" "varchar" "=" (ktv-get (get-current 'pack '()) "unique_id")) - (list "dob" "varchar" "d<" 30)))) + (list "parent" "varchar" "=" (ktv-get (get-current 'pack '()) "unique_id")) + (list "date" "varchar" "d<" 30)))) diff --git a/android/app/src/main/assets/mongoose.scm b/android/app/src/main/assets/mongoose.scm index a76a3f8..ed2aba6 100644 --- a/android/app/src/main/assets/mongoose.scm +++ b/android/app/src/main/assets/mongoose.scm @@ -51,6 +51,7 @@ "preg-focal-affil" "lifehist-event" + "movepack-event" )) (define pup-focal-export @@ -444,11 +445,9 @@ '()))) (define (db-mongoose-packs) - (msg "db-mongooses-by-pack") (db-filter db "sync" "pack" '())) (define (db-mongooses-by-pack) - (msg "db-mongooses-by-pack") (db-filter db "sync" "mongoose" (list (list "pack-id" "varchar" "=" (ktv-get (get-current 'pack '()) "unique_id"))))) @@ -474,7 +473,6 @@ (list "gender" "varchar" "not like" "male")))) - ;; (y m d h m s) (define (date-minus-months d ms) (let ((year (list-ref d 0)) @@ -800,6 +798,7 @@ (equal? type "group-alarm") (equal? type "group-move") (equal? type "note") + (equal? type "movepack-event") (equal? type "lifehist-event")) (cons (mbutton @@ -1234,7 +1233,8 @@ (let ((search-results (if parent (db-filter-only db table entity-type - (list (list "parent" "varchar" "=" parent)) + (list (list "parent" "varchar" "=" parent) + (list "date" "varchar" "d<" 90)) (map (lambda (id) (list id "varchar")) diff --git a/android/app/src/main/assets/starwisp.scm b/android/app/src/main/assets/starwisp.scm index 853c346..1572594 100644 --- a/android/app/src/main/assets/starwisp.scm +++ b/android/app/src/main/assets/starwisp.scm @@ -575,10 +575,10 @@ (entity-set-value! "litter-code-number" "int" (string->number v)) '())))) - (build-list-widget db "sync" "Recent litters" (list "name" "date") + (build-list-widget db "sync" "Recent litters (last 90 days)" (list "name" "date") "litter" "update-litter" (lambda () (ktv-get (get-current 'pack '()) "unique_id")) - (lambda () (init-litter))) + (lambda () (init-litter (ktv-get (get-current 'pack '()) "unique_id")))) (build-lifehist 'pack) (horiz (mbutton2 "manage-pack-back" "Cancel" (lambda () (list (finish-activity 1)))) @@ -683,65 +683,70 @@ (activity "update-individual" - (vert - (text-view (make-id "title") "Update Mongoose" 40 fillwrap) - (spacer 10) - (text-view (make-id "update-individual-name-text") "Name" 30 fillwrap) - (edit-text (make-id "update-individual-name") "" 30 "text" fillwrap - (lambda (v) (entity-set-value! "name" "varchar" v) '())) - (text-view (make-id "update-individual-name-text") "Gender" 30 fillwrap) - (mspinner "update-individual-gender" list-gender - (lambda (v) (entity-set-value! "gender" "varchar" (spinner-choice list-gender v)) '())) - (text-view (make-id "update-individual-dob-text") "Date of Birth" 30 fillwrap) - (horiz - (text-view (make-id "update-individual-dob") "00/00/00" 25 fillwrap) - (button (make-id "date") "Set date" 30 fillwrap - (lambda () - (list (date-picker-dialog - "update-individual-date" - (lambda (day month year) - (let ((datestring (date->string (list year (+ month 1) day)))) - (entity-set-value! "dob" "varchar" datestring) - (list - (update-widget - 'text-view - (get-id "update-individual-dob") 'text datestring)))))))) - (button (make-id "update-unknown-date") "Unknown" 30 fillwrap - (lambda () - (entity-set-value! "dob" "varchar" "Unknown") - (list (update-widget 'text-view (get-id "update-individual-dob") 'text "Unknown")))) - ) - - (text-view (make-id "update-individual-litter-text") "Litter code" 30 fillwrap) - (edit-text (make-id "update-individual-litter-code") "" 30 "text" fillwrap - (lambda (v) (entity-set-value! "litter-code" "varchar" v) '())) - (text-view (make-id "update-individual-chip-text") "Chip code" 30 fillwrap) - (edit-text (make-id "update-individual-chip-code") "" 30 "text" fillwrap - (lambda (v) (entity-set-value! "chip-code" "varchar" v) '())) - (text-view (make-id "update-individual-collar-text") "Collar weight" 30 fillwrap) - (edit-text (make-id "update-individual-collar-weight") "" 30 "numeric" fillwrap - (lambda (v) (entity-set-value! "collar-weight" "real" (string->number v)) '())) - (spacer 10) - (horiz - (mtoggle-button2 "update-individual-delete" "Delete" - (lambda (v) - (entity-set-value! "deleted" "int" (if v 1 0)) - (list))) - (mtoggle-button2 "update-individual-died" "Died" - (lambda (v) - (entity-set-value! "deleted" "int" (if v 2 0)) - (list)))) - - (build-lifehist 'male) - - (horiz - (mbutton2 "update-individual-cancel" "Cancel" - (lambda () (list (finish-activity 2)))) - (mbutton2 "update-individual-done" "Done" - (lambda () - (entity-update-values!) - (list (finish-activity 2))))) - ) + (scroll-view-vert + 0 (layout 'fill-parent 'wrap-content 0.75 'centre 0) + (list + (vert + (text-view (make-id "title") "Update Mongoose" 40 fillwrap) + (spacer 10) + (text-view (make-id "update-individual-name-text") "Name" 30 fillwrap) + (edit-text (make-id "update-individual-name") "" 30 "text" fillwrap + (lambda (v) (entity-set-value! "name" "varchar" v) '())) + (text-view (make-id "update-individual-name-text") "Gender" 30 fillwrap) + (mspinner "update-individual-gender" list-gender + (lambda (v) (entity-set-value! "gender" "varchar" (spinner-choice list-gender v)) '())) + (text-view (make-id "update-individual-dob-text") "Date of Birth" 30 fillwrap) + (horiz + (text-view (make-id "update-individual-dob") "00/00/00" 25 fillwrap) + (button (make-id "date") "Set date" 30 fillwrap + (lambda () + (list (date-picker-dialog + "update-individual-date" + (lambda (day month year) + (let ((datestring (date->string (list year (+ month 1) day)))) + (entity-set-value! "dob" "varchar" datestring) + (list + (update-widget + 'text-view + (get-id "update-individual-dob") 'text datestring)))))))) + (button (make-id "update-unknown-date") "Unknown" 30 fillwrap + (lambda () + (entity-set-value! "dob" "varchar" "Unknown") + (list (update-widget 'text-view (get-id "update-individual-dob") 'text "Unknown")))) + ) + + (text-view (make-id "update-individual-litter-text") "Litter code" 30 fillwrap) + (edit-text (make-id "update-individual-litter-code") "" 30 "text" fillwrap + (lambda (v) (entity-set-value! "litter-code" "varchar" v) '())) + (text-view (make-id "update-individual-chip-text") "Chip code" 30 fillwrap) + (edit-text (make-id "update-individual-chip-code") "" 30 "text" fillwrap + (lambda (v) (entity-set-value! "chip-code" "varchar" v) '())) + (text-view (make-id "update-individual-collar-text") "Collar weight" 30 fillwrap) + (edit-text (make-id "update-individual-collar-weight") "" 30 "numeric" fillwrap + (lambda (v) (entity-set-value! "collar-weight" "real" (string->number v)) '())) + (spacer 10) + (horiz + (mtoggle-button2 "update-individual-delete" "Delete" + (lambda (v) + (entity-set-value! "deleted" "int" (if v 1 0)) + (list))) + (mtoggle-button2 "update-individual-died" "Died" + (lambda (v) + (entity-set-value! "deleted" "int" (if v 2 0)) + (list)))) + + (build-grid-selector "move-pack-list" "button" "Move pack") + + (build-lifehist 'male) + + (horiz + (mbutton2 "update-individual-cancel" "Cancel" + (lambda () (list (finish-activity 2)))) + (mbutton2 "update-individual-done" "Done" + (lambda () + (entity-update-values!) + (list (finish-activity 2))))) + ))) (lambda (activity arg) (activity-layout activity)) (lambda (activity arg) @@ -767,7 +772,32 @@ (if (eqv? (entity-get-value "deleted") 1) 1 0)) (update-widget 'toggle-button (get-id "update-individual-died") 'checked (if (eqv? (entity-get-value "deleted") 2) 1 0)) - ))) + (populate-grid-selector + "move-pack-list" "button" (db-mongoose-packs) #f + (lambda (pack) + (list + (alert-dialog + "move-pack-done" + "Move mongoose into new pack: are you sure?" + (lambda (v) + (cond + ((eqv? v 1) + (let ((src-pack (get-entity-by-unique db "sync" (entity-get-value "pack-id")))) + (entity-create! + db "stream" "movepack-event" + (list + (ktv "mongoose-id" "varchar" (entity-get-value "unique_id")) + (ktv "mongoose-name" "varchar" (entity-get-value "name")) + (ktv "pack-dst-id" "varchar" (ktv-get pack "unique_id")) + (ktv "pack-dst-name" "varchar" (ktv-get pack "name")) + (ktv "pack-src-id" "varchar" (entity-get-value "pack-id")) + (ktv "pack-src-name" "varchar" (ktv-get src-pack "name")))) + (entity-set-value! "pack-id" "varchar" (ktv-get pack "unique_id")) + (entity-update-values!) + (list (finish-activity 1)))) + (else + (list))))))) + )))) (lambda (activity) '()) (lambda (activity) '()) (lambda (activity) '()) @@ -992,11 +1022,12 @@ (build-lifehist 'litter) - (mtoggle-button2 "update-litter-delete" "Delete" - (lambda (v) - (entity-set-value! "deleted" "int" (if v 1 0)) - (list))) - + (mbutton2 "update-litter-delete" "Delete" + (lambda () + (entity-set-value! "deleted" "int" 1) + (entity-update-values!) + (list (finish-activity 2)))) + (horiz (mbutton2 "update-litter-cancel" "Cancel" (lambda () (list (finish-activity 2)))) diff --git a/eavdb/entity-filter.ss b/eavdb/entity-filter.ss index fb27280..9edfe2a 100644 --- a/eavdb/entity-filter.ss +++ b/eavdb/entity-filter.ss @@ -70,7 +70,7 @@ r "join " table "_value_" (filter-type i) " " "as " var " on " var ".entity_id = e.entity_id and " var ".attribute_id = '" (filter-key i) "' and ( " - "(julianday(" var ".value)-julianday('now'))" (substring (filter-op i) 1 (string-length (filter-op i))) " ? " + "julianday('now')-julianday(" var ".value)" (substring (filter-op i) 1 (string-length (filter-op i))) " ? " "or " var ".value like 'unknown') ")) ((equal? (substring (filter-op i) 0 1) "t") ;; time version