Commit 8c25d7e6 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

updated oestrus

parent 98227bd7
...@@ -1492,43 +1492,55 @@ ...@@ -1492,43 +1492,55 @@
(entity-init! db "stream" "mate-guard" '()) (entity-init! db "stream" "mate-guard" '())
(append (append
(list (list
(populate-grid-selector
"gc-oestrus-guard" "single"
(db-mongooses-by-pack-male) #t
(lambda (escort-individual)
;; no pup yet...
(list)))
(populate-grid-selector (populate-grid-selector
"gc-oestrus-female" "single" "gc-oestrus-female" "single"
(db-mongooses-by-pack-female) #f (db-mongooses-by-pack-female) #f
(lambda (individual) (lambda (pup-individual)
;; search for a weight for this individual... (append
(let ((s (db-filter (list
db "stream" "mate-guard" (populate-grid-selector
(list (list "parent" "varchar" "=" (get-current 'group-composition-id 0)) "gc-oestrus-guard" "single"
(list "id-mongoose" "varchar" "=" (ktv-get individual "unique_id")))))) (db-mongooses-by-pack-adults) #t
(if (null? s) (lambda (escort-individual)
;; not there, make a new one (let ((s (db-filter
(entity-init&save! db "stream" "mate-guard" db "stream" "mate-guard"
(list (list (list "parent" "varchar" "=" (get-current 'group-composition-id 0))
(ktv "name" "varchar" "") (list "id-escort" "varchar" "=" (ktv-get escort-individual "unique_id"))
(ktv "id-escort" "varchar" "none") (list "id-mongoose" "varchar" "=" (ktv-get pup-individual "unique_id"))))))
(ktv "accurate" "varchar" "") (if (null? s)
(ktv "strength" "varchar" "") ;; not there, make a new one
(ktv "parent" "varchar" (get-current 'group-composition-id 0)) (entity-init&save! db "stream" "mate-guard"
(ktv "id-mongoose" "varchar" (ktv-get individual "unique_id")))) (list
(entity-init! db "stream" "mate-guard" (car s))) (ktv "name" "varchar" "")
(append (ktv "id-escort" "varchar" (ktv-get escort-individual "unique_id"))
;; rebuild the selector to clear it... (ktv "accurate" "varchar" "medium")
(list (ktv "strength" "varchar" "medium")
(populate-grid-selector (ktv "parent" "varchar" (get-current 'group-composition-id 0))
"gc-oestrus-guard" "toggle" (ktv "id-mongoose" "varchar" (ktv-get pup-individual "unique_id"))))
(db-mongooses-by-pack-adults) #t (entity-init! db "stream" "mate-guard" (car s)))
(lambda (individuals) (append
(msg "setting id-escort") (list
(entity-update-single-value! (ktv "id-escort" "varchar" (assemble-array individuals))) (update-widget 'spinner (get-id "gc-oestrus-strength") 'selection (spinner-index list-strength (entity-get-value "strength")))
(list)) (update-widget 'spinner (get-id "gc-oestrus-accuracy") 'selection (spinner-index list-strength (entity-get-value "accurate"))))
(get-grid-select-init-state "id-escort")))
(update-grid-selector-enabled "gc-oestrus-guard" (get-current 'gc-present '())) (update-selector-colours2 "gc-oestrus-guard" "mate-guard" (list "id-escort" "varchar" "=" (ktv-get escort-individual "unique_id"))))
(update-grid-selector-checked "gc-oestrus-guard" "id-escort")
(update-selector-colours "gc-oestrus-female" "mate-guard" (list "id-escort" "varchar" "!=" "none")))))))
))))
(update-selector-colours2 "gc-oestrus-guard" "mate-guard" (list "id-mongoose" "varchar" "=" (ktv-get pup-individual "unique_id")))
(update-selector-colours3 "gc-oestrus-female" "mate-guard")
(update-grid-selector-enabled "gc-oestrus-guard" (get-current 'gc-present '()))
))))
(update-grid-selector-enabled "gc-oestrus-guard" (get-current 'gc-present '()))
(update-grid-selector-enabled "gc-oestrus-female" (get-current 'gc-present '())) (update-grid-selector-enabled "gc-oestrus-female" (get-current 'gc-present '()))
(update-selector-colours "gc-oestrus-female" "mate-guard" (list "id-escort" "varchar" "!=" "none")))) (update-selector-colours3 "gc-oestrus-female" "mate-guard")
))
(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