mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-01-01 06:41:11 -08:00
Code Issues Projects Releases Wiki Activity

unit*,default units on builder and set-geometry, working color pickers

Browse source
This commit is contained in:
David Botton 2022-09-13 15:59:35 -04:00
parent 7e9dfb9038
commit c241b62d4a
5 changed files with 61 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

31
source/clog-element.lisp
View file

@ -1456,30 +1456,31 @@ parent in the DOM."))
(defgeneric set-geometry (clog-element &key left top right bottom
width height units)
(:documentation "Change the geometry :LEFT :TOP :RIGHT :BOTTOM
:WIDTH :HEIGHT each optional in UNITS (default :px)"))
:WIDTH :HEIGHT each optional. If any measure is missing a unit,
UNITS (default :px) is used."))
(defmethod set-geometry ((obj clog-element) &key left top right bottom
width height (units :px))
(jquery-execute obj (format nil "css({~@[~a~]~@[~a~]~@[~a~]~@[~a~]~@[~a~]~@[~a~]})"
(when left
(format nil "'left':'~A~A'," left units))
(format nil "'left':'~A'," (unit* units left)))
(when top
(format nil "'top':'~A~A'," top units))
(format nil "'top':'~A'," (unit* units top)))
(when right
(format nil "'right':'~A~A'," right units))
(format nil "'right':'~A'," (unit* units right)))
(when bottom
(format nil "'bottom':'~A~A'," bottom units))
(format nil "'bottom':'~A'," (unit* units bottom)))
(when width
(format nil "'width':'~A~A'," width units))
(format nil "'width':'~A'," (unit* units width)))
(when height
(format nil "'height':'~A~A'," height units)))))
(format nil "'height':'~A'," (unit* units height))))))
;;;;;;;;;;
;; left ;;
;;;;;;;;;;
(defgeneric left (clog-element)
(:documentation "Get/Setf left."))
(:documentation "Get/Setf left (defaults to us :px units)."))
(defmethod left ((obj clog-element))
(style obj "left"))
@ -1488,14 +1489,14 @@ parent in the DOM."))
(:documentation "Set left VALUE for CLOG-ELEMENT"))
(defmethod (setf left) (value (obj clog-element))
(setf (style obj "left") value))
(setf (style obj "left") (unit* :px value)))
;;;;;;;;;;;
;; right ;;
;;;;;;;;;;;
(defgeneric right (clog-element)
(:documentation "Get/Setf right."))
(:documentation "Get/Setf right (defaults to us :px units)."))
(defmethod right ((obj clog-element))
(style obj "right"))
@ -1504,14 +1505,14 @@ parent in the DOM."))
(:documentation "Set right VALUE for CLOG-ELEMENT"))
(defmethod (setf right) (value (obj clog-element))
(setf (style obj "right") value))
(setf (style obj "right") (unit* :px value)))
;;;;;;;;;
;; top ;;
;;;;;;;;;
(defgeneric top (clog-element)
(:documentation "Get/Setf top."))
(:documentation "Get/Setf top (defaults to us :px units)."))
(defmethod top ((obj clog-element))
(style obj "top"))
@ -1520,14 +1521,14 @@ parent in the DOM."))
(:documentation "Set top VALUE for CLOG-ELEMENT"))
(defmethod (setf top) (value (obj clog-element))
(setf (style obj "top") value))
(setf (style obj "top") (unit* :px value)))
;;;;;;;;;;;;
;; bottom ;;
;;;;;;;;;;;;
(defgeneric bottom (clog-element)
(:documentation "Get/Setf bottom."))
(:documentation "Get/Setf bottom (defaults to us :px units)."))
(defmethod bottom ((obj clog-element))
(style obj "bottom"))
@ -1536,7 +1537,7 @@ parent in the DOM."))
(:documentation "Set bottom VALUE for CLOG-ELEMENT"))
(defmethod (setf bottom) (value (obj clog-element))
(setf (style obj "bottom") value))
(setf (style obj "bottom") (unit* :px value)))
;;;;;;;;;;;;;;;;
;; box-height ;;

28
source/clog-utilities.lisp
View file

@ -182,6 +182,20 @@ and not for security purposes or html escapes."
"Return RGB string, red green and blue may be 0-255"
(format nil "rgb(~A, ~A, ~A)" red green blue))
;;;;;;;;;;;;;;;;
;; rgb-to-hex ;;
;;;;;;;;;;;;;;;;
(defun rgb-to-hex (rgb)
"Return hex #rrggbb from rgb(red,green,blue)"
(multiple-value-bind (m l)
(ppcre:scan-to-strings "rgba?\\s?\\((\\d+),\\s?(\\d+),\\s?(\\d+),?\\s?(\\d*)\\)" rgb)
(declare (ignore m))
(format nil "#~2,'0x~2,'0x~2,'0x"
(parse-integer (aref l 0))
(parse-integer (aref l 1))
(parse-integer (aref l 2))))))
;;;;;;;;;;
;; rgba ;;
;;;;;;;;;;
@ -240,6 +254,20 @@ alpha 0.0 - 1.0"
"produce a string from numeric value with UNIT-TYPE appended."
(format nil "~A~A" value unit-type))
(defun unit* (unit-type value)
"Returns value and if no unit was specified on value
unit added unless value is empty string or nil."
(cond ((or (equal value "")
(eq value nil))
value)
(t
(let* ((str (format nil "~A" value))
(l (char-code (uiop:last-char str))))
(if (or (numberp value)
(and (>= l 48) (<= l 57)))
(format nil "~A~A" str unit-type)
str)))))
;; https://www.w3schools.com/colors/colors_names.asp
;;
;; From - https://www.w3schools.com/

4
source/clog.lisp
View file

@ -95,12 +95,14 @@ embedded in a native template application.)"
"CLOG Color utilities"
(rgb function)
(rgb-to-hex function)
(rgba function)
(hsl function)
(hsla function)
"CLOG Unit utilities"
(unit function))
(unit function)
(unit* function))
(defsection @clog-obj (:title "CLOG Objects")
"CLOG-Obj - Base class for CLOG Objects"

21
tools/clog-builder-settings.lisp
View file

@ -137,12 +137,13 @@
(declare (ignore td1))
(let ((dd (create-select td2))
(v (string-downcase (positioning control))))
(add-select-options dd `(,v
"absolute"
(add-select-options dd '("absolute"
"static"
"relative"
"sticky"
"fixed"))
(set-geometry dd :width "100%")
(setf (value dd) v)
(set-on-change dd (lambda (obj)
(declare (ignore obj))
(when (equalp (value dd) "static")
@ -250,12 +251,14 @@
:setup ,(lambda (control td1 td2)
(declare (ignore td1))
(let ((d1 (create-form-element td2 :text :value (color control)))
(dd (create-form-element td2 :color :value (color control))))
(dd (create-form-element td2 :color :value (rgb-to-hex (color control)))))
(set-geometry d1 :width "100%")
(set-geometry dd :width "100%")
(make-data-list dd '("#ffffff"
"#000000"
"#ff0000"
"#00ff00"
"#0000ff"
"#ff00ff"))
"#0000ff"))
(set-on-change dd (lambda (obj)
(declare (ignore obj))
(setf (value d1) (value dd))
@ -270,12 +273,14 @@
:setup ,(lambda (control td1 td2)
(declare (ignore td1))
(let ((d1 (create-form-element td2 :text :value (background-color control)))
(dd (create-form-element td2 :color :value (background-color control))))
(dd (create-form-element td2 :color :value (rgb-to-hex (background-color control)))))
(set-geometry d1 :width "100%")
(set-geometry dd :width "100%")
(make-data-list dd '("#ffffff"
"#000000"
"#ff0000"
"#00ff00"
"#0000ff"
"#ff00ff"))
"#0000ff"))
(set-on-change dd (lambda (obj)
(declare (ignore obj))
(setf (value d1) (value dd))

2
tools/clog-builder.lisp
View file

@ -990,7 +990,7 @@ not a temporary attached one when using select-control."
(declare (ignore td1))
(let ((dd (create-select td2))
(v (attribute (parent-element control) "data-clog-name")))
(setf (width dd) "100%")
(set-geometry dd :width "100%")
(add-select-options dd panel-controls)
(setf (value dd) v)
(set-on-change dd