From 42a5efd09dcf4595b9548a8239c0b8520da005f9 Mon Sep 17 00:00:00 2001 From: David Botton Date: Mon, 22 Aug 2022 00:40:39 -0400 Subject: [PATCH] transfer image data --- source/clog-canvas.lisp | 323 ++++++++++++++++++++++++++++++++++---- source/clog.lisp | 22 ++- tutorial/10-tutorial.lisp | 12 +- 3 files changed, 322 insertions(+), 35 deletions(-) diff --git a/source/clog-canvas.lisp b/source/clog-canvas.lisp index aa0cc89..113b421 100644 --- a/source/clog-canvas.lisp +++ b/source/clog-canvas.lisp @@ -406,16 +406,20 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global ;; path-clip ;; ;;;;;;;;;;;;;;; -(defgeneric path-clip (clog-context2d) +(defgeneric path-clip (clog-context2d &key path2d fill-rule) (:documentation "Clip a path.")) -(defmethod path-clip ((obj clog-context2d)) - (execute obj "clip()")) - -;; to add -;; clip(path) -;; clip(fillRule) -;; clip(path, fillRule) +(defmethod path-clip ((obj clog-context2d) &key path2d fill-rule) + (execute obj (format nil "clip(~A~A~A)" + (if path2d + (script-id path2d) + "") + (if (and path2d fill-rule) + "," + "") + (if fill-rule + (format nil "'~A'" fill-rule) + "")))) ;;;;;;;;;;;;;;;; ;; close-path ;; @@ -428,25 +432,59 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (execute obj "closePath()")) +;;;;;;;;;;;;;;;;;;;;;;; +;; create-image-data ;; +;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric create-image-data (clog-context2d width height) + (:documentation "Create black image data")) + +(defmethod create-image-data ((obj clog-context2d) width height) + (let ((web-id (clog-connection:generate-id))) + (js-execute obj (format nil "clog['~A']=~A.createImageData(~A,~A)" + web-id (script-id obj) + width height)) + (make-instance 'clog-image-data + :connection-id (clog::connection-id obj) + :html-id web-id))) + ;; createConicGradient -;; createImageData ;; need to add createLinearGradient ;; need to add createRadialGradient ;; need to add createPattern + ;; drawFocusIfNeeded ;;;;;;;;;;;;;;;; ;; draw-image ;; ;;;;;;;;;;;;;;;; -(defgeneric draw-image (clog-context2d clog-obj x y) - (:documentation "Draw image at x y")) +(defgeneric draw-image (clog-context2d clog-obj dx dy &key dwidth dheight) + (:documentation "Draw image at dx dy optionally dwidth and dheight")) -(defmethod draw-image ((obj clog-context2d) clog-obj x y) - (execute obj (format nil "drawImage(~A,~A,~A)" - (script-id clog-obj) x y))) +(defmethod draw-image ((obj clog-context2d) clog-obj dx dy &key dwidth dheight) + (execute obj (format nil "drawImage(~A,~A,~A~A)" + (script-id clog-obj) dx dy + (if dwidth + (format nil "~A,~A" dwidth dheight) + "")))) -;; need other versions of draw-image +;;;;;;;;;;;;;;;;;;;;;;;; +;; draw-image-from-to ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric draw-image-from-to (clog-context2d clog-obj + sx sy swidth sheight + dx dy dwidth dheight) + (:documentation "Draw image at sx sy swidth sheight to dx dy dwidth dheight")) + +(defmethod draw-image-from-to ((obj clog-context2d) clog-obj + sx sy swidth sheight + dx dy dwidth dheight) + (execute obj (format nil "drawImage(~A,~A,~A,~A,~A,~A,~A,~A,~A)" + (script-id clog-obj) + sx sy swidth sheight + dx dy dwidth dheight))) ;;;;;;;;;;;;; ;; ellipse ;; @@ -470,12 +508,20 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global ;; path-fill ;; ;;;;;;;;;;;;;;; -(defgeneric path-fill (clog-context2d) +(defgeneric path-fill (clog-context2d &key path2d fill-rule) (:documentation "Fill a path.")) -(defmethod path-fill ((obj clog-context2d)) - (execute obj "fill()")) - +(defmethod path-fill ((obj clog-context2d) &key path2d fill-rule) + (execute obj (format nil "fill(~A~A~A)" + (if path2d + (script-id path2d) + "") + (if (and path2d fill-rule) + "," + "") + (if fill-rule + (format nil "'~A'" fill-rule) + "")))) ;;;;;;;;;;;;;;; ;; fill-rect ;; @@ -503,7 +549,21 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (format nil ",~A" max-width) "")))) -;; getImageData() +;;;;;;;;;;;;;;;;;;;; +;; get-image-data ;; +;;;;;;;;;;;;;;;;;;;; + +(defgeneric get-image-data (clog-context2d sx sy sw sh) + (:documentation "Get image data from clog-context2d. Returns a CLOG-IMAGE-DATA")) + +(defmethod get-image-data ((obj clog-context2d) sx sy sw sh) + (let ((web-id (clog-connection:generate-id))) + (js-execute obj (format nil "clog['~A']=~A.getImageData(~A,~A,~A,~A)" + web-id (script-id obj) + sx sy sw sh)) + (make-instance 'clog-image-data + :connection-id (clog::connection-id obj) + :html-id web-id))) ;;;;;;;;;;;;;;;;;;; ;; get-line-dash ;; @@ -513,11 +573,40 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (:documentation "Set line style dash pattern, e.g. 10, 20")) (defmethod get-line-dash ((obj clog-context2d)) - (query obj (format nil "getLineDash()"))) + (query obj "getLineDash()")) ;; getTransform -;; isPointinPath -;; isPointinStroke + +;;;;;;;;;;;;;;;;;;;;;; +;; is-point-in;path ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric is-point-in-path (clog-context2d x y &key path2d fill-rule) + (:documentation "Returns t if point is in path or PATH2D if specfified")) + +(defmethod is-point-in-path ((obj clog-context2d) x y &key path2d fill-rule) + (js-true-p (query obj (format nil "isPointInPath(~A~A,~A~A)" + (if path2d + (format nil "~A," (script-id path2d)) + "") + x y + (if fill-rule + (format nil ",'~A'" fill-rule) + ""))))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; is-point-in-stroke ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric is-point-in-stroke (clog-context2d x y &key path2d) + (:documentation "Returns t if point is in stroke or PATH2D if specfified")) + +(defmethod is-point-in-stroke ((obj clog-context2d) x y &key path2d) + (js-true-p (query obj (format nil "isPointInStroke(~A~A,~A)" + (if path2d + (format nil "~A," (script-id path2d)) + "") + x y)))) ;;;;;;;;;;;;; ;; line-to ;; @@ -555,7 +644,28 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defmethod move-to ((obj clog-context2d) x y) (execute obj (format nil "moveTo(~A,~A)" x y))) -;; putImageData +;;;;;;;;;;;;;;;;;;;; +;; put-image-data ;; +;;;;;;;;;;;;;;;;;;;; + +(defgeneric put-image-data (clog-context2d image-data x y) + (:documentation "Put image-data at x y")) + +(defmethod put-image-data ((obj clog-context2d) image-data x y) + (execute obj (format nil "putImageData(~A,~A,~A)" (script-id image-data) x y))) + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;; put-image-data-dirty ;; +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric put-image-data-dirty (clog-context2d image-data x y + dx dy dwidth dheight) + (:documentation "Put portion of image-data at x y")) + +(defmethod put-image-data-dirty ((obj clog-context2d) image-data x y + dx dy dwidth dheight) + (execute obj (format nil "putImageData(~A,~A,~A,~A,~A,~A,~A)" (script-id image-data) x y + dx dy dwidth dheight))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; quadratic-curve-to ;; @@ -577,7 +687,15 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defmethod rect ((obj clog-context2d) x y width height) (execute obj (format nil "rect(~A,~A,~A,~A)" x y width height))) -;; resetTransform +;;;;;;;;;;;;;;;;;;;;; +;; reset-transform ;; +;;;;;;;;;;;;;;;;;;;;; + +(defgeneric reset-transform (clog-context2d) + (:documentation "Restore canvas from stack")) + +(defmethod reset-transform ((obj clog-context2d)) + (execute obj "resetTransform()")) ;;;;;;;;;;;;;;;;;;;; ;; canvas-restore ;; @@ -635,11 +753,14 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global ;; path-stroke ;; ;;;;;;;;;;;;;;;;; -(defgeneric path-stroke (clog-context2d) +(defgeneric path-stroke (clog-context2d &key path2d) (:documentation "Stroke a path.")) -(defmethod path-stroke ((obj clog-context2d)) - (execute obj "stroke()")) +(defmethod path-stroke ((obj clog-context2d) &key path2d) + (execute obj (format nil "stroke(~A)" + (if path2d + (script-id path2d) + "")))) ;;;;;;;;;;;;;;;;; ;; stroke-rect ;; @@ -686,6 +807,32 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defmethod translate ((obj clog-context2d) x y) (execute obj (format nil "translate(~A,~A)" x y))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-image-data +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-image-data (clog-obj)()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Properties - clog-image-data +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmethod width ((obj clog-image-data)) + (parse-integer (query obj "width"))) + +(defmethod height ((obj clog-image-data)) + (parse-integer (query obj "height"))) + +(defgeneric json-image-data (clog-image-data) + (:documentation "Setf/get json image data")) + +(defmethod json-image-data ((obj clog-image-data)) + (js-query obj (format nil "JSON.stringify(~A.data)" (script-id obj)))) + +(defmethod (setf json-image-data) (value (obj clog-image-data)) + (js-execute obj (format nil "~A=new ImageData(new Uint8ClampedArray(Object.values(~A)), ~A.width)" + (script-id obj) value (script-id obj)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-text-metrics ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -750,13 +897,13 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defgeneric hanging-baseline (clog-text-metrics) (:documentation "Hanging baseline")) - + (defmethod hanging-baseline ((obj clog-text-metrics)) (parse-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"))) @@ -765,3 +912,119 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global (defmethod ideographic-baseline ((obj clog-text-metrics)) (parse-float (query obj "ideographicBaseline"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implementation - clog-path2d +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass clog-path2d (clog-obj)()) + +;;;;;;;;;;;;;;;;;;;;;; +;; create-path2d ;; +;;;;;;;;;;;;;;;;;;;;;; + +(defgeneric create-path2d (clog-canvas &key path2d) + (:documentation "Create a new CLOG-Path2d. If CLOG-PATH2D creates a copy.")) + + +(defmethod create-path2d ((obj clog-canvas) &key path2d) + (let ((web-id (clog-connection:generate-id))) + (js-execute obj (format nil "clog['~A']=Path2D(~A)" + web-id + (if path2d + (if (typep path2d 'clog-path2d) + (script-id path2d) + path2d) + ""))) + (make-instance 'clog-path2d + :connection-id (connection-id obj) + :html-id web-id))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Properties - clog-text-metrics +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;; +;; add-path ;; +;;;;;;;;;;;;;; + +(defgeneric add-path (clog-path2d path2d) + (:documentation "Add Path to this Path")) + +(defmethod add-path ((obj clog-path2d) path2d) + (execute obj (format nil "addPath(~A)" (script-id path2d)))) + +;;;;;;;;;;;;;;;; +;; close-path ;; +;;;;;;;;;;;;;;;; + +(defmethod close-path ((obj clog-path2d)) + (execute obj "closePath()")) + +;;;;;;;;;;;;; +;; move-to ;; +;;;;;;;;;;;;; + +(defmethod move-to ((obj clog-path2d) x y) + (execute obj (format nil "moveTo(~A,~A)" x y))) + +;;;;;;;;;;;;; +;; line-to ;; +;;;;;;;;;;;;; + +(defmethod line-to ((obj clog-path2d) x y) + (execute obj (format nil "lineTo(~A,~A)" x y))) + +;;;;;;;;;;;;;;;;;;;;; +;; bezier-curve-to ;; +;;;;;;;;;;;;;;;;;;;;; + +(defmethod bezier-curve-to ((obj clog-path2d) cp1x cp1y cp2x cp2y x y) + (execute obj (format nil "bezierCurveTo(~A,~A,~A,~A,~A,~A)" + cp1x cp1y cp2x cp2y x y))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; quadratic-curve-to ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defmethod quadratic-curve-to ((obj clog-path2d) cpx cpy x y) + (execute obj (format nil "quadraticCurveTo(~A,~A,~A,~A)" cpx cpy x y))) + +;;;;;;;;; +;; arc ;; +;;;;;;;;; + +(defmethod arc ((obj clog-path2d) x y radius start-angle end-angle + &key (anticlockwise nil)) + (execute obj (format nil "arc(~A,~A,~A,~A,~A~A)" + x y radius start-angle end-angle + (if anticlockwise + (format nil ",~A" anticlockwise) + "")))) + +;;;;;;;;;;;; +;; arc-to ;; +;;;;;;;;;;;; + +(defmethod arc-to ((obj clog-path2d) x1 y1 x2 y2) + (execute obj (format nil "arcTo(~A,~A,~A,~A)" x1 y1 x2 y2))) + + +;;;;;;;;;;;;; +;; ellipse ;; +;;;;;;;;;;;;; + +(defmethod ellipse ((obj clog-path2d) x y radius-x radius-y rotation + start-angle end-angle + &key (anticlockwise nil)) + (execute obj (format nil "ellipse(~A,~A,~A,~A,~A,~A,~A~A)" + x y radius-x radius-y rotation start-angle end-angle + (if anticlockwise + (format nil ",~A" anticlockwise) + "")))) +;;;;;;;;;; +;; rect ;; +;;;;;;;;;; + +(defmethod rect ((obj clog-path2d) x y width height) + (execute obj (format nil "rect(~A,~A,~A,~A)" x y width height))) diff --git a/source/clog.lisp b/source/clog.lisp index ab3555c..c34e68c 100644 --- a/source/clog.lisp +++ b/source/clog.lisp @@ -757,7 +757,7 @@ embedded in a native template application.)" (text-baseline-type type) (text-baseline generic-function) (text-dir generic-function) - + "CLOG-Canvas - Methods" (arc generic-function) (arc-to generic-function) @@ -766,17 +766,25 @@ embedded in a native template application.)" (clear-rect generic-function) (path-clip generic-function) (close-path generic-function) + (create-image-data generic-function) (draw-image generic-function) + (draw-image-from-to generic-function) (ellipse generic-function) - (path-fill generic-function) + (path-fill generic-function) (fill-rect generic-function) (fill-text generic-function) + (get-image-data generic-function) (get-line-dash generic-function) + (is-point-in-path generic-function) + (is-point-in-stroke generic-function) (line-to generic-function) (measure-text generic-function) (move-to generic-function) + (put-image-data generic-function) + (put-image-dirty generic-function) (quadratic-curve-to generic-function) (rect generic-function) + (reset-transform generic-function) (canvas-restore generic-function) (rotate generic-function) (canvas-save generic-function) @@ -788,9 +796,17 @@ embedded in a native template application.)" (transform generic-function) (translate generic-function) + "CLOG-Image-Data" + (clog-image-data class) + (json-image-data generic-function) + + "CLOG-Path2d" + (clog-path2d class) + (create-path2d generic-function) + "CLOG-Text-Metrics" (clog-text-metrics class) - + (actual-bounding-box-left generic-function) (actual-bounding-box-right generic-function) (actual-bounding-box-ascent generic-function) diff --git a/tutorial/10-tutorial.lisp b/tutorial/10-tutorial.lisp index ae2e281..9bd7136 100644 --- a/tutorial/10-tutorial.lisp +++ b/tutorial/10-tutorial.lisp @@ -6,9 +6,11 @@ ;;; A very brief example of using the canvas control. (defun on-new-window (body) + (debug-mode body) (setf (title (html-document body)) "Tutorial 10") (let* ((canvas (create-canvas body :width 600 :height 400)) - (cx (create-context2d canvas))) + (cx (create-context2d canvas)) + dat) (set-border canvas :thin :solid :black) (setf (fill-style cx) :green) (fill-rect cx 10 10 150 100) @@ -19,7 +21,13 @@ (begin-path cx) (ellipse cx 200 200 50 7 0.78 0 6.29) (path-stroke cx) - (path-fill cx))) + (path-fill cx) + (setf dat (get-image-data cx 100 100 10 10)) + (put-image-data cx dat 10 200) + (let ((data (json-image-data dat))) + (setf data (ppcre:regex-replace-all ":0" data ":255")) + (setf (json-image-data dat) data)) + (put-image-data cx dat 30 200))) (defun start-tutorial () "Start turtorial."