From 80904d7d198f4f4e1348f999c08893843e1df5e9 Mon Sep 17 00:00:00 2001 From: David Botton Date: Mon, 22 Aug 2022 01:23:50 -0400 Subject: [PATCH] gradients --- source/clog-canvas.lisp | 87 +++++++++++++++++++++++++++++++++++---- source/clog.lisp | 8 ++++ tutorial/10-tutorial.lisp | 7 +++- 3 files changed, 92 insertions(+), 10 deletions(-) diff --git a/source/clog-canvas.lisp b/source/clog-canvas.lisp index 113b421..d665e7c 100644 --- a/source/clog-canvas.lisp +++ b/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.")) diff --git a/source/clog.lisp b/source/clog.lisp index c34e68c..7dfeda5 100644 --- a/source/clog.lisp +++ b/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) diff --git a/tutorial/10-tutorial.lisp b/tutorial/10-tutorial.lisp index 9bd7136..36217d6 100644 --- a/tutorial/10-tutorial.lisp +++ b/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)