brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Porting to new calendar modules.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-09 22:56:50 +02:00
parent 21a58e9536
commit cc463991c1
10 changed files with 57 additions and 545 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/members-fees.scm
View file

@ -47,17 +47,17 @@
(chicken sort)
configuration
brmember
month
cal-month
ansi
table
mbase
period
cal-period
specification
util-list)
;; Returns a matching list of (list regular student)
(define (lookup-member-fees)
(lookup-by-period member-fees-lookup-table))
(lookup-by-cal-period member-fees-lookup-table))
;; Returns time-based fee for given type
(define (lookup-member-fee type)
@ -74,12 +74,12 @@
(let ((last-month (if (null? args)
(*current-month*)
(car args)))
(first-month (period-since (car (brmember-info mr 'member)))))
(first-month (cal-period-since (car (brmember-info mr 'member)))))
(let loop ((cm first-month)
(cal '()))
(if (month>? cm last-month)
(if (cal-month>? cm last-month)
(reverse cal)
(loop (month-add cm)
(loop (cal-month-add cm)
(cons (list cm
(parameterize ((*current-month* cm))
(brmember-flags mr)))
@ -134,8 +134,8 @@
'()
(let* ((fm (member-calendar-first-month mc))
(lm (member-calendar-last-month mc))
(fy (month-year fm))
(ly (month-year lm)))
(fy (cal-month-year fm))
(ly (cal-month-year lm)))
(let loop ((y fy)
(rows '()))
(if (> y ly)
@ -147,7 +147,7 @@
(reverse row)
(mloop (add1 m)
(cons (member-calendar-entry->string
(member-calendar-query mc (make-month y m)))
(member-calendar-query mc (make-cal-month y m)))
row))))
rows)))))))