Work on calendar formatting.
This commit is contained in:
parent
2a6b364b4a
commit
3e9b421f60
3 changed files with 45 additions and 1 deletions
|
@ -137,7 +137,13 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|||
(if mr
|
||||
(let ()
|
||||
(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))
|
||||
(newline))
|
||||
((print-stats)
|
||||
|
|
|
@ -32,6 +32,7 @@
|
|||
member-calendar-first-month
|
||||
member-calendar-last-month
|
||||
member-calendar-query
|
||||
member-calendar->years-table
|
||||
member-calendar->fees
|
||||
)
|
||||
|
||||
|
@ -72,6 +73,37 @@
|
|||
(define (member-calendar-query mc m)
|
||||
(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)
|
||||
#f)
|
||||
|
||||
|
|
|
@ -29,6 +29,8 @@
|
|||
month
|
||||
(
|
||||
make-month
|
||||
month-year
|
||||
month-month
|
||||
month-valid?
|
||||
string->month
|
||||
month->string
|
||||
|
@ -52,6 +54,10 @@
|
|||
(define (make-month 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
|
||||
;; two integer elements within the allowed range.
|
||||
(define (month-valid? m)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue