diff options
author | Juan Manuel Tomás <jtomas1815@gmail.com> | 2023-07-24 00:09:53 -0300 |
---|---|---|
committer | Juan Manuel Tomás <jtomas1815@gmail.com> | 2023-07-24 00:09:53 -0300 |
commit | bb4b2bc484ed1d827d707a5a50b234d6994af90c (patch) | |
tree | 832ec90bf0f34252447c3fd49311d3af3e319d56 | |
parent | 3d6e80b447ef96cdac3aada1f2ca08073648294f (diff) | |
download | utils-bb4b2bc484ed1d827d707a5a50b234d6994af90c.tar.gz utils-bb4b2bc484ed1d827d707a5a50b234d6994af90c.zip |
-rw-r--r-- | alien.lisp | 8 | ||||
-rw-r--r-- | char.lisp | 7 | ||||
-rw-r--r-- | color.lisp | 28 | ||||
-rw-r--r-- | package.lisp | 14 | ||||
-rw-r--r-- | str.lisp | 39 | ||||
-rw-r--r-- | utils.asd | 3 |
6 files changed, 88 insertions, 11 deletions
@@ -3,10 +3,10 @@ (defmacro call (fname rtype &rest types-n-values) (let ((tlist (queue:new)) (vlist (queue:new))) - (dolist (item types-n-values) - (queue:add tlist (first item)) - (queue:add vlist (second item))) + (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 - (function ,rtype + (sb-alien:function ,rtype ,@(queue:to-list tlist))) ,@(queue:to-list vlist)))) diff --git a/char.lisp b/char.lisp new file mode 100644 index 0000000..8d1f21c --- /dev/null +++ b/char.lisp @@ -0,0 +1,7 @@ +(in-package #:char) + +(defun whitespace? (x) + (some (lambda (y) (char= x y)) '(#\Space #\Newline #\Tab))) + +(defun visible? (x) + (char/= x #\Space #\Newline #\Tab)) diff --git a/color.lisp b/color.lisp new file mode 100644 index 0000000..d9ed800 --- /dev/null +++ b/color.lisp @@ -0,0 +1,28 @@ +(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))) diff --git a/package.lisp b/package.lisp index f2e0a24..5a1af97 100644 --- a/package.lisp +++ b/package.lisp @@ -1,5 +1,14 @@ -(defpackage #:alien +(defpackage #:color + (:use #:cl) + (:export #:hsl->rgb)) + +(defpackage #:char (:use #:cl) + (:export #:whitespace? + #:visible?)) + +(defpackage #:alien + (:use #:cl #:sb-alien) (:export #:call)) (defpackage #:queue @@ -15,6 +24,9 @@ (:use #:cl) (:export #:split #:from-list + #:underscore->hyphen + #:pascal->kebab + #:upcase->pascal #:read-file)) (defpackage #:small-cl @@ -1,8 +1,10 @@ (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)) @@ -10,17 +12,16 @@ (read-sequence buf file) buf))) -(declaim (ftype (function (simple-string simple-string) (values (cons simple-string) &optional)) split)) (defun split (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)) (min (the fixnum (+ (length delimiter) next)) - (the fixnum (length input)))) + (split-rec (queue:add result (subseq input start next)) + (min (the fixnum (+ (length delimiter) next)) + (the fixnum (length input)))) (queue:add result (subseq input start next)))))) (queue:to-list (split-rec (queue:new) 0)))) -(declaim (ftype (function ((or null (cons character))) (values simple-string &optional)) from-list)) (defun from-list (lst) (let ((str (make-string (length lst))) (i 0)) @@ -28,3 +29,31 @@ (setf (char str i) item) (incf i)) str)) + +(defun underscore->hyphen (str) + (let ((result (make-string-output-stream))) + (dotimes (i (length str)) + (if (char= #\_ (char str i)) + (format result "-") + (format result "~a" (char str i)))) + (get-output-stream-string result))) + +(defun pascal->kebab (str) + (let ((result (make-string-output-stream))) + (dotimes (i (length str)) + (if (and (> i 0) (upper-case-p (char str i))) + (format result "-~a" (char str i)) + (format result "~a" (char str i)))) + (get-output-stream-string result))) + +(defun upcase->pascal (str) + (let ((result (make-string-output-stream))) + (dotimes (i (length str)) + (if (and (< 0 i) + (upper-case-p (char str i)) + (not (lower-case-p (char str (1- i)))) + (or (= i (1- (length str))) + (not (lower-case-p (char str (1+ i)))))) + (format result "~a" (char-downcase (char str i))) + (format result "~a" (char str i)))) + (get-output-stream-string result))) @@ -1,7 +1,8 @@ (asdf:defsystem #:utils - :serial t :components ((:file "package") (:file "queue") (:file "alien") + (:file "char") + (:file "color") (:file "str"))) |