gradients

Author: rabbibotton

source/clog-canvas.lisp

@@ -79,7 +79,10 @@
   (query obj "fillStyle"))
 
 (defmethod (setf fill-style) (value (obj clog-context2d))
-  (execute obj (format nil "fillStyle='~A'" value)))
+  (execute obj (format nil "fillStyle=~A"
+                       (if (typep value 'clog-obj)
+                           (script-id value)
+                           (format nil "'~A'" value)))))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; canvas-filter ;;
@@ -448,12 +451,64 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global
                    :connection-id (clog::connection-id obj)
                    :html-id web-id)))
 
-;; createConicGradient
-;; need to add createLinearGradient
-;; need to add createRadialGradient
-;; need to add createPattern
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; create-conic-gradient ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; drawFocusIfNeeded
+(defgeneric create-conic-gradient (clog-context2d start-angle x y)
+  (:documentation "Create conic gradient"))
+
+(defmethod create-conic-gradient ((obj clog-context2d) start-angle x y)
+  (let ((web-id (clog-connection:generate-id)))
+    (js-execute obj (format nil "clog['~A']=~A.createConicGradient(~A,~A,~A)"
+                            web-id (script-id obj)
+                            start-angle x y))
+    (make-instance 'clog-canvas-gradient
+                   :connection-id (clog::connection-id obj)
+                   :html-id web-id)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; create-linear-gradient ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric create-linear-gradient (clog-context2d x0 y0 x1 y1)
+  (:documentation "Create linear gradient"))
+
+(defmethod create-linear-gradient ((obj clog-context2d) x0 y0 x1 y1)
+  (let ((web-id (clog-connection:generate-id)))
+    (js-execute obj (format nil "clog['~A']=~A.createLinearGradient(~A,~A,~A,~A)"
+                            web-id (script-id obj)
+                             x0 y0 x1 y1))
+    (make-instance 'clog-canvas-gradient
+                   :connection-id (clog::connection-id obj)
+                   :html-id web-id)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; create-radial-gradient ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric create-radial-gradient (clog-context2d x0 y0 r0 x1 y1 r1)
+  (:documentation "Create radial gradient"))
+
+(defmethod create-radial-gradient ((obj clog-context2d) x0 y0 r0 x1 y1 r1)
+  (let ((web-id (clog-connection:generate-id)))
+    (js-execute obj (format nil "clog['~A']=~A.createRadialGradient(~A,~A,~A,~A,~A,~A)"
+                            web-id (script-id obj)
+                            x0 y0 r0 x1 y1 r1))
+    (make-instance 'clog-canvas-gradient
+                   :connection-id (clog::connection-id obj)
+                   :html-id web-id)))
+
+;;;;;;;;;;;;;;;;;;;;
+;; create-pattern ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric create-pattern (clog-context2d clog-obj repetition)
+  (:Documentation "Create pattern"))
+
+(defmethod create-pattern ((obj clog-context2d) clog-obj repetition)
+  (execute obj (format nil "createPattern(~A,'~A')"
+                       (script-id clog-obj) repetition)))
 
 ;;;;;;;;;;;;;;;;
 ;; draw-image ;;
@@ -807,6 +862,22 @@ 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-canvas-gradient
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass clog-canvas-gradient (clog-obj)())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Methods - clog-canvas-gradient
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric add-color-stop (clog-canvas-gradient offset color)
+  (:documentation "Add a color stop"))
+
+(defmethod add-color-stop ((obj clog-canvas-gradient) offset color)
+  (execute obj (format nil "addColorStop(~A,'~A')" offset color)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation - clog-image-data
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -919,9 +990,9 @@ https://developer.mozilla.org/en-US/docs/Web/API/CanvasRenderingContext2D/global
 
 (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."))

source/clog.lisp

@@ -767,6 +767,10 @@ embedded in a native template application.)"
   (path-clip                  generic-function)
   (close-path                 generic-function)
   (create-image-data          generic-function)
+  (create-conic-gradient      generic-function)
+  (create-linear-gradient     generic-function)
+  (create-radial-gradient     generic-function)
+  (create-pattern             generic-function)  
   (draw-image                 generic-function)
   (draw-image-from-to         generic-function)
   (ellipse                    generic-function)
@@ -796,6 +800,10 @@ embedded in a native template application.)"
   (transform                  generic-function)
   (translate                  generic-function)
 
+  "CLOG-Canvas-Gradient"
+  (clog-canvas-gradien class)
+  (add-color-stop      generic-function)
+
   "CLOG-Image-Data"
   (clog-image-data class)
   (json-image-data generic-function)

tutorial/10-tutorial.lisp

@@ -6,7 +6,6 @@
 
 ;;; 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))
@@ -17,8 +16,12 @@
     (setf (fill-style cx) :blue
           (font-style cx) "bold 24px serif")
     (fill-text cx "Hello World" 10 150)
-    (setf (fill-style cx) :red)
     (begin-path cx)
+    (let ((gr (create-linear-gradient cx 20 0 220 0)))
+      (add-color-stop gr 0 :red)
+      (add-color-stop gr .5 :cyan)
+      (add-color-stop gr 1 :yellow)
+      (setf (fill-style cx) gr))
     (ellipse cx 200 200 50 7 0.78 0 6.29)
     (path-stroke cx)
     (path-fill cx)