init

cal.lisp

@@ -0,0 +1,94 @@
+(load (sb-ext:posix-getenv "ASDF"))
+(asdf:load-system 'str)
+(asdf:load-system 'alexandria)
+(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-cycle (stream cl-date year-number quarter-number cycle-number)
+	(format stream "
+		#set page(
+			paper: \"a4\",
+			flipped: true,
+			header: [
+				Y~d
+				#h(1fr)
+				Q~d
+				#h(1fr)
+				C~d
+				],
+			margin: 0.5cm)
+		" 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)
+	(format stream "
+		#set page(
+			paper: \"a4\",
+			flipped: true,
+			header: [
+				Y~d
+				#h(1fr)
+				Q~d
+				#h(1fr)
+				Reset Week
+				],
+			margin: 0.5cm)
+		" 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)))
+		))