#+TITLE: Demons calendar #+AUTHOR: screwlisp #+PROPERTY: header-args:lisp :tangle yes * My amazing goban symbolic calendar #+CALL: goban-print(sym='*l19*) #+RESULTS: #+begin_example _A: 001 CF2 CF3 CF4 CF5 CF6 007 008 009 010 011 012 013 014 015 016 017 018 019 _B: 020 021 022 023 024 025 026 027 028 029 030 031 032 033 034 035 036 037 038 _C: 039 040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 _D: 058 059 060 061 062 063 064 065 066 067 068 069 070 071 072 073 074 075 076 _E: 077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 095 _F: 096 097 098 099 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 _G: 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 _H: 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 _J: 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 _K: 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 _L: 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 _M: 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 _N: 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 _O: 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 _P: 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 _Q: 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 _R: 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 _S: 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 _T: 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 #+end_example Alright! My own entry in my own calendar challenge * Screwtape's calendar I had the idea that a time sequence could be a list. ** SCREWTAPE'S CALENDAR CODE #+make-calendar #+begin_src lisp (defvar *cal* (list)) #+end_src #+RESULTS: : *CAL* ** Events and that events could be 3 letter ANSI graphic char symbols. The tricky thing is that I thought they should be interned in a different package. *** event package #+begin_src lisp (defvar *cal-event-pkg* (uiop:ensure-package :|scr|)) #+end_src #+RESULTS: : *CAL-EVENT-PKG* *** add events #+name: add-intern-event #+begin_src lisp (defun add-event (sym) (push (eval `(defvar ,(intern (format nil "~a" sym) *cal-event-pkg*))) ,*cal*)) #+end_src #+RESULTS: add-intern-event : ADD-EVENT *** events and event naming Since one might want to compare lots and lots of events at once, I'm going to use 3 letter ansi graphic char names per event, but put an event class in the symbol-value **** Event class #+begin_src lisp (defclass calendar-event () ((subevents :type t :initarg :subevents :accessor subevents) (show-sub-p :initarg :show-sub-p :accessor show-sub-p) (notes :Type t :initarg :notes :accessor notes) (show-notes-p :initarg :show-notes-p :accessor show-notes-p) (show-obj-p :initarg :show-obj-p :accessor show-obj-p)) (:default-initargs :notes () :subevents () :show-notes-p t :show-sub-p t :show-obj-p nil) (:documentation "Screwtape's calendar event class")) (defmethod print-object ((obj calendar-event) stream) (princ "#<" stream) (when (show-obj-p obj) (call-next-method) (terpri stream)) (when (show-sub-p obj) (princ "Subevents: " stream) (terpri stream) (princ (subevents obj) stream) (terpri stream)) (when (show-notes-p obj) (princ "Notes: " stream) (format stream "~{~%~a~}" (notes obj))) (princ ">" stream)) #+end_src #+RESULTS: : # ** A week calendar *** Fresh special variables #+name: fresh-cal #+begin_src lisp :var name='wek (setq *cal* ()) (setq *cal-event-pkg* (uiop:ensure-package name)) #+end_src #+RESULTS: fresh-cal : # #+RESULTS: : # *** Add days with events #+begin_src lisp (loop for day in '(mon tue wed thu fri sat sun) for sym = (car (add-event day)) for evn = (make-instance 'calendar-event) do (set sym evn) finally (setf *cal* (nreverse *cal*)) (return *cal*)) #+end_src #+RESULTS: | WEK::MON | WEK::TUE | WEK::WED | WEK::THU | WEK::FRI | WEK::SAT | WEK::SUN | *** Add some stuff to tuesday. #+begin_src lisp (push "some-note" (notes wek::tue)) (push "some other note" (notes wek::tue)) (push "multi line" (notes wek::tue)) (push 'bish (subevents wek::tue)) (push 'bash (subevents wek::tue)) (push 'bosh (subevents wek::tue)) wek::tue #+end_src #+RESULTS: : #<# : Subevents: (BOSH BASH BISH) : Notes: : multi : line : some other note : some-note *** Save cal to var and look at a day #+begin_src lisp (defparameter *wek* *cal*) (list (second *wek*) (symbol-value (second *wek*))) #+end_src #+RESULTS: : (WEK::TUE #<# : Subevents: (BOSH BASH BISH) : Notes: : multi : line : some other note : some-note) *** Actually, I really want to get the unreadable print as a padded list of lines. #+begin_src lisp :results verbatim output (defmethod list-unreadable ((obj calendar-event) &optional (padded-to 32)) (with-input-from-string (in (with-output-to-string (*standard-output*) (princ obj))) (loop for line = (read-line in nil nil) for padded = (format nil "~vA" padded-to line) while line collect padded))) (let ((summary (list-unreadable wek::tue))) (format t "~{~s~^~%~}" summary)) #+end_src #+RESULTS: : # *** util #+begin_src lisp (eval-when (:compile-toplevel :execute :load-toplevel) (defmacro clss ((sym) &optional (count 0)) `(car (last (subevents (symbol-value ,(if (zerop count) `',sym `(clss (,sym) ,(1- count))))))))) #+end_src *** Create goban year calendar #+begin_src lisp (loop initially (setf *cal-event-pkg* (uiop:ensure-package :l19)) for row below 19 for letter in '(a b c d e f g h j k l m n o p q r s t) for str = (format nil "_~a:" letter) collect (car (Add-event str)) into tmp do (set (car (last tmp)) (make-instance 'calendar-event :subevents (loop initially (setq *cal* '()) for col below 19 for flat = (+ col (* 19 row) 1) for pad = (format nil "~3,'0d" flat) for sym = (car (add-event pad)) do (set sym (make-instance 'calendar-event)) finally (return (nreverse *cal*))))) finally (setq *cal* tmp)) (defvar *l19*) (setq *l19* (make-instance 'calendar-event :subevents *cal*)) (setq *cal* nil) (defparameter *361st-day* (clss (*l19*) 1)) (symbol-value *361st-day*) #+end_src #+RESULTS: : # *** Add the remaining 5 days So every year is covered in one go. These are going to be handled like this: January 2 3 4 5 6 ie 002 003 004 005 006 get replaced by CF2 CF3 CF4 CF5 CF6, mnemonically "conflict". CF2 has subevents: 002 and 362, CF3 -> 003 and 363 etc until CF6. The presence of this line also naturally orients the *l19* square. #+begin_src lisp (loop initially (setq *cal* nil) for x from 2 to 6 for yend = (car (add-event (format nil "36~d" x))) for orig = (intern (format nil "00~d" x) *cal-event-pkg*) for comb = (car (add-event (format nil "CF~d" x))) do (set yend (make-instance 'calendar-event)) (set comb (make-instance 'calendar-event :subevents `(,orig ,yend))) collect comb into combo finally (setf (subseq (subevents (symbol-value (car (subevents *l19*)))) 1 6) combo)) #+end_src #+RESULTS: : NIL *** Goban print! #+begin_src lisp (defun goban-print (l19-calendar &optional (stream t)) (loop for row in (subevents l19-calendar) do (format stream "~a ~{~a~^ ~}~%" row (subevents (symbol-value row))))) (goban-print *l19*) #+end_src *** Do goban print #+name: goban-print #+HEADER: :var sym='*l19* #+begin_src lisp :results output (goban-print (symbol-value sym))) #+end_src #+RESULTS: goban-print #+begin_example _A: 001 CF2 CF3 CF4 CF5 CF6 007 008 009 010 011 012 013 014 015 016 017 018 019 _B: 020 021 022 023 024 025 026 027 028 029 030 031 032 033 034 035 036 037 038 _C: 039 040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 _D: 058 059 060 061 062 063 064 065 066 067 068 069 070 071 072 073 074 075 076 _E: 077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 095 _F: 096 097 098 099 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 _G: 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 _H: 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 _J: 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 _K: 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 _L: 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 _M: 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 _N: 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 _O: 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 _P: 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 _Q: 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 _R: 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 _S: 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 _T: 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 #+end_example