mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

gradients

Browse source
This commit is contained in:
David Botton 2022-08-22 01:23:50 -04:00
parent 42a5efd09d
commit 80904d7d19
3 changed files with 92 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

87
source/clog-canvas.lisp
View file

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

8
source/clog.lisp
View file

@ -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)

7
tutorial/10-tutorial.lisp
View file

@ -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)