Work on calendar formatting.

This commit is contained in:
Dominik Pantůček 2023-03-27 21:18:11 +02:00
parent 2a6b364b4a
commit 3e9b421f60
3 changed files with 45 additions and 1 deletions

View file

@ -137,7 +137,13 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(if mr (if mr
(let () (let ()
(print-member-table mr) (print-member-table mr)
(print (member-calendar mr))) (print (table->string (cons (list "" 1 2 3 4 5 6 7 8 9 10 11 12)
(member-calendar->years-table (member-calendar mr)))
#:table-border #t
#:row-border #t
#:col-border #t
#:ansi #t
)))
(print-members-base-table MB)) (print-members-base-table MB))
(newline)) (newline))
((print-stats) ((print-stats)

View file

@ -32,6 +32,7 @@
member-calendar-first-month member-calendar-first-month
member-calendar-last-month member-calendar-last-month
member-calendar-query member-calendar-query
member-calendar->years-table
member-calendar->fees member-calendar->fees
) )
@ -72,6 +73,37 @@
(define (member-calendar-query mc m) (define (member-calendar-query mc m)
(assoc m mc)) (assoc m mc))
;; Formats the calendar entry for visualization
(define (member-calendar-entry->string e)
(if e
(if (member 'existing (cadr e))
"EEE"
" ")
" "))
;; Converts the calendar into a table where rows represent years and
;; contain the year in the first cell and 12 cells for months after
;; it.
(define (member-calendar->years-table mc)
(let* ((fm (member-calendar-first-month mc))
(lm (member-calendar-last-month mc))
(fy (month-year fm))
(ly (month-year lm)))
(let loop ((y fy)
(rows '()))
(if (> y ly)
(reverse rows)
(loop (add1 y)
(cons (let mloop ((m 1)
(row (list y)))
(if (> m 12)
(reverse row)
(mloop (add1 m)
(cons (member-calendar-entry->string
(member-calendar-query mc (make-month y m)))
row))))
rows))))))
(define (member-calendar->fees mr) (define (member-calendar->fees mr)
#f) #f)

View file

@ -29,6 +29,8 @@
month month
( (
make-month make-month
month-year
month-month
month-valid? month-valid?
string->month string->month
month->string month->string
@ -52,6 +54,10 @@
(define (make-month y m) (define (make-month y m)
(list y m)) (list y m))
;; Accessors
(define month-year car)
(define month-month cadr)
;; Returns true if this is a valid month representation - a list with ;; Returns true if this is a valid month representation - a list with
;; two integer elements within the allowed range. ;; two integer elements within the allowed range.
(define (month-valid? m) (define (month-valid? m)