fancify the patterns in book-club
This commit is contained in:
parent
22a228ab4b
commit
c78b76b38c
|
@ -67,7 +67,7 @@
|
||||||
(field [books Inventory inventory])
|
(field [books Inventory inventory])
|
||||||
|
|
||||||
;; Give quotes to interested parties.
|
;; Give quotes to interested parties.
|
||||||
(during (observe (book-quote (bind title String) discard))
|
(during (observe (book-quote $title _))
|
||||||
;; TODO - lookup
|
;; TODO - lookup
|
||||||
(assert (book-quote title (lookup title (ref books)))))))))
|
(assert (book-quote title (lookup title (ref books)))))))))
|
||||||
|
|
||||||
|
@ -116,10 +116,10 @@
|
||||||
(set! book-list (rest (ref book-list)))]))
|
(set! book-list (rest (ref book-list)))]))
|
||||||
|
|
||||||
;; keep track of book club members
|
;; keep track of book club members
|
||||||
(define/query-set members (club-member (bind name String)) name
|
(define/query-set members (club-member $name) name
|
||||||
#;#:on-add #;(printf "leader acknowledges member ~a\n" name))
|
#;#:on-add #;(printf "leader acknowledges member ~a\n" name))
|
||||||
|
|
||||||
(on (asserted (book-quote (ref title) (bind quantity Int)))
|
(on (asserted (book-quote (ref title) $quantity))
|
||||||
(printf "leader learns that there are ~a copies of ~a\n" quantity (ref title))
|
(printf "leader learns that there are ~a copies of ~a\n" quantity (ref title))
|
||||||
(cond
|
(cond
|
||||||
[(< quantity (+ 1 (set-count (ref members))))
|
[(< quantity (+ 1 (set-count (ref members))))
|
||||||
|
@ -128,9 +128,9 @@
|
||||||
[#t
|
[#t
|
||||||
;; find out if at least half of the members want to read the book
|
;; find out if at least half of the members want to read the book
|
||||||
(start-facet poll-members
|
(start-facet poll-members
|
||||||
(define/query-set yays (book-interest (ref title) (bind name String) #t) name)
|
(define/query-set yays (book-interest (ref title) $name #t) name)
|
||||||
(define/query-set nays (book-interest (ref title) (bind name String) #f) name)
|
(define/query-set nays (book-interest (ref title) $name #f) name)
|
||||||
(on (asserted (book-interest (ref title) (bind name String) discard))
|
(on (asserted (book-interest (ref title) $name _))
|
||||||
;; count the leader as a 'yay'
|
;; count the leader as a 'yay'
|
||||||
(when (>= (set-count (ref yays))
|
(when (>= (set-count (ref yays))
|
||||||
(/ (set-count (ref members)) 2))
|
(/ (set-count (ref members)) 2))
|
||||||
|
@ -172,7 +172,7 @@
|
||||||
;; assert our presence
|
;; assert our presence
|
||||||
(assert (club-member name))
|
(assert (club-member name))
|
||||||
;; respond to polls
|
;; respond to polls
|
||||||
(during (observe (book-interest (bind title String) discard discard))
|
(during (observe (book-interest $title _ _))
|
||||||
(define answer (member? title titles))
|
(define answer (member? title titles))
|
||||||
(printf "~a responds to suggested book ~a: ~a\n" name title answer)
|
(printf "~a responds to suggested book ~a: ~a\n" name title answer)
|
||||||
(assert (book-interest title name answer)))))))
|
(assert (book-interest title name answer)))))))
|
||||||
|
|
Loading…
Reference in New Issue