83 lines
3 KiB
Common Lisp
83 lines
3 KiB
Common Lisp
(load (sb-ext:posix-getenv "ASDF"))
|
|
(asdf:load-system 'cl-dates)
|
|
|
|
;; week is 7 days
|
|
;; 52 weeks in a year
|
|
;; 13 weeks in a quarter
|
|
|
|
;; cycle is 4 weeks
|
|
;; standing in for a month
|
|
;; 3 cycles in a quarter
|
|
|
|
;; quarter is 3 cycles + a week
|
|
;; 4 quarters in a year
|
|
|
|
|
|
; ---
|
|
|
|
(defun add-weeks (date weeks)
|
|
(+ date (* weeks 7)))
|
|
(defun week-number (date)
|
|
(mod (cl-dates:week-number date) 52))
|
|
|
|
(defun write-page-header (stream header-text)
|
|
(format stream "
|
|
#set page(
|
|
paper: \"a4\",
|
|
flipped: true,
|
|
header: align(bottom)[~A],
|
|
margin: (
|
|
top: 1.5cm,
|
|
bottom: 0.5cm,
|
|
x: 0.5cm
|
|
))
|
|
" 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(
|
|
columns: (auto ,1fr, 1fr, 1fr, 1fr, 1fr, 1fr, 1fr),
|
|
rows: (auto, 1fr),
|
|
table.header([],align(center)[Monday],align(center)[Tuesday],align(center)[Wednesday],align(center)[Thursday],align(center)[Friday],align(center)[Saturday],align(center)[Sunday])")
|
|
(loop for week from 0 to 3
|
|
do (format stream "~%,align(horizon)[#rotate(270deg, reflow: true)[Week ~d]]" (week-number (+ cl-date (* week 7))))
|
|
do (loop for day from 0 to 6
|
|
do (let ((cycle-day (+ cl-date day (* week 7))))
|
|
(multiple-value-bind (yy mm dd) (cl-dates:date->ymd cycle-day)
|
|
(if (= 1 dd)
|
|
(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(
|
|
columns: (1fr, 1fr, 1fr),
|
|
rows: (1fr),
|
|
align(center)[_Going In_]")
|
|
(loop for day from 0 to 6
|
|
do (let* ((week-day (+ cl-date day))
|
|
(day-of-week (cl-dates:dow->string (cl-dates:day-of-week week-day))))
|
|
(multiple-value-bind (yy mm dd) (cl-dates:date->ymd week-day)
|
|
(if (= 1 dd)
|
|
(format stream ",[~A #h(1fr) ~A]~%" day-of-week (cl-dates:month->string mm))
|
|
(format stream ",[~A #h(1fr) ~d]~%" day-of-week dd))
|
|
)))
|
|
(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)))
|
|
))
|