diff --git a/src/members-fees.scm b/src/members-fees.scm index 7fe3dc8..a79aa0e 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -30,6 +30,7 @@ ( lookup-member-fee member-calendar + make-member-calendar-entry member-calendar-first-month member-calendar-last-month member-calendar-query @@ -82,15 +83,17 @@ (if (cal-month>? cm last-month) (reverse cal) (loop (cal-month-add cm) - (cons (list cm - (with-current-month - cm - (brmember-flags mr)) - (with-current-month - cm - (brmember-spec-fee mr))) + (cons (with-current-month + cm + (make-member-calendar-entry mr)) cal)))))) + ;; Assumes current-month is specified correctly + (define (make-member-calendar-entry mr) + (list (*current-month*) + (brmember-flags mr) + (brmember-spec-fee mr))) + ;; Returns the first month of the calendar (define (member-calendar-first-month mc) (caar mc)) diff --git a/src/members-print.scm b/src/members-print.scm index fad53e6..b470e13 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -500,7 +500,17 @@ (null? (cdr dsa))) #f (cadr dsa)))) - (let* ((members ;; Pass 1 + (let* ((raw-members + (sort + (if destroyed? + (find-members-by-predicate MB (lambda x #t)) + (if only-active? + (find-members-by-predicate MB (lambda (mr) + (brmember-active? mr))) + (find-members-by-predicate MB (lambda (mr) + (not (brmember-destroyed? mr)))))) + brmemberfee make-member-calendar-entry) + (filter brmember-active? raw-members))) + (amts (sort (delete-duplicates flst) <)) + (sums + (map + (lambda (amt) + (cons amt + (length (filter (lambda (v) (= v amt)) flst)))) + amts)) + ) (print "Expected income: " - (+ (* (lookup-member-fee 'normal) full) - (* (lookup-member-fee 'student) students)) - " (" full " full members + " students " students)")) - ) - )) + (string-intersperse (map + (lambda (p) + (format "~A*~A" (cdr p) (car p))) + sums) + " + ") + " = " + (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))))) (define (unpaired-table mb . args) (apply