diff --git a/lass.asd b/lass.asd index f1d5362..f49b354 100644 --- a/lass.asd +++ b/lass.asd @@ -22,10 +22,7 @@ (:file "writer") (:file "lass") (:file "special") - (:file "units") (:file "asdf")) :depends-on (:trivial-indent :trivial-mimes - :physical-quantities - :parse-float :cl-base64)) diff --git a/lass.lisp b/lass.lisp index b28c4c1..5f79776 100644 --- a/lass.lisp +++ b/lass.lisp @@ -44,9 +44,6 @@ See COMPILE-CONSTRAINT." (destructuring-bind ,args ,argsym ,@body)))) -(defparameter *current-file* nil - "Current LASS file path") - (defun generate (in &key (out (merge-pathnames (make-pathname :type "css") in)) (pretty NIL) (if-exists :supersede)) "Generate a CSS file from a LASS file. @@ -56,8 +53,7 @@ PRETTY --- Whether to minify or not. See WRITE-SHEET. IF-EXISTS --- See WITH-OPEN-FILE Returns OUT" - (let ((eof (gensym "EOF")) - (*current-file* in)) + (let ((eof (gensym "EOF"))) (with-open-file (outstream out :direction :output :if-exists if-exists) (write-sheet (apply #'compile-sheet diff --git a/package.lisp b/package.lisp index 5cf5b6d..3b82ec3 100644 --- a/package.lisp +++ b/package.lisp @@ -42,8 +42,7 @@ ;; special.lisp (:export #:define-single-arg-selector - #:define-browser-property - #:*current-file*) + #:define-browser-property) ;; writer.lisp (:export #:*pretty* diff --git a/special.lisp b/special.lisp index 14e4fd9..99e2381 100644 --- a/special.lisp +++ b/special.lisp @@ -38,11 +38,12 @@ (proc arg)))) (write-string ")" out))) (write-string "calc" out) - (proc func)))) + (proc func)))) (define-simple-property-function counter (var)) ;;; BLOCKS + (define-special-block charset (charset) (list (list :property (format NIL "@charset ~a" (resolve charset))))) @@ -100,55 +101,9 @@ table))) ,@body)) -(defmacro bind-vars* (bindings &body body) - `(let ((*vars* (let ((table (make-hash-table))) - (maphash #'(lambda (k v) (setf (gethash k table) v)) *vars*) - table))) - (progn - (loop for (k v) in ,bindings - do (setf (gethash k *vars*) - (resolve v))) - ,@body))) - (define-special-block let (bindings &rest body) (bind-vars bindings - (apply #'compile-sheet body))) - -(define-special-block let* (bindings &rest body) - (bind-vars* bindings - (apply #'compile-sheet body))) - -(define-special-block include (file) - (format t "~A ~%" *current-file*) - (let* ((eof (gensym "EOF")) - (in (resolve file)) - (parent-dir (if *current-file* - (make-pathname :defaults *current-file* - :name nil :type nil) - #p"./")) - (directory (pathname-directory in)) - (parent-directory (pathname-directory parent-dir)) - (path - (make-pathname :defaults parent-dir - :directory (ecase (first directory) - ((nil) parent-directory) - (:absolute directory) - (:relative (append parent-directory (rest directory)))) - :name (pathname-name in) - :type (pathname-type in) - :version (pathname-version in))) - (*current-file* path)) - (bind-vars* '() - (apply #'compile-sheet - (with-open-file (instream path :direction :input) - (loop for read = (read instream NIL eof) - until (eql read eof) - collect read)))))) - -;;; Function for constructing property value lists in let/let* bindings -(setf (property-function "values") - (lambda (&rest args) (format nil "~{~a~^ ~}" (mapcar #'resolve args)))) - + (apply #'compile-sheet body))) ;;; SELECTORS diff --git a/units.lisp b/units.lisp deleted file mode 100644 index 8543d80..0000000 --- a/units.lisp +++ /dev/null @@ -1,258 +0,0 @@ -(defpackage :lass-units - (:use #:cl - #:lass - #:parse-float - #:physical-quantities) - (:export #:resolve-css-arg - #:with-css-units)) - -(in-package :lass-units) - -;;; Using physical-quantities to define units of measure relevant to CSS -(defmacro with-css-units (&body body) - `(with-local-units - (define-unit-prefix |yocto| -24 :abbrev |y|) - (define-unit-prefix |zepto| -21 :abbrev |z|) - (define-unit-prefix |atto| -18 :abbrev |a|) - (define-unit-prefix |femto| -15 :abbrev |f|) - (define-unit-prefix |pico| -12 :abbrev |p|) - (define-unit-prefix |nano| -9 :abbrev |n|) - (define-unit-prefix |micro| -6 :abbrev |u|) - (define-unit-prefix |milli| -3 :abbrev |m|) - (define-unit-prefix |centi| -2 :abbrev |c|) - (define-unit-prefix |deci| -1 :abbrev |d|) - (define-unit-prefix |deca| 1 :abbrev |da|) - (define-unit-prefix |hecto| 2 :abbrev |h|) - (define-unit-prefix |kilo| 3 :abbrev |k|) - (define-unit-prefix |mega| 6 :abbrev |M|) - (define-unit-prefix |giga| 9 :abbrev |G|) - (define-unit-prefix |tera| 12 :abbrev |T|) - (define-unit-prefix |peta| 15 :abbrev |P|) - (define-unit-prefix |exa| 18 :abbrev |E|) - (define-unit-prefix |zetta| 21 :abbrev |Z|) - (define-unit-prefix |yotta| 24 :abbrev |Y|) - (define-unit-prefix |kibi| 1 :abbrev |Ki| :base 1024) - (define-unit-prefix |mebi| 2 :abbrev |Mi| :base 1024) - (define-unit-prefix |gibi| 3 :abbrev |Gi| :base 1024) - (define-unit-prefix |tebi| 4 :abbrev |Ti| :base 1024) - (define-unit-prefix |pebi| 5 :abbrev |Pi| :base 1024) - (define-unit-prefix |exbi| 6 :abbrev |Ei| :base 1024) - (define-unit-prefix |zebi| 7 :abbrev |Zi| :base 1024) - (define-unit-prefix |yobi| 8 :abbrev |Yi| :base 1024) - - ;; Most units are named according to their name in CSS - (define-unit |m| :alias (|meter| |metres| |meters|) :prefix-test (pq::prefix-range 10 nil 3)) - (define-unit |s| :alias (|second| |seconds|) :prefix-test (pq::prefix-range 10 nil -3)) - (define-unit |rad| :def (1) :alias (|radian| |radians|) :prefix-test (pq::prefix-range 10 nil -3)) - (define-unit |grad| :def (400/360 |rad|) :alias (|gradian| |gradians|) :prefix-test (pq::prefix-range 10 nil -3)) - (define-unit |turn| :def ((* 2 pi) |rad|) :alias |turns| :prefix-test (constantly nil)) - (define-unit |steradian| :def (1) :abbrev |sr| :prefix-test (pq::prefix-range 10 nil -3)) - (define-unit |Hz| :def (1 / |second|) :alias |hertz| :prefix-test (pq::prefix-base 10 3)) - (define-unit |byte| :def (1) :alias |bytes| :abbrev |b| :prefix-test (pq::prefix-or (pq::prefix-base 1024) (pq::prefix-range 10 3 nil))) - (define-unit |minute| :def (60 |s|) :alias |minutes| :abbrev |min| :prefix-test (constantly nil)) - (define-unit |hour| :def (60 |minute|) :alias |hours| :abbrev |h| :prefix-test (constantly nil)) - (define-unit |day| :def (24 |hour|) :alias |days| :abbrev |d| :prefix-test (constantly nil)) - (define-unit |deg| :def ((/ pi 180) |rad|) :alias (|degrees| |degree|) :prefix-test (pq::prefix-range 10 nil -3)) - (define-unit |%| :def (0.01) :alias (|percent| |percents|) :prefix-test (constantly nil)) - (define-unit |in| :def (0.0254 |m|) :alias (|inch| |inches|) :prefix-test (constantly nil)) - (define-unit |pt| :def (1/72 |inch|) :alias (|point| |points|) :prefix-test (constantly nil)) - (define-unit |pc| :def (1/6 |inch|) :alias (|pica| |picas|) :prefix-test (constantly nil)) - (define-unit |px| :def (1/96 |inch|) :alias (|pixel| |pixels|) :prefix-test (constantly nil)) - - ;; relative units: em, ex, ch, rem, lh, vw, vh, vmin, vmax - ,@(mapcar (lambda (unit) - `(define-unit ,unit :prefix-test (constantly nil))) - '(|em| |ex| |ch| |rem| |lh| |vw| |vh| |vmin| |vmax|)) - - ,@body)) - -(defun parse-css-number (x &key unit) - "Parses CSS number wrapping it in pq:quantity if unit of measure is present" - (cond ((stringp x) - (multiple-value-bind (val idx) (parse-float x :junk-allowed t) - (when (zerop idx) - (signal 'pq:invalid-unit-error)) - (let ((q-unit (cond (unit unit) - ((>= idx (length x)) nil) - ((char-equal #\e (char x (1- idx))) (subseq x (1- idx))) - (t (subseq x idx))))) - (if q-unit - (make-quantity :value val :unit (make-unit (list q-unit 1))) - val)))) - ((symbolp x) - (parse-css-number (string x) :unit unit)) - (unit - (make-quantity :value x :unit (make-unit (list unit 1)))) - (t - x))) - -(defun reduce-percents (q) - "Collapses percents in quantity so that 100% * 100% = 100% and not 10000%^2" - (if (quantityp q) - (let ((units (unit q)) - (value (value q))) - (multiple-value-bind (percents others) - (loop for u in units - if (string= "%" (uf-unit u)) - collect u into percents - else collect u into others - finally (return (values percents others))) - (cond ((not percents) q) - ((not others) - (let ((power (- (uf-power (car percents)) 1))) - (make-quantity :value (/ value (expt 100.0 power)) - :unit (make-unit (list "%" (max 1 power)))))) - (t (make-quantity :value (/ value (expt 100.0 (uf-power (car percents)))) - :unit others))))) - q)) - -(defun resolve-css-number (x) - "Returns CSS number with unit, only power 1 units are properly supported." - (if (quantityp x) - (let* ((q (reduce-percents x)) - (value (value q)) - (units (unit q)) - (unit (when units (uf-unit (car units))))) - (values (if (string= "%" unit) (/ value 100.0) value) unit value)) - (values x nil x))) - -(defun css-number-string-format (value unit raw) - "Render a quantity with unit in CSS format" - (cond ((string= "%" unit) - (format nil "~$%" raw)) - (unit - (format nil "~$~A" value unit)) - ((integerp value) - (format nil "~A" value)) - (t - (format nil "~$" value)))) - -(defun css-number-string (q) - (multiple-value-call 'css-number-string-format (resolve-css-number q))) - -(defun wrap-funcall (fn q) - (with-css-units - (multiple-value-bind (value unit raw) (resolve-css-number q) - (declare (ignore raw)) - (let ((result (funcall fn value))) - (values result unit (if (string= "%" unit) (* 100.0 result) result)))))) - -(defun wrap-funcall-raw (fn q) - (with-css-units - (multiple-value-bind (value unit raw) (resolve-css-number q) - (declare (ignore value)) - (let ((result (funcall fn raw))) - (values (if (string= "%" unit) (/ result 100.0) result) unit result))))) - -(defun resolve-css-arg (expr) - "Utility function to get the numeric value of the value with unit of measure" - (with-css-units - (resolve-css-number - (parse-css-number - (resolve expr))))) - -;;; Convert PQ function with 'q' prefix to a LASS propery function by reading and resolving CSS values and properly -;;; formatting the result - -(defmacro define-css-op (op) - `(define-property-function ,(string op) (&rest args) - (handler-case (with-css-units - (css-number-string - (apply #',(intern (string-upcase (concatenate 'string "q" (string op)))) - (mapcar (lambda (x) (parse-css-number (resolve x))) args)))) - ;; Catch errors that originate from non-existing or non-convertable (e.g. px and em) units. - (pq:invalid-unit-error - () - (format nil ,(format nil "(~~{~~a~~^ ~a ~~})" op) (mapcar #'resolve args)))))) - -;;; Assign unit to a number -(define-property-function unit (value &optional unit) - (with-css-units - (let ((numeric-value (resolve-css-number - (parse-css-number - (resolve value))))) - (css-number-string - (make-quantity :value (if (string= "%" unit) - (* numeric-value 100) - numeric-value) - :unit (when unit (make-unit (list unit 1)))))))) - -;;; Convert value to the specified unit if compatible -(define-property-function convert-unit (value unit) - (with-css-units - (let ((numeric-value (parse-css-number - (resolve value)))) - (css-number-string - (convert-unit (if (quantityp numeric-value) - numeric-value - (make-quantity :value numeric-value)) - (list (list unit 1))))))) - -;;; Adding math functions -(define-css-op +) -(define-css-op -) -(define-css-op /) -(define-css-op *) -(define-css-op =) -(define-css-op /=) -(define-css-op >) -(define-css-op <) -(define-css-op <=) -(define-css-op >=) -(define-css-op round) -(define-css-op ln) -(define-css-op log) -(define-css-op exp) -(define-css-op expt) -(define-css-op root) -(define-css-op sqrt) -(define-css-op pow) -(define-css-op sin) -(define-css-op asin) -(define-css-op sinh) -(define-css-op asinh) -(define-css-op cos) -(define-css-op acos) -(define-css-op cosh) -(define-css-op acosh) -(define-css-op tan) -(define-css-op atan) -(define-css-op tanh) -(define-css-op atanh) -(define-css-op abs) - -(defun qclamp (min-value value max-value) - "Value clamping function" - (cond - ((q< value min-value) - min-value) - ((q> value max-value) - max-value) - (t value))) - -(define-css-op clamp) - -(defun qhypot (&rest args) - "Function returns a sum of squares of its arguments" - (reduce #'q+ args :key (lambda (x) (qpow x 2)))) - -(define-css-op hypot) - -(defun qrandom (&optional (range 1.0)) - "Generates random number, if range is specified as a quantity it's value will be used as parameter to CL:RANDOM and unit would be used for resulting quantity" - (q* (random 1.0) range)) - -(define-css-op random) - -;;; Rounds 45.5% to 46% -(define-property-function ceil (a) - (with-css-units - (multiple-value-call 'css-number-string-format - (wrap-funcall-raw #'ceiling (parse-css-number (resolve a)))))) - -(define-property-function floor (a) - (with-css-units - (multiple-value-call 'css-number-string-format - (wrap-funcall-raw #'floor (parse-css-number (resolve a)))))) - -