Commit 06ecbda4 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

pup-associations done, some abstraction to group comp

parent 89ceacbb
...@@ -263,6 +263,7 @@ ...@@ -263,6 +263,7 @@
(define (update-grid-selector-checked id items-id) (define (update-grid-selector-checked id items-id)
(let ((items-str (entity-get-value items-id))) (let ((items-str (entity-get-value items-id)))
(msg "selector-checked for" id items-id items-str)
(if items-str (if items-str
(map (map
(lambda (item) (lambda (item)
...@@ -530,7 +531,16 @@ ...@@ -530,7 +531,16 @@
(update-widget 'toggle-button (get-id "pf-pause") 'checked 1))) (update-widget 'toggle-button (get-id "pf-pause") 'checked 1)))
(define (update-selector-colours id entity-type where)
id "id-mongoose"
db "stream" entity-type
(list "parent" "varchar" "=" (get-current 'group-composition-id 0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; fragments ;; fragments
...@@ -1110,24 +1120,9 @@ ...@@ -1110,24 +1120,9 @@
(if (null? s) "" (ktv-get (car s) "weight"))) (if (null? s) "" (ktv-get (car s) "weight")))
(update-widget 'toggle-button (get-id "gc-weigh-accurate") 'selected (update-widget 'toggle-button (get-id "gc-weigh-accurate") 'selected
(if (null? s) 0 (ktv-get (car s) "accurate")))) (if (null? s) 0 (ktv-get (car s) "accurate"))))
(update-grid-selector-colours (update-selector-colours "gc-weigh-choose" "weight" (list "weight" "real" "!=" 0)))))))
db "stream" "weight"
(list "parent" "varchar" "=" (get-current 'group-composition-id 0))
(list "weight" "real" "!=" 0)))))))))
(update-grid-selector-enabled "gc-weigh-choose" (get-current 'gc-present '())) (update-grid-selector-enabled "gc-weigh-choose" (get-current 'gc-present '()))
(update-grid-selector-colours (update-selector-colours "gc-weigh-choose" "weight" (list "weight" "real" "!=" 0))))
db "stream" "weight"
(list "parent" "varchar" "=" (get-current 'group-composition-id 0))
(list "weight" "real" "!=" 0))))
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
...@@ -1169,7 +1164,7 @@ ...@@ -1169,7 +1164,7 @@
(make-id "") 'vertical fill gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtext "title" "Pup Associations") (mtext "title" "Pup Associations")
(build-grid-selector "gc-pup-choose" "toggle" "Choose pup") (build-grid-selector "gc-pup-choose" "single" "Choose pup")
(horiz (horiz
(vert (vert
(mtext "" "Strength") (mtext "" "Strength")
...@@ -1186,16 +1181,47 @@ ...@@ -1186,16 +1181,47 @@
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(entity-init! db "stream" "pup-assoc" '())
(list (list
(populate-grid-selector "gc-pup-choose" "toggle" (populate-grid-selector
"gc-pup-choose" "single"
(db-mongooses-by-pack-pups) #f (db-mongooses-by-pack-pups) #f
(lambda (individual) (lambda (individual)
(list))) ;; search for a weight for this individual...
(populate-grid-selector "gc-pup-escort" "toggle" (let ((s (db-filter
db "stream" "pup-assoc"
(list (list "parent" "varchar" "=" (get-current 'group-composition-id 0))
(list "id-mongoose" "varchar" "=" (ktv-get individual "unique_id"))))))
(if (null? s)
;; not there, make a new one
(entity-init&save! db "stream" "pup-assoc"
(ktv "name" "varchar" "")
(ktv "id-escort" "varchar" "none")
(ktv "accurate" "varchar" "")
(ktv "strength" "varchar" "")
(ktv "parent" "varchar" (get-current 'group-composition-id 0))
(ktv "id-mongoose" "varchar" (ktv-get individual "unique_id"))))
(entity-init! db "stream" "pup-assoc" (car s)))
;; rebuild the selector to clear it...
"gc-pup-escort" "toggle"
(db-mongooses-by-pack-adults) #t (db-mongooses-by-pack-adults) #t
(lambda (individual) (lambda (individuals)
(list))) (msg "setting id-escort")
)) (entity-update-single-value! (ktv "id-escort" "varchar" (assemble-array individuals)))
(update-grid-selector-enabled "gc-pup-escort" (get-current 'gc-present '()))
(update-grid-selector-checked "gc-pup-escort" "id-escort")
(update-selector-colours "gc-pup-choose" "pup-assoc" (list "id-escort" "varchar" "!=" "none")))))))
(update-grid-selector-enabled "gc-pup-choose" (get-current 'gc-present '()))
(update-selector-colours "gc-pup-choose" "pup-assoc" (list "id-escort" "varchar" "!=" "none"))))
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '()) (lambda (fragment) '())
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