diff options
| -rw-r--r-- | alien.lisp | 12 | ||||
| -rw-r--r-- | char.lisp | 6 | ||||
| -rw-r--r-- | color.lisp | 48 | ||||
| -rw-r--r-- | package.lisp | 47 | ||||
| -rw-r--r-- | queue.lisp | 14 | ||||
| -rw-r--r-- | str.lisp | 41 | ||||
| -rw-r--r-- | symbol.lisp | 9 | ||||
| -rw-r--r-- | utils.asd | 5 |
8 files changed, 82 insertions, 100 deletions
diff --git a/alien.lisp b/alien.lisp deleted file mode 100644 index 5e870ec..0000000 --- a/alien.lisp +++ /dev/null @@ -1,12 +0,0 @@ -(in-package #:alien) - -(defmacro call (fname rtype &rest types-n-values) - (let ((tlist (queue:new)) - (vlist (queue:new))) - (do () ((null types-n-values) nil) - (queue:add tlist (pop types-n-values)) - (queue:add vlist (pop types-n-values))) - `(alien-funcall (extern-alien ,fname - (sb-alien:function ,rtype - ,@(queue:to-list tlist))) - ,@(queue:to-list vlist)))) @@ -1,7 +1,5 @@ (in-package #:char) (defun whitespace? (x) - (some (lambda (y) (char= x y)) '(#\Space #\Newline #\Tab))) - -(defun visible? (x) - (char/= x #\Space #\Newline #\Tab)) + (or (char= x #\Space) + (not (graphic-char-p x)))) @@ -1,28 +1,26 @@ (in-package #:color) (defun hsl->rgb (h s l) - (let* ((c (* (- 1 (abs (- (* 2 l) 1))) s)) - (x (* c (- 1 (abs (- (mod (/ h 60) 2) 1))))) - (m (- l (/ c 2))) - (r m) - (g m) - (b m)) - (cond ((<= 0 h 59) - (incf r c) - (incf g x)) - ((<= 60 h 119) - (incf r x) - (incf g c)) - ((<= 120 h 179) - (incf g c) - (incf b x)) - ((<= 180 239) - (incf g x) - (incf b c)) - ((<= 240 299) - (incf r x) - (incf b c)) - ((<= 300 359) - (incf r c) - (incf b x))) - (values r g b))) + (declare (optimize (speed 3) (safety 0)) + ((single-float 0.0 1.0) h s l)) + (labels ((hue-to-rgb + (p q tt) + (declare (single-float p q tt)) + (setf tt (mod tt 1)) + (cond ((< tt (float (/ 1 6))) + (+ p (* (- q p) 6 tt))) + ((< tt (/ 1 2)) + q) + ((< tt (float (/ 2 3))) + (+ p (* (- q p) 6 (- (/ 2 3) tt)))) + (t p)))) + (if (= s 0) + (values l l l) + (let* ((q (if (< l 0.5) + (* l (1+ s)) + (+ l s (- (* l s))))) + (p (- (* 2 l) q))) + (values + (hue-to-rgb p q (+ h (/ 1 3))) + (hue-to-rgb p q h) + (hue-to-rgb p q (- h (/ 1 3)))))))) diff --git a/package.lisp b/package.lisp index 5a1af97..d170039 100644 --- a/package.lisp +++ b/package.lisp @@ -4,18 +4,16 @@ (defpackage #:char (:use #:cl) - (:export #:whitespace? - #:visible?)) + (:export #:whitespace?)) -(defpackage #:alien - (:use #:cl #:sb-alien) - (:export #:call)) +(defpackage #:symbol + (:use #:cl) + (:export #:normalize)) (defpackage #:queue - (:use #:cl) (:export #:new - #:add - #:sub + #:push + #:pop #:peek #:to-list #:from-list)) @@ -23,39 +21,16 @@ (defpackage #:str (:use #:cl) (:export #:split - #:from-list + #:remove-prefix #:underscore->hyphen #:pascal->kebab #:upcase->pascal - #:read-file)) + #:read-file + #:line-and-column + #:context-window)) (defpackage #:small-cl - (:import-from #:cl - #:block - #:catch - #:eval-when - #:flet - #:function - #:go - #:if - #:labels - #:let - #:let* - #:load-time-value - #:locally - #:macrolet - #:multiple-value-call - #:multiple-value-prog1 - #:progn - #:progv - #:quote - #:return-from - #:setq - #:symbol-macrolet - #:tagbody - #:the - #:throw - #:unwind-protect) + (:use #:cl) (:export #:block #:catch #:eval-when @@ -1,11 +1,9 @@ -(in-package #:queue) - (declaim (optimize (speed 3) (safety 1))) -(defun new () +(defun queue:new () (cons nil nil)) -(defun add (q datum) +(defun queue:push (datum q) (let ((element (cons datum nil))) (if (car q) (setf (cddr q) element) @@ -13,14 +11,14 @@ (setf (cdr q) element) q)) -(defun sub (q) +(defun queue:pop (q) (pop (car q))) -(defun peek (q) +(defun queue:peek (q) (caar q)) -(defun to-list (q) +(defun queue:to-list (q) (car q)) -(defun from-list (lst) +(defun queue:from-list (lst) (cons lst (last lst))) @@ -1,10 +1,5 @@ (in-package #:str) -(declaim (optimize speed)) -(declaim (ftype (function ((or pathname string)) (values simple-string &optional)) read-file)) -(declaim (ftype (function (simple-string simple-string) (values (cons simple-string) &optional)) split)) -(declaim (ftype (function ((or null (cons character))) (values simple-string &optional)) from-list)) - (defun read-file (path) (with-open-file (file path) (let* ((size (file-length file)) @@ -13,21 +8,21 @@ buf))) (defun split (input delimiter) + (declare (optimize speed) + (simple-string input delimiter)) (labels ((split-rec (result start) (let ((next (search delimiter input :start2 start))) (if next - (split-rec (queue:add result (subseq input start next)) + (split-rec (queue:push result (subseq input start next)) (min (the fixnum (+ (length delimiter) next)) (the fixnum (length input)))) - (queue:add result (subseq input start next)))))) + (queue:push result (subseq input start next)))))) (queue:to-list (split-rec (queue:new) 0)))) -(defun from-list (lst) - (let ((str (make-string (length lst))) - (i 0)) - (dolist (item lst) - (setf (char str i) item) - (incf i)) +(defun remove-prefix (str prefix) + (if (and (> (length str) (length prefix)) + (string= str prefix :end1 (length prefix))) + (subseq str (length prefix)) str)) (defun underscore->hyphen (str) @@ -57,3 +52,23 @@ (format result "~a" (char-downcase (char str i))) (format result "~a" (char str i)))) (get-output-stream-string result))) + +(defun line-and-column (str index) + (let ((line 1) (column 1)) + (dotimes (i index) + (let ((c (char str i))) + (case c + (#\Newline + (incf line) + (setf column 1)) + (t (incf column))))) + (cons line column))) + +(defun context-window (str index &key (side-length 20)) + (let ((begin (max (- index side-length) 0)) + (end (min (+ index side-length) (length str))) + (result '())) + (push (subseq str begin index) result) + (push (elt str index) result) + (push (subseq str (1+ index) end) result) + result)) diff --git a/symbol.lisp b/symbol.lisp new file mode 100644 index 0000000..3585976 --- /dev/null +++ b/symbol.lisp @@ -0,0 +1,9 @@ +(in-package #:symbol) + +(defun normalize (sym expression) + (nsubst-if sym + (lambda (x) + (and (symbolp x) + (string-equal (symbol-name x) + (symbol-name sym)))) + expression)) @@ -1,8 +1,9 @@ -(asdf:defsystem #:utils +(defsystem #:utils + :serial nil :components ((:file "package") (:file "queue") - (:file "alien") (:file "char") + (:file "symbol") (:file "color") (:file "str"))) |