(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 */~%") (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))) ))