branch: externals/sketch-mode
commit d5bb2b7b87ca2da5c74458e0b307d17efa7a7df9
Author: Daniel Nicolai <dalanico...@gmail.com>
Commit: Daniel Nicolai <dalanico...@gmail.com>
Implement freehand drawing
---
sketch-mode.el | 29 +++++++++++++++++++++++++----
1 file changed, 25 insertions(+), 4 deletions(-)
diff --git a/sketch-mode.el b/sketch-mode.el
index 04885d1..7e4b3e2 100644
--- a/sketch-mode.el
+++ b/sketch-mode.el
@@ -767,6 +767,7 @@ else return nil"
("ellipse" "e")
("polyline" "p")
("polygon" "g")
+ ("freehand" "f")
("text" "t")
("group" "g"))))
(idx 0)
@@ -952,9 +953,9 @@ else return nil"
(car start-coords) (cdr
start-coords)
(sketch--circle-radius
start-coords start-coords)))
("ellipse" `(svg-ellipse
,@(sketch--ellipse-coords start-coords start-coords)))
- (var (list (if (string= var "polyline")
- 'svg-polyline
- 'svg-polygon)
+ (var (list (pcase var
+ ((or "polyline" "freehand")
'svg-polyline)
+ ("polygon" 'svg-polygon))
points))))
(label (sketch-create-label object-type)))
(apply (car start-command-and-coords)
@@ -1012,7 +1013,27 @@ else return nil"
(if (eq (car event)
'down-mouse-1)
(push
end-coords points)
(cons end-coords
points)))
- ",
"))))))
+ ",
")))))
+ ((string= object-type "freehand")
+ (track-mouse
+ (while (not (eq (car event) 'drag-mouse-1))
+ (setq event (read-event))
+ (let* ((end (if (eq (car event) 'drag-mouse-1)
+ (event-end event)
+ (event-start event)))
+ (end-coords (if (or (not snap) (string= snap "nil"))
+ (posn-object-x-y end)
+ (sketch--snap-to-grid (posn-object-x-y
end) grid-param))))
+ (setf (dom-attr node 'points) (mapconcat (lambda (pair)
+
(format "%s %s" (car pair) (cdr pair)))
+
(reverse (cl-pushnew end-coords points))
+
", "))
+ (sketch-update nil nil (cons (car end-coords) (cdr
end-coords)))
+ (setq sketch-cursor-position (format "(%s, %s)"
+ (car end-coords)
+ (cdr end-coords)))
+ (force-mode-line-update))))))
+ ;; (sketch-possibly-update-image sketch-svg)))
;; (sketch-possibly-update-image sketch-svg
;; :pointer 'arrow
;; :map `(((rect . ((0 . 0) .
(,(dom-attr sketch-svg 'width) . ,(dom-attr sketch-svg 'height))))
