I usually have to convert hex code to Lispworks' color-spec. And here's some interesting ways to separate color components from hex code in Lisp.
Assuming we have hex string like "#AABBCCDD"
or #ABCD
, to collect its r, g, b, a
and convert them to single-float in range 0-1
:
Parsing Each Byte
Parsing hex numbers in string maybe the most straightest. One way is to use parse-integer
on each part of the code like this:
(parse-integer (subseq str i (1+ i)) :radix 16)
But if you prefer a way more "lisper", you can also use read
instead of parse-integer
. This may be more flexible:
(let ((*read-base* 16))
(read-from-string (subseq str (1- i) i)))
To split out substrings, we can use subseq
with an arithmatic loop; and with string-trim
to cut off junks:
(loop with str = (string-trim '(#\# #\Space) hex)
for i from 0 below (length str) by 2
collect (parse-integer (subseq str i (1+ i)) :radix 16))
Now we have collected a list, but it can be annoying to manually re-order them. We can take a few changes to our loop keywords to adjust the list, using downfrom
and above
; and, it's more convenient to use destructuring-bind
here, which can apply the versatile Ordinary Lambda List
facility:
(destructuring-bind (b g r &optional (a 0))
(loop with str = (string-trim '(#\# #\Space) hex)
for i downfrom (1- (length str)) above 0 by 2
collect (parse-integer (subseq str i (1+ i)) :radix 16))
())
There's two types of Hex color expression: One is (unsigned-byte 8)
of each unit and has a deno of 255, another is (unsigned-byte 4)
and has a deno of 15. We can distinct them by their length:
(destructuring-bind (b g r &optional (a 0))
(loop with str = (string-trim '(#\# #\Space) hex)
with deno = (if (> (length str) 4) 255 16)
for i downfrom (1- (length str)) above 0 by 2
collect (/ (float (parse-integer (subseq str i (1+ i)) :radix 16))
deno))
())
Finally we can encapsulate the code into function, for example if I need a Lispworks' color:color-spec
:
(defun hex-to-spec (hex)
(destructuring-bind (b g r &optional (a 0))
(loop with str = (string-trim '(#\# #\Space) hex)
with deno = (if (> (length str) 4) 255 16)
for i downfrom (1- (length str)) above 0 by 2
collect (/ (float (parse-integer (subseq str i (1+ i)) :radix 16))
deno))
(color:make-rgb r g b (+ (- a) 1))))
Byte Shifting
There's another choice of using byte-shifting instead of apply parse-integer
on each part. It maybe more effective, but we need slightly longer code:
(defun hex-to-spec (hex)
(let* ((str (string-trim '(#\# #\Space) hex))
(hex-val (parse-integer str :radix 16))
(deno (if (> (length str) 4) 255 15))
(shift (logcount deno)))
(let ((b (logand hex-val deno))
(g (ash (logand hex-val (ash deno shift)) (- shift)))
(r (ash (logand hex-val (ash deno (* 2 shift))) (- (* 2 shift))))
(a (ash (logand hex-val (ash deno (* 3 shift))) (- (* 3 shift)))))
(apply #'color:make-rgb
(mapcar #'(lambda (f) (/ (float f) deno))
(list r g b (+ (- a) deno)))))))
Why I Write This
Improving personal ability is always a hard odyssey. This is what I've done at the first time I got this requirement:
(defun hex-to-spec (hex)
(let ((hex-list (case (length hex)
(4 (mapcar #'string
(loop for i from 1 to 3 collect (schar hex i))))
(7 (loop for i from 1 to 5 by 2
collect (subseq hex i (+ 2 i))))
(5 (nconc (mapcar #'string
(loop for i from 2 to 4 collect (schar hex i)))
(list (string (aref hex 1)))))
(9 (nconc (loop for i from 3 to 7 by 2
collect (subseq hex i (+ 2 i)))
(list (subseq hex 1 3))))))
(deno (if (< (length hex) 6) 15 255)))
(apply #'color:make-rgb
(mapcar #'(lambda (f) (/ (float f) deno))
(mapcar #'(lambda (s) (parse-integer s :radix 16))
hex-list)))))
That's surely awful. But after weeks of exploration, I can finally write a more elegant code above. I hope this post can be a documentary of my growing, telling me that I can do better with my endeavour. And you, I hope you can do it too.