From bb4b2bc484ed1d827d707a5a50b234d6994af90c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= <jtomas1815@gmail.com>
Date: Mon, 24 Jul 2023 00:09:53 -0300
Subject: Add char, color and name transformers

---
 alien.lisp   |  8 ++++----
 char.lisp    |  7 +++++++
 color.lisp   | 28 ++++++++++++++++++++++++++++
 package.lisp | 14 +++++++++++++-
 str.lisp     | 39 ++++++++++++++++++++++++++++++++++-----
 utils.asd    |  3 ++-
 6 files changed, 88 insertions(+), 11 deletions(-)
 create mode 100644 char.lisp
 create mode 100644 color.lisp

diff --git a/alien.lisp b/alien.lisp
index 3451dc9..5e870ec 100644
--- a/alien.lisp
+++ b/alien.lisp
@@ -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
diff --git a/str.lisp b/str.lisp
index aee3604..e00fb0f 100644
--- a/str.lisp
+++ b/str.lisp
@@ -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)))
diff --git a/utils.asd b/utils.asd
index 878e309..6ce8f62 100644
--- a/utils.asd
+++ b/utils.asd
@@ -1,7 +1,8 @@
 (asdf:defsystem #:utils
-  :serial t
   :components
   ((:file "package")
    (:file "queue")
    (:file "alien")
+   (:file "char")
+   (:file "color")
    (:file "str")))
-- 
cgit v1.2.3