transfer image data

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))
+(defmethod path-clip ((obj clog-context2d) &key path2d fill-rule)
-  (execute obj "clip()"))
+  (execute obj (format nil "clip(~A~A~A)"
-
+                       (if path2d
-;; to add
+                           (script-id path2d)
-;; clip(path)
+                           "")
-;; clip(fillRule)
+                       (if (and path2d fill-rule)
-;; clip(path, fillRule)
+                           ","
+                           "")
+                       (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)
+(defgeneric draw-image (clog-context2d clog-obj dx dy &key dwidth dheight)
-  (:documentation "Draw image at x y"))
+  (:documentation "Draw image at dx dy optionally dwidth and dheight"))
 
-(defmethod draw-image ((obj clog-context2d) 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)"
+  (execute obj (format nil "drawImage(~A,~A,~A~A)"
-                       (script-id clog-obj) x y)))
+                       (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))
+(defmethod path-fill ((obj clog-context2d) &key path2d fill-rule)
-  (execute obj "fill()"))
+  (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))
+(defmethod path-stroke ((obj clog-context2d) &key path2d)
-  (execute obj "stroke()"))
+  (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)))

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)

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."