aland/cyclic-calendar
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

more fmt

Browse source
This commit is contained in:
Alan Daniels 2025-12-19 21:03:36 +11:00
parent c10511a418
commit df5afab545
2 changed files with 26 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
cal.lisp
View file

@ -33,6 +33,7 @@
))
" header-text)
)
(defun write-page-cycle (stream cl-date year-number quarter-number cycle-number)
(write-page-header stream (format nil "Y~d #h(1fr) Q~d #h(1fr) C~d" year-number quarter-number cycle-number))
(format stream "#table(
@ -48,6 +49,7 @@
(format stream ",[#h(1fr) ~A]" (cl-dates:month->string mm))
(format stream ",[#h(1fr) ~d]" dd))))))
(format stream ")~%"))
(defun write-page-reset-week (stream cl-date year-number quarter-number)
(write-page-header stream (format nil "Y~d #h(1fr) Q~d #h(1fr) Reset Week" year-number quarter-number))
(format stream "#table(
@ -64,15 +66,18 @@
)))
(format stream ",align(center)[_Coming Out_]")
(format stream ")~%"))
(defun write-pages-quarter (stream cl-date year-number quarter-number)
(loop for c from 0 to 2 do (write-page-cycle stream (add-weeks cl-date (* c 4)) year-number quarter-number (+ c 1)))
(write-page-reset-week stream (add-weeks cl-date 12) year-number quarter-number))
(with-open-file (stream "main.typ"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(format stream "/* This is an auto-generated file
You can run `sbcl --script ./cal.lisp` to create a new one */~%")
(write-page-reset-week stream (cl-dates:ymd->date 2025 12 22) 2025 4)
(let ((year-start (cl-dates:ymd->date 2025 12 29)))
(loop for q from 0 to 3 do (write-pages-quarter stream (add-weeks year-start (* q 13)) 2026 (+ q 1)))
))