diff --git a/source/clog-base.lisp b/source/clog-base.lisp index c106e1a..58b0792 100644 --- a/source/clog-base.lisp +++ b/source/clog-base.lisp @@ -198,19 +198,19 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (let ((f (ppcre:split ":" data))) (list :event-type :mouse - :x (parse-integer (nth 0 f) :junk-allowed t) - :y (parse-integer (nth 1 f) :junk-allowed t) - :screen-x (parse-integer (nth 2 f) :junk-allowed t) - :screen-y (parse-integer (nth 3 f) :junk-allowed t) - :which-button (parse-integer (nth 4 f) :junk-allowed t) + :x (js-to-integer (nth 0 f)) + :y (js-to-integer (nth 1 f)) + :screen-x (js-to-integer (nth 2 f)) + :screen-y (js-to-integer (nth 3 f)) + :which-button (js-to-integer (nth 4 f)) :alt-key (js-true-p (nth 5 f)) :ctrl-key (js-true-p (nth 6 f)) :shift-key (js-true-p (nth 7 f)) :meta-key (js-true-p (nth 8 f)) - :client-x (parse-integer (nth 9 f) :junk-allowed t) - :client-Y (parse-integer (nth 10 f) :junk-allowed t) - :page-x (parse-integer (nth 11 f) :junk-allowed t) - :page-Y (parse-integer (nth 12 f) :junk-allowed t)))) + :client-x (js-to-integer (nth 9 f)) + :client-Y (js-to-integer (nth 10 f)) + :page-x (js-to-integer (nth 11 f)) + :page-Y (js-to-integer (nth 12 f))))) ;;;;;;;;;;;;;;;;;;;;;;; ;; parse-touch-event ;; @@ -236,19 +236,19 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (let ((f (ppcre:split ":" data))) (list :event-type :touch - :x (parse-integer (nth 0 f) :junk-allowed t) - :y (parse-integer (nth 1 f) :junk-allowed t) - :screen-x (parse-integer (nth 2 f) :junk-allowed t) - :screen-y (parse-integer (nth 3 f) :junk-allowed t) - :number-fingers (parse-integer (nth 4 f) :junk-allowed t) + :x (js-to-integer (nth 0 f)) + :y (js-to-integer (nth 1 f)) + :screen-x (js-to-integer (nth 2 f)) + :screen-y (js-to-integer (nth 3 f)) + :number-fingers (js-to-integer (nth 4 f)) :alt-key (js-true-p (nth 5 f)) :ctrl-key (js-true-p (nth 6 f)) :shift-key (js-true-p (nth 7 f)) :meta-key (js-true-p (nth 8 f)) - :client-x (parse-integer (nth 9 f) :junk-allowed t) - :client-Y (parse-integer (nth 10 f) :junk-allowed t) - :page-x (parse-integer (nth 11 f) :junk-allowed t) - :page-Y (parse-integer (nth 12 f) :junk-allowed t)))) + :client-x (js-to-integer (nth 9 f)) + :client-Y (js-to-integer (nth 10 f)) + :page-x (js-to-integer (nth 11 f)) + :page-Y (js-to-integer (nth 12 f))))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; parse-pointer-event ;; @@ -266,19 +266,19 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (let ((f (ppcre:split ":" data))) (list :event-type :pointer - :x (parse-integer (nth 0 f) :junk-allowed t) - :y (parse-integer (nth 1 f) :junk-allowed t) - :screen-x (parse-integer (nth 2 f) :junk-allowed t) - :screen-y (parse-integer (nth 3 f) :junk-allowed t) - :which-button (parse-integer (nth 4 f) :junk-allowed t) + :x (js-to-integer (nth 0 f)) + :y (js-to-integer (nth 1 f)) + :screen-x (js-to-integer (nth 2 f)) + :screen-y (js-to-integer (nth 3 f)) + :which-button (js-to-integer (nth 4 f)) :alt-key (js-true-p (nth 5 f)) :ctrl-key (js-true-p (nth 6 f)) :shift-key (js-true-p (nth 7 f)) :meta-key (js-true-p (nth 8 f)) - :client-x (parse-integer (nth 9 f) :junk-allowed t) - :client-Y (parse-integer (nth 10 f) :junk-allowed t) - :page-x (parse-integer (nth 11 f) :junk-allowed t) - :page-Y (parse-integer (nth 12 f) :junk-allowed t)))) + :client-x (js-to-integer (nth 9 f)) + :client-Y (js-to-integer (nth 10 f)) + :page-x (js-to-integer (nth 11 f)) + :page-Y (js-to-integer (nth 12 f))))) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; parse-keyboard-event ;; @@ -294,8 +294,8 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (let ((f (ppcre:split ":" data))) (list :event-type :keyboard - :key-code (parse-integer (nth 0 f) :junk-allowed t) - :char-code (parse-integer (nth 1 f) :junk-allowed t) + :key-code (js-to-integer (nth 0 f)) + :char-code (js-to-integer (nth 1 f)) :alt-key (js-true-p (nth 2 f)) :ctrl-key (js-true-p (nth 3 f)) :shift-key (js-true-p (nth 4 f)) @@ -319,9 +319,9 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (let ((f (ppcre:split ":" data))) (list :event-type :drop - :x (parse-integer (nth 0 f) :junk-allowed t) - :y (parse-integer (nth 1 f) :junk-allowed t) - :which-button (parse-integer (nth 2 f) :junk-allowed t) + :x (js-to-integer (nth 0 f)) + :y (js-to-integer (nth 1 f)) + :which-button (js-to-integer (nth 2 f)) :alt-key (js-true-p (nth 3 f)) :ctrl-key (js-true-p (nth 4 f)) :shift-key (js-true-p (nth 5 f)) @@ -398,7 +398,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (:documentation "Get/Setf html height in pixels.")) (defmethod height ((obj clog-obj)) - (parse-integer (jquery-query obj "height()" :default-answer 0) :junk-allowed t)) + (js-to-integer (jquery-query obj "height()"))) (defgeneric (setf height) (value clog-obj) (:documentation "Set height VALUE for CLOG-OBJ")) @@ -415,7 +415,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (:documentation "Get/Setf html width in pixels.")) (defmethod width ((obj clog-obj)) - (parse-integer (jquery-query obj "width()" :default-answer 0) :junk-allowed t)) + (js-to-integer (jquery-query obj "width()"))) (defgeneric (setf width) (value clog-obj) (:documentation "Set width VALUE for CLOG-OBJ")) diff --git a/source/clog-canvas.lisp b/source/clog-canvas.lisp index a153cec..25ae891 100644 --- a/source/clog-canvas.lisp +++ b/source/clog-canvas.lisp @@ -120,7 +120,7 @@ See https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/fi (:documentation "Setf/get global alpha")) (defmethod global-alpha ((obj clog-context2d)) - (parse-float (query obj "globalAlpha"))) + (js-to-float (query obj "globalAlpha"))) (defmethod (setf global-alpha) (value (obj clog-context2d)) (execute obj (format nil "globalAlpha=~A" value))) @@ -188,7 +188,7 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Setf/get miter style limit")) (defmethod line-dash-offset ((obj clog-context2d)) - (parse-float (query obj "lineDashOffset"))) + (js-to-float (query obj "lineDashOffset"))) (defmethod (setf line-dash-offset) (value (obj clog-context2d)) (execute obj (format nil "lineDashOffset=~A" value))) @@ -229,7 +229,7 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Setf/get miter style limit")) (defmethod miter-limit ((obj clog-context2d)) - (parse-float (query obj "miterLimit"))) + (js-to-float (query obj "miterLimit"))) (defmethod (setf miter-limit) (value (obj clog-context2d)) (execute obj (format nil "miterLimit=~A" value))) @@ -242,7 +242,7 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Setf/get text shadow blur")) (defmethod shadow-blur ((obj clog-context2d)) - (parse-float (query obj "shadowBlur"))) + (js-to-float (query obj "shadowBlur"))) (defmethod (setf shadow-blur) (value (obj clog-context2d)) (execute obj (format nil "shadowBlur=~A" value))) @@ -268,7 +268,7 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Setf/get text shadow offset x")) (defmethod shadow-offset-x ((obj clog-context2d)) - (parse-float (query obj "shadowOffsetX"))) + (js-to-float (query obj "shadowOffsetX"))) (defmethod (setf shadow-offset-x) (value (obj clog-context2d)) (execute obj (format nil "shadowOffsetX=~A" value))) @@ -281,7 +281,7 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Setf/get text shadow offset y")) (defmethod shadow-offset-y ((obj clog-context2d)) - (parse-float (query obj "shadowOffsetY=~A"))) + (js-to-float (query obj "shadowOffsetY=~A"))) (defmethod (setf shadow-offset-y) (value (obj clog-context2d)) (execute obj (format nil "shadowOffsetY=~A" value))) @@ -921,10 +921,10 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmethod width ((obj clog-image-data)) - (parse-integer (query obj "width"))) + (js-to-integer (query obj "width"))) (defmethod height ((obj clog-image-data)) - (parse-integer (query obj "height"))) + (js-to-integer (query obj "height"))) (defgeneric json-image-data (clog-image-data) (:documentation "Setf/get json image data")) @@ -948,73 +948,73 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defmethod width ((obj clog-text-metrics)) "Width of text" - (parse-float (query obj "width"))) + (js-to-float (query obj "width"))) (defgeneric actual-bounding-box-left (clog-text-metrics) (:documentation "Actual bounding box left")) (defmethod actual-bounding-box-left ((obj clog-text-metrics)) - (parse-float (query obj "actualBoundingBoxLeft"))) + (js-to-float (query obj "actualBoundingBoxLeft"))) (defgeneric actual-bounding-box-right (clog-text-metrics) (:documentation "Actual bounding box right")) (defmethod actual-bounding-box-right ((obj clog-text-metrics)) - (parse-float (query obj "actualBoundingBoxRight"))) + (js-to-float (query obj "actualBoundingBoxRight"))) (defgeneric actual-bounding-box-ascent (clog-text-metrics) (:documentation "Actual bounding box ascent")) (defmethod actual-bounding-box-ascent ((obj clog-text-metrics)) - (parse-float (query obj "actualBoundingBoxAscent"))) + (js-to-float (query obj "actualBoundingBoxAscent"))) (defgeneric actual-bounding-box-descent (clog-text-metrics) (:documentation "Actual bounding box descent")) (defmethod actual-bounding-box-descent ((obj clog-text-metrics)) - (parse-float (query obj "actualBoundingBoxDescent"))) + (js-to-float (query obj "actualBoundingBoxDescent"))) (defgeneric font-bounding-box-ascent (clog-text-metrics) (:documentation "Font bounding box ascent")) (defmethod font-bounding-box-ascent ((obj clog-text-metrics)) - (parse-float (query obj "fontBoundingBoxAscent"))) + (js-to-float (query obj "fontBoundingBoxAscent"))) (defgeneric font-bounding-box-descent (clog-text-metrics) (:documentation "Font bounding box descent")) (defmethod font-bounding-box-descent ((obj clog-text-metrics)) - (parse-float (query obj "fontBoundingBoxDescent"))) + (js-to-float (query obj "fontBoundingBoxDescent"))) (defgeneric em-height-ascent (clog-text-metrics) (:documentation "'M' height ascent")) (defmethod em-height-ascent ((obj clog-text-metrics)) - (parse-float (query obj "emHeightAscent"))) + (js-to-float (query obj "emHeightAscent"))) (defgeneric em-height-descent (clog-text-metrics) (:documentation "'M' height descent")) (defmethod em-height-descent ((obj clog-text-metrics)) - (parse-float (query obj "emHeightDescent"))) + (js-to-float (query obj "emHeightDescent"))) (defgeneric hanging-baseline (clog-text-metrics) (:documentation "Hanging baseline")) (defmethod hanging-baseline ((obj clog-text-metrics)) - (parse-float (query obj "hangingBaseline"))) + (js-to-float (query obj "hangingBaseline"))) (defgeneric alphabetic-baseline (clog-text-metrics) (:documentation "Alphabetic baseline")) (defmethod alphabetic-baseline ((obj clog-text-metrics)) - (parse-float (query obj "alphabeticBaseline"))) + (js-to-float (query obj "alphabeticBaseline"))) (defgeneric ideographic-baseline (clog-text-metrics) (:documentation "Ideographic baseline")) (defmethod ideographic-baseline ((obj clog-text-metrics)) - (parse-float (query obj "ideographicBaseline"))) + (js-to-float (query obj "ideographicBaseline"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/source/clog-element.lisp b/source/clog-element.lisp index a7f97d7..a76dcfb 100644 --- a/source/clog-element.lisp +++ b/source/clog-element.lisp @@ -78,7 +78,8 @@ CONNECTION-ID to it and then return it. The HTML-ID must be unique. (private)" (defgeneric create-element (clog-obj html-tag &rest all-args &key content clog-type html-id auto-place &allow-other-keys) - (:documentation "Create a new CLOG-element as child of CLOG-OBJ with any possible keyword.")) + (:documentation "Create a new CLOG-ELEMENT as child of CLOG-OBJ with any +possible tag and keywords.")) (defmethod create-element (clog-obj html-tag &rest all-args &key (content "") @@ -86,14 +87,19 @@ CONNECTION-ID to it and then return it. The HTML-ID must be unique. (private)" html-id (auto-place t) &allow-other-keys) - (let* ((extra-args (alexandria:remove-from-plist all-args :content :clog-type :html-id :auto-place)) + (let* ((extra-args (alexandria:remove-from-plist all-args + :content :clog-type + :html-id :auto-place)) (html (with-output-to-string (*standard-output*) (format t "<~(~a~) " html-tag) (loop for (key value) on extra-args by #'cddr do (format t "~(~a~)=~s" key value)) (format t " id=~s>~A" html-id content html-tag))) (clog-type (or clog-type - (let* ((class-name (intern (string-upcase (format nil "CLOG-~a" html-tag)) :clog))) + (let* ((class-name (intern (string-upcase + (format nil "CLOG-~a" + html-tag)) + :clog))) (when (find-class class-name nil) class-name)) 'clog-element))) @@ -599,8 +605,7 @@ Additionally works for forms and can get/setf the values.")) in pixels (css left in pixels).")) (defmethod position-left ((obj clog-element)) - (parse-integer (jquery-query obj "position().left" :default-answer 0) - :junk-allowed t)) + (js-to-integer (jquery-query obj "position().left"))) ;;;;;;;;;;;;;;;;;; ;; position-top ;; @@ -611,8 +616,7 @@ in pixels (css left in pixels).")) in pixels (css top in pixels).")) (defmethod position-top ((obj clog-element)) - (parse-integer (jquery-query obj "position().top" :default-answer 0) - :junk-allowed t)) + (js-to-integer (jquery-query obj "position().top"))) ;;;;;;;;;;;;;;;;; ;; client-left ;; @@ -623,8 +627,7 @@ in pixels (css top in pixels).")) in pixels. It does not include the margin or padding.")) (defmethod client-left ((obj clog-element)) - (parse-integer (property obj "clientLeft" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "clientLeft"))) ;;;;;;;;;;;;;;;; ;; client-top ;; @@ -635,8 +638,7 @@ in pixels. It does not include the margin or padding.")) in pixels. It does not include the margin or padding.")) (defmethod client-top ((obj clog-element)) - (parse-integer (property obj "clientTop" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "clientTop"))) ;;;;;;;;;;;;;;;;;; ;; client-width ;; @@ -648,8 +650,7 @@ CSS width + CSS padding - width of vertical scrollbar (if present) Does not include the border or margin.")) (defmethod client-width ((obj clog-element)) - (parse-integer (property obj "clientWidth" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "clientWidth"))) ;;;;;;;;;;;;;;;;;;; ;; client-height ;; @@ -661,8 +662,7 @@ CSS height + CSS padding - height of horizontal scrollbar (if present) Does not include the border or margin.")) (defmethod client-height ((obj clog-element)) - (parse-integer (property obj "clientHeight" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "clientHeight"))) ;;;;;;;;;;;;;;;;; ;; offset-left ;; @@ -673,7 +673,7 @@ Does not include the border or margin.")) child border left.")) (defmethod offset-left ((obj clog-element)) - (property obj "offsetLeft")) + (js-to-integer (property obj "offsetLeft"))) ;;;;;;;;;;;;;;;; ;; offset-top ;; @@ -684,7 +684,7 @@ child border left.")) child border top.")) (defmethod offset-top ((obj clog-element)) - (property obj "offsetTop")) + (js-to-integer (property obj "offsetTop"))) ;;;;;;;;;;;;;;;;;; ;; offset-width ;; @@ -695,7 +695,7 @@ child border top.")) vertical scrollbar (if present) + Border")) (defmethod offset-width ((obj clog-element)) - (property obj "offsetWidth")) + (js-to-integer (property obj "offsetWidth"))) ;;;;;;;;;;;;;;;;;;; ;; offset-height ;; @@ -706,7 +706,7 @@ vertical scrollbar (if present) + Border")) horizontal scrollbar (if present) + Border")) (defmethod offset-height ((obj clog-element)) - (property obj "offsetHeight")) + (js-to-integer (property obj "offsetHeight"))) ;;;;;;;;;;;;;;;;; ;; scroll-left ;; @@ -717,8 +717,7 @@ horizontal scrollbar (if present) + Border")) content is scrolled to the left. For RTL languages is negative.")) (defmethod scroll-left ((obj clog-element)) - (parse-integer (property obj "scrollLeft" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "scrollLeft"))) (defgeneric (setf scroll-left) (value clog-element) (:documentation "Set scroll-left VALUE for CLOG-ELEMENT")) @@ -735,8 +734,7 @@ content is scrolled to the left. For RTL languages is negative.")) content has been scrolled upward.")) (defmethod scroll-top ((obj clog-element)) - (parse-integer (property obj "scrollTop" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "scrollTop"))) (defgeneric (setf scroll-top) (value clog-element) (:documentation "Set scroll-top VALUE for CLOG-ELEMENT")) @@ -753,8 +751,7 @@ content has been scrolled upward.")) of an element or the width of the element itself, whichever is greater.")) (defmethod scroll-width ((obj clog-element)) - (parse-integer (property obj "scrollWidth" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "scrollWidth"))) ;;;;;;;;;;;;;;;;;;; ;; scroll-height ;; @@ -765,8 +762,7 @@ of an element or the width of the element itself, whichever is greater.")) content not visible on the screen due to overflow.")) (defmethod scroll-height ((obj clog-element)) - (parse-integer (property obj "scrollHeight" :default-answer 0) - :junk-allowed t)) + (js-to-integer (property obj "scrollHeight"))) ;;;;;;;;;;;;;; ;; html-tag ;; @@ -1382,7 +1378,7 @@ Note: z-index only works on Elements with Position Type of absolute, relative and fixed.")) (defmethod z-index ((obj clog-element)) - (parse-integer (style obj "z-index" :default-answer 0) :junk-allowed t)) + (js-to-integer (style obj "z-index"))) (defgeneric (setf z-index) (value clog-element) (:documentation "Set z-index VALUE for CLOG-ELEMENT")) @@ -1447,8 +1443,7 @@ right, top and bottom are interpreted. parent in the DOM.")) (defmethod position-top ((obj clog-element)) - (parse-integer (jquery-query obj "position().top" :default-answer 0) - :junk-allowed t)) + (js-to-integer (jquery-query obj "position().top"))) ;;;;;;;;;;;;;;;;;;; ;; position-left ;; @@ -1459,8 +1454,7 @@ parent in the DOM.")) parent in the DOM.")) (defmethod position-left ((obj clog-element)) - (parse-integer (jquery-query obj "position().left" :default-answer 0) - :junk-allowed t)) + (js-to-integer (jquery-query obj "position().left"))) ;;;;;;;;;;;;;;;; ;; offset-top ;; @@ -1470,8 +1464,7 @@ parent in the DOM.")) (:documentation "Position in pixels from top relative to the document.")) (defmethod offset-top ((obj clog-element)) - (parse-integer (jquery-query obj "offset().top" :default-answer 0) - :junk-allowed t)) + (js-to-integer (jquery-query obj "offset().top"))) ;;;;;;;;;;;;;;;;; ;; offset-left ;; @@ -1481,9 +1474,7 @@ parent in the DOM.")) (:documentation "Position in pixels from left relative to the document.")) (defmethod offset-left ((obj clog-element)) - (parse-integer (jquery-query obj "offset().left" :default-answer 0) - :junk-allowed t)) - + (js-to-integer (jquery-query obj "offset().left"))) ;;;;;;;;;;;;;;;;;; ;; set-geometry ;; @@ -1532,7 +1523,7 @@ UNITS (default :px) is used.")) ;;;;;;;;;;; (defgeneric right (clog-element) - (:documentation "Get/Setf right (defaults to us :px units).")) + (:documentation "Get/Setf right (defaults to use :px units).")) (defmethod right ((obj clog-element)) (style obj "right")) @@ -1548,7 +1539,7 @@ UNITS (default :px) is used.")) ;;;;;;;;; (defgeneric top (clog-element) - (:documentation "Get/Setf top (defaults to us :px units).")) + (:documentation "Get/Setf top (defaults to use :px units).")) (defmethod top ((obj clog-element)) (style obj "top")) @@ -1564,7 +1555,7 @@ UNITS (default :px) is used.")) ;;;;;;;;;;;; (defgeneric bottom (clog-element) - (:documentation "Get/Setf bottom (defaults to us :px units).")) + (:documentation "Get/Setf bottom (defaults to use :px units).")) (defmethod bottom ((obj clog-element)) (style obj "bottom")) @@ -1690,9 +1681,9 @@ UNITS (default :px) is used.")) ;; For reference: ;; | Margin | Border | Padding | Scroll | [Element] | Scroll | Padding ... ;; -;; Height and Width of Element are in clog-base -;; All the following have the advantage of the CSS related size properties -;; in that the results are always pixels and numeric. +;; Height and Width of Element are in clog-base +;; All the following have the advantage in that the results are always +;; pixels and numeric. ;;;;;;;;;;;;;;;;;; ;; inner-height ;; @@ -1702,7 +1693,7 @@ UNITS (default :px) is used.")) (:documentation "Get/Setf inner-height. Includes padding but not border.")) (defmethod inner-height ((obj clog-element)) - (jquery-query obj "innerHeight()")) + (js-to-intger (jquery-query obj "innerHeight()"))) (defgeneric (setf inner-height) (value clog-element) (:documentation "Set inner-height VALUE for CLOG-ELEMENT")) @@ -1719,7 +1710,7 @@ UNITS (default :px) is used.")) (:documentation "Get/Setf inner-width. Includes padding but not border.")) (defmethod inner-width ((obj clog-element)) - (jquery-query obj "innerWidth()")) + (js-to-integer (jquery-query obj "innerWidth()"))) (defgeneric (setf inner-width) (value clog-element) (:documentation "Set inner-width VALUE for CLOG-ELEMENT")) @@ -1737,7 +1728,7 @@ UNITS (default :px) is used.")) margin.")) (defmethod outer-height ((obj clog-element)) - (jquery-query obj "outerHeight()")) + (js-to-integer (jquery-query obj "outerHeight()"))) ;;;;;;;;;;;;;;;;; ;; outer-width ;; @@ -1748,7 +1739,7 @@ margin.")) but not margin.")) (defmethod outer-width ((obj clog-element)) - (jquery-query obj "outerWidth()")) + (js-to-integer (jquery-query obj "outerWidth()"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; outer-height-to-margin ;; @@ -1770,7 +1761,7 @@ margin.")) margin.")) (defmethod outer-width-to-margin ((obj clog-element)) - (jquery-query obj "outerWidth(true)")) + (js-to-integer (jquery-query obj "outerWidth(true)"))) ;;;;;;;;;;; ;; color ;; diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp index 82a4103..bc5dcb8 100644 --- a/source/clog-gui.lisp +++ b/source/clog-gui.lisp @@ -15,7 +15,7 @@ (mgl-pax:define-package :clog-gui (:documentation "CLOG-GUI a desktop GUI abstraction for CLOG") - (:use #:cl #:parse-float #:clog #:mgl-pax)) + (:use #:cl #:clog #:mgl-pax)) (cl:in-package :clog-gui) @@ -355,8 +355,8 @@ window or nil if not found")) (defun make-in-bounds (obj mbh bh bw) "Insure obj in bounds of gui (private)" - (let* ((top-loc (parse-integer (top obj) :junk-allowed t)) - (left-loc (parse-integer (left obj) :junk-allowed t)) + (let* ((top-loc (js-to-integer (top obj))) + (left-loc (js-to-integer (left obj))) (width-loc (width obj))) (if (< (+ left-loc width-loc) 25) (setf (left obj) (unit :px (- 25 width-loc)))) @@ -730,9 +730,9 @@ The on-window-change clog-obj received is the new window")) (setf (drag-obj app) target) (cond ((equalp (in-drag app) "m") (setf obj-top - (parse-integer (top (drag-obj app)) :junk-allowed t)) + (js-to-integer (top (drag-obj app)))) (setf obj-left - (parse-integer (left (drag-obj app)) :junk-allowed t)) + (js-to-integer (left (drag-obj app)))) (setf perform-drag (fire-on-window-can-move (drag-obj app)))) ((equalp (in-drag app) "s") (setf obj-top (height (drag-obj app))) diff --git a/source/clog-multimedia.lisp b/source/clog-multimedia.lisp index 4baefa9..56d3b21 100644 --- a/source/clog-multimedia.lisp +++ b/source/clog-multimedia.lisp @@ -43,7 +43,7 @@ (:documentation "Get/Setf media in seconds property.")) (defmethod media-duration ((obj clog-multimedia)) - (parse-float (property obj "duration" :default-answer 0) :type 'double-float :junk-allowed t)) + (js-to-float (property obj "duration"))) ;;;;;;;;;;;;;;;;;; ;; media-source ;; @@ -69,7 +69,7 @@ (:documentation "Get/Setf postion of media in seconds.")) (defmethod media-position ((obj clog-multimedia)) - (parse-float (property obj "currentTime" :default-answer 0) :type 'double-float :junk-allowed t)) + (js-to-float (property obj "currentTime"))) (defgeneric (setf media-position) (value clog-multimedia) (:documentation "Set media source VALUE for CLOG-MULTIMEDIA")) @@ -160,7 +160,7 @@ duration.")) (:documentation "Get/Setf media volume, not system volume. 0.0 .. 1.0")) (defmethod media-volume ((obj clog-multimedia)) - (parse-float (property obj "volume" :default-answer 0) :type 'double-float :junk-allowed t)) + (js-to-float (property obj "volume"))) (defgeneric (setf media-volume) (value clog-multimedia) (:documentation "Set media source VALUE for CLOG-MULTIMEDIA")) diff --git a/source/clog-utilities.lisp b/source/clog-utilities.lisp index 572f23a..6bb3496 100644 --- a/source/clog-utilities.lisp +++ b/source/clog-utilities.lisp @@ -135,6 +135,38 @@ CLOG-OBJ unless :NAME is set and is used instead.")) "on" "off")) +;;;;;;;;;;;;;;;;;;; +;; js-to-integer ;; +;;;;;;;;;;;;;;;;;;; + +(defun js-to-integer (value &key (default 0)) + "Returns two values first as an integer and second the original value" + (cond ((typep value 'integer) + (values value value)) + ((typep value 'string) + (let ((r (parse-integer value :junk-allowed t))) + (if r + (values r value) + (values default value)))) + (t + (values default value)))) + +;;;;;;;;;;;;;;;;; +;; js-to-float ;; +;;;;;;;;;;;;;;;;; + +(defun js-to-float (value &key (default 0.0d0)) + "Returns two values first as a float and second the original value" + (cond ((typep value 'float) + (values value value)) + ((typep value 'string) + (let ((r (parse-float value :type 'double-float :junk-allowed t))) + (if r + (values r value) + (values default value)))) + (t + (values default value)))) + ;;;;;;;;;;;;;;;;;;; ;; escape-string ;; ;;;;;;;;;;;;;;;;;;; diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index c91a3f2..0226454 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -10,7 +10,7 @@ (mgl-pax:define-package :clog-web-dbi (:documentation "CLOG-WEB-DBI - dbi based website helpers") - (:use #:cl #:parse-float #:clog #:clog-web #:clog-auth #:mgl-pax)) + (:use #:cl #:clog #:clog-web #:clog-auth #:mgl-pax)) (cl:in-package :clog-web-dbi) diff --git a/source/clog-web.lisp b/source/clog-web.lisp index 8cefd4c..88019a5 100644 --- a/source/clog-web.lisp +++ b/source/clog-web.lisp @@ -17,7 +17,7 @@ (mgl-pax:define-package :clog-web (:documentation "CLOG-WEB a web page style abstraction for CLOG") - (:use #:cl #:parse-float #:clog #:mgl-pax)) + (:use #:cl #:clog #:mgl-pax)) (cl:in-package :clog-web) diff --git a/source/clog-webgl.lisp b/source/clog-webgl.lisp index 300adbc..8c7942e 100644 --- a/source/clog-webgl.lisp +++ b/source/clog-webgl.lisp @@ -8,7 +8,7 @@ (mgl-pax:define-package :clog-webgl (:documentation "CLOG-WEBGL bindings to WebGL") - (:use #:cl #:parse-float #:clog #:mgl-pax)) + (:use #:cl #:clog #:mgl-pax)) (cl:in-package :clog-webgl) @@ -192,13 +192,13 @@ can be webgl (version 1) or webgl2 (default)")) (:documentation "Drawing are of buffer width. returns float")) (defmethod drawing-buffer-width ((obj clog-webgl)) - (parse-float (query obj "drawingBufferWidth"))) + (js-to-float (query obj "drawingBufferWidth"))) (defgeneric drawing-buffer-height (clog-webgl) (:documentation "Drawing are of buffer height. returns float")) (defmethod drawing-buffer-height ((obj clog-webgl)) - (parse-float (query obj "drawingBufferHeight"))) + (js-to-float (query obj "drawingBufferHeight"))) (defgeneric buffer-parameter (clog-webgl glenum-target glenum-pname) (:documentation "Returns information about the buffer. @@ -262,7 +262,7 @@ When using a WebGL 2 context, the following values are available additionally: (query obj "getContextAttributes()")) (defmethod webgl-error ((obj clog-webgl)) - (parse-integer (query obj "getError()"))) + (js-to-integer (query obj "getError()"))) ;; WebGLRenderingContext.getExtension() @@ -430,7 +430,7 @@ Equivalent to :FRAMEBUFFER. Used as a destination for drawing, rendering, cleari Used as a source for reading operations.")) (defmethod check-frame-buffer-status ((obj clog-webgl) target) - (parse-integer (query obj (format nil "checkFrameBufferStatus(~A.~A)" + (js-to-integer (query obj (format nil "checkFrameBufferStatus(~A.~A)" (script-id obj) target)) :junk-allowed t)) diff --git a/source/clog-window.lisp b/source/clog-window.lisp index 203c361..f0d541d 100644 --- a/source/clog-window.lisp +++ b/source/clog-window.lisp @@ -75,7 +75,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf inner height of browser window.")) (defmethod inner-height ((obj clog-window)) - (parse-integer (query obj "innerHeight" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "innerHeight"))) (defgeneric (setf inner-height) (value clog-window)) @@ -91,7 +91,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf inner width of browser window.")) (defmethod inner-width ((obj clog-window)) - (parse-integer (query obj "innerWidth" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "innerWidth"))) (defgeneric (setf inner-width) (value clog-window)) @@ -107,7 +107,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf outer height of browser window.")) (defmethod outer-height ((obj clog-window)) - (parse-integer (query obj "outerHeight" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "outerHeight"))) (defgeneric (setf outer-height) (value clog-window)) @@ -123,7 +123,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf outer width of browser window.")) (defmethod outer-width ((obj clog-window)) - (parse-integer (query obj "outerWidth" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "outerWidth"))) (defgeneric (setf outer-width) (value clog-window)) @@ -139,7 +139,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf browser window x offset from left edge.")) (defmethod x-offset ((obj clog-window)) - (parse-integer (query obj "pageXOffset" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "pageXOffset"))) (defgeneric (setf x-offset) (value clog-window)) @@ -155,7 +155,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf browser window y offset from top edge.")) (defmethod y-offset ((obj clog-window)) - (parse-integer (query obj "pageYOffset" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "pageYOffset"))) (defgeneric (setf y-offset) (value clog-window)) @@ -171,7 +171,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf browser y postion.")) (defmethod top ((obj clog-window)) - (parse-integer (query obj "screenY" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screenY"))) (defgeneric (setf top) (value clog-window)) @@ -187,7 +187,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get/Setf browser x position.")) (defmethod left ((obj clog-window)) - (parse-integer (query obj "screenX" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screenX"))) (defgeneric (setf left) (value clog-window)) @@ -213,7 +213,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get screen width.")) (defmethod screen-width ((obj clog-window)) - (parse-integer (query obj "screen.width" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.width"))) ;;;;;;;;;;;;;;;;;;; ;; screen-height ;; @@ -223,7 +223,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get screen height.")) (defmethod screen-height ((obj clog-window)) - (parse-integer (query obj "screen.height" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.height"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; screen-available-width ;; @@ -233,7 +233,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get available screen width.")) (defmethod screen-available-width ((obj clog-window)) - (parse-integer (query obj "screen.availWidth" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.availWidth"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; screen-available-height ;; @@ -243,7 +243,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get available screen height.")) (defmethod screen-available-height ((obj clog-window)) - (parse-integer (query obj "screen.availHeight" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.availHeight"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; screen-available-left ;; @@ -253,7 +253,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get available screen left.")) (defmethod screen-available-left ((obj clog-window)) - (parse-integer (query obj "screen.availLeft" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.availLeft"))) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; screen-available-top ;; @@ -263,7 +263,7 @@ no redirection of browser takes place. REWRITE-URL must be same domain.")) (:documentation "Get available screen top.")) (defmethod screen-available-top ((obj clog-window)) - (parse-integer (query obj "screen.availTop" :default-answer 0) :junk-allowed t)) + (js-to-integer (query obj "screen.availTop"))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; screen-color-depth ;; @@ -557,7 +557,7 @@ on-storage event is fired for changes to :local storage keys.")) (local = persistant or session)")) (defmethod storage-length ((obj clog-window) storage-type) - (parse-integer (query obj (format nil "~(~a~)Storage.length" storage-type) :default-answer 0))) + (js-to-integer (query obj (format nil "~(~a~)Storage.length" storage-type)))) ;;;;;;;;;;;;;;;;; ;; storage-key ;;