Skip to content

Instantly share code, notes, and snippets.

@texdraft
Created April 7, 2020 21:32
Show Gist options
  • Save texdraft/c7518c1ee6f71c28565590866562f064 to your computer and use it in GitHub Desktop.
Save texdraft/c7518c1ee6f71c28565590866562f064 to your computer and use it in GitHub Desktop.
(defconstant character-patterns
(quote ((#\Newline . #*000000000000)
(#\Space . #*000000000000)
(#\0 . #*001000000000)
(#\1 . #*000100000000)
(#\2 . #*000010000000)
(#\3 . #*000001000000)
(#\4 . #*000000100000)
(#\5 . #*000000010000)
(#\6 . #*000000001000)
(#\7 . #*000000000100)
(#\8 . #*000000000010)
(#\9 . #*000000000001)
(#\= . #*000000001010)
(#\" . #*000000000110)
(#\+ . #*100000001010)
(#\A . #*100100000000)
(#\B . #*100010000000)
(#\C . #*100001000000)
(#\D . #*100000100000)
(#\E . #*100000010000)
(#\F . #*100000001000)
(#\G . #*100000000100)
(#\H . #*100000000010)
(#\I . #*100000000001)
(#\. . #*100001000010)
(#\) . #*010000010010)
(#\- . #*010000000000)
(#\J . #*010100000000)
(#\K . #*010010000000)
(#\L . #*010001000000)
(#\M . #*010000100000)
(#\N . #*010000010000)
(#\O . #*010000001000)
(#\P . #*010000000100)
(#\Q . #*010000000010)
(#\R . #*010000000001)
(#\* . #*010000100010)
(#\/ . #*001100000000)
(#\S . #*001010000000)
(#\T . #*001001000000)
(#\U . #*001000100000)
(#\V . #*001000010000)
(#\W . #*001000001000)
(#\X . #*001000000100)
(#\Y . #*001000000010)
(#\Z . #*001000000001)
(#\, . #*001001000010)
(#\$ . #*010001000010)
(#\( . #*100000010010))))
(defvar character-table (make-hash-table :test 'equalp))
(mapcar (lambda (c)
(setf (gethash (car c) character-table) (cdr c)))
character-patterns)
(defun n-characters (n character)
(make-string n :initial-element character))
(defun string->card-string (string &optional (card-width 72) (punched #\*))
(let* ((string (string-right-trim '(#\Space #\Tab) string))
(length (length string)))
(with-output-to-string (out)
(format out " ~A~%/~:@(~A~)~@?|~%" (n-characters card-width #\_)
string
(format nil "~~~D,0T" (+ card-width 1)))
(loop for r from 0 below 12 do
(write-char #\| out)
(loop for i from 0 below card-width do
(let ((blank (if (< r 2)
#\Space
(digit-char (- r 2))))
(c (if (>= i length)
0
(sbit (gethash (char string i) character-table) r))))
(write-char (if (not (zerop c))
punched
blank)
out)))
(write-char #\| out)
(terpri out))
(format out "|~A|~%" (n-characters card-width #\_)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment