branch: externals/sketch-mode
commit 0f870a1e2dceb4975bc794043c3be4e9b84a628f
Author: Daniel Nicolai <dalanico...@gmail.com>
Commit: Daniel Nicolai <dalanico...@gmail.com>
Implement load from definition buffer & modify object functionality
---
README.org | 46 +++++++++++++++----
sketch-mode.el | 131 +++++++++++++++++++++++++++++++++++++-----------------
sketch-scratch.el | 44 ------------------
3 files changed, 128 insertions(+), 93 deletions(-)
diff --git a/README.org b/README.org
index 4284f79..2dddf7f 100644
--- a/README.org
+++ b/README.org
@@ -3,28 +3,50 @@
* Preliminary comment
This is a new package that is still in development. However, its main
- functionality is very usable already. Any feedback, for example suggestions
- for enhancing the interface/usability, is very welcome (probably best by
- opening an issue). Also, any contributions are very welcome. The code of the
- package is very accessible (especially if you quickly read how to use
[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Edebug.html][edebug]].
+ functionality is very usable already. On the other hand, several (or most)
+ features are not implemented completely, simply because implementing these
+ things take time, and I should first focus on keeping myself alive:|. But if
+ you know some elisp, than it should be quite straightforward to complete the
+ implementation of those features. Any feedback, for example suggestions for
+ enhancing the interface/usability, is very welcome (probably best by opening
+ an issue). Also, any contributions are very welcome. The code of the package
+ is very accessible (especially if you quickly read how to use
[[https://www.gnu.org/software/emacs/manual/html_node/elisp/Edebug.html][edebug]]).
+ A list of ideas for implementation can be found in the preliminary comment in
+ the =sketch.el= file and additionally in the
[[https://github.com/dalanicolai/sketch-mode/wiki/vision][wiki]] section.
+
+
** Included features
- snap to grid
- draw text
- crop finale image
- set stroke, fill, width etc.
- show dom (lisp) in other window
- - draw angle arcs (between lines, available soon)
+ - draw angle arcs (between lines, available soon, I hope. See
+ =implement-angle-arc= branch)
- save drawing presets using
[[https://magit.vc/manual/transient.html#Saving-Values][transient's saving
values feature]] (documentation
contribution welcome)
+** Incomplete features (merged into main)
+ - Draw labels (not implemented for all type of objects. Easy to implement)
+ - Modify object (not, at all, fully implemented for all object. Easy to
+ implement).
+
+ It would be handy to have a 'transform group' option also.
[[https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/transform][SVG
groups allow
+ for easy transformations]]. Then it would probably be handy to wrap all
+ objects in group tags.
+
+** Incomplete features (not merged into main)
+ - Implement layers (see/try out =implement-layers= branch)
+
** Delicious low hanging fruit
- use svg snippets (i.e. design object in external programs like inkscape,
geogebra etc., end quickly insert them in your sketches)
- - export to tikz, asymptote, other image extensions etc.
** Less low hanging fruit
- draw directly in you literate org file, with the dom updated in your
source block
+ - export to tikz, asymptote, other image extensions etc. (probably requires
+ to implement 'nodes')
The =sketch-mode.el= file starts with listing TODO items describing features
that are missing from the package.
@@ -76,8 +98,13 @@
- to remove an object (without using undo), you should toggle labels by
pressing =l=, and then to remove an object enter its label after pressing
=R=.
- - You can hide the transient by pressing =q=, and you can go back to sketch
- mode via =M-x sketch= (or =C-c C-t= when still in the sketch-mode buffer)
+ - You can also modify the drawing by changing the object definition (i.e.
+ elisp). For that press =d= to open the definition in a side-window, then
+ press =q= to hide (deactivate the) transient (keymap). Now modify the code
+ and press =C-c C=c=, to load it and update the =\*sketch\*= buffer.
+ - After you've hidden the transient by pressing =q=, you can go back to
+ sketch mode via =M-x sketch= (or =C-c C-s= when still in the sketch-mode
+ buffer)
Create your sketch and then save
the file by pressing =S=.
@@ -87,7 +114,8 @@
the Netherlands, I have no penny to scratch my butt. Therefore, although I am
also really happy to offer it for free, if you find
[[https://github.com/dalanicolai][my package(s)]] (real
projects page in the making) useful (e.g. for you work), and if you can
afford
- it, then I would be very happy with any donation. As soon as I have the
+ it, then I would be very happy with any donation (of course that would also
+ enable me to work on your feature requests). As soon as I have the
opportunity/possibility to find a stable job, I will happily suggest you to
transfer or donate to other projects/charity.
diff --git a/sketch-mode.el b/sketch-mode.el
index f757bc1..4713604 100644
--- a/sketch-mode.el
+++ b/sketch-mode.el
@@ -66,7 +66,8 @@
(require 'transient)
(defgroup sketch nil
- "Configure default sketch (object) properties.")
+ "Configure default sketch (object) properties."
+ :group 'Applications)
(defcustom sketch-im-x-offset 7
"Default grid line separation distance (integer)."
@@ -187,12 +188,13 @@ transient."
(abs (/ (- (car end-coords) (car start-coords)) 2))
(abs (/ (- (cdr end-coords) (cdr start-coords)) 2))))
-(defun sketch--create-canvas (width height &optional grid-param)
+(defvar sketch-svg)
+(defvar-local svg-canvas nil)
+(defvar-local svg-grid nil)
+(defvar-local sketch-root nil)
+
+(defun sketch--create-canvas (width height &optional grid-parameter)
"Create canvas for drawing svg using the mouse."
- (defvar sketch-svg)
- (defvar svg-canvas)
- (defvar svg-grid)
- (defvar sketch-root)
(insert-image
(let ((width width)
(height height))
@@ -201,18 +203,18 @@ transient."
(svg-rectangle svg-canvas 0 0 width height :fill "white")
(setq svg-grid (svg-create width height))
(let ((dash t))
- (dotimes (x (1- (/ width grid-param)))
- (let ((pos (* (1+ x) grid-param)))
+ (dotimes (x (1- (/ width grid-parameter)))
+ (let ((pos (* (1+ x) grid-parameter)))
(svg-line svg-grid pos 0 pos height :stroke-dasharray (when dash
"2,4"))
(setq dash (if dash nil t)))))
(let ((dash t))
- (dotimes (x (1- (/ height grid-param)))
- (let ((pos (* (1+ x) grid-param)))
+ (dotimes (x (1- (/ height grid-parameter)))
+ (let ((pos (* (1+ x) grid-parameter)))
(svg-line svg-grid 0 pos width pos :stroke-dasharray (when dash
"2,4"))
(setq dash (if dash nil t)))))
(setq sketch-svg (append svg-canvas (when sketch-show-grid (cddr
svg-grid))))
(svg-image sketch-svg
- :grid-param grid-param
+ :grid-param grid-parameter
:pointer 'arrow
:map `(((rect . ((0 . 0) . (,(dom-attr sketch-svg 'width) .
,(dom-attr sketch-svg 'height))))
;; :map '(((rect . ((0 . 0) . (800 . 600)))
@@ -227,6 +229,8 @@ transient."
(call-interactively 'sketch-transient)
(setq sketch-root (svg-create width height)))
+(defvar-local sketch-elements nil)
+
;;;###autoload
(defun sketch (arg)
"Initialize or switch to (new) SVG image.
@@ -242,15 +246,14 @@ values"
(switch-to-buffer (get-buffer-create "*sketch*"))
;; FIXME: `defvar' can't be meaningfully inside a function like that.
;; FIXME: Use a `sketch-' prefix for all dynbound vars.
- (defvar-local sketch-elements nil)
- (defvar-local grid-param 25)
+ (setq grid-param 25)
(setq grid-param (if arg 25 (read-number "Enter grid parameter (enter
0 for no grid): ")))
(sketch--create-canvas width height grid-param)))))
-(defun sketch-snap-to-grid (coord grid-param)
- (cons (* (round (/ (float (car coord)) grid-param)) grid-param)
- (* (round (/ (float (cdr coord)) grid-param)) grid-param)))
+(defun sketch-snap-to-grid (coord grid-parameter)
+ (cons (* (round (/ (float (car coord)) grid-parameter)) grid-parameter)
+ (* (round (/ (float (cdr coord)) grid-parameter)) grid-parameter)))
;;; Transient
@@ -448,8 +451,9 @@ values"
(defun sketch-toggle-grid ()
(interactive)
- (setq sketch-show-grid (if sketch-show-grid nil t))
- (sketch-redraw))
+ (with-current-buffer "*sketch*"
+ (setq sketch-show-grid (if sketch-show-grid nil t))
+ (sketch-redraw)))
(defun sketch-labels ()
(interactive)
@@ -490,8 +494,9 @@ values"
(defun sketch-toggle-labels ()
(interactive)
- (setq sketch-show-labels (if sketch-show-labels nil t))
- (sketch-redraw))
+ (with-current-buffer "*sketch*"
+ (setq sketch-show-labels (if sketch-show-labels nil t))
+ (sketch-redraw)))
(defun sketch-translate-node-coords (node amount &rest args)
(dolist (coord args node)
@@ -515,12 +520,14 @@ values"
(defun sketch-redraw (&optional lisp lisp-buffer)
(unless sketch-mode
(user-error "Not in sketch-mode buffer"))
- (let ((lisp-window (or (get-buffer-window "*sketch-root*")
- (get-buffer-window lisp-buffer))))
- (unless (string= (buffer-name (window-buffer lisp-window)) "*sketch*")
- (if-let (buf (get-buffer"*sketch-root*"))
- (sketch-update-lisp-window sketch-root buf)
- (sketch-update-lisp-window lisp lisp-buffer))))
+ (when lisp-buffer
+ (sketch-update-lisp-window lisp lisp-buffer))
+ ;; (let ((lisp-window (or (get-buffer-window "*sketch-root*")
+ ;; (get-buffer-window lisp-buffer))))
+ ;; (unless (string= (buffer-name (window-buffer lisp-window)) "*sketch*")
+ ;; (if-let (buf (get-buffer"*sketch-root*"))
+ ;; (sketch-update-lisp-window sketch-root buf)
+ ;; (sketch-update-lisp-window lisp lisp-buffer))))
(setq sketch-svg (append svg-canvas
(when sketch-show-grid (cddr svg-grid))
(cddr sketch-root)
@@ -574,6 +581,8 @@ values"
(sketch--circle-radius
start-coords end-coords)))
("ellipse" `(svg-ellipse
,@(sketch--ellipse-coords start-coords end-coords))))))
(apply (car command-and-coords) sketch-root `(,@(cdr command-and-coords)
,@object-props :id ,(sketch-create-label)))
+ (when-let (buf (get-buffer "*sketch-root*"))
+ (sketch-update-lisp-window sketch-root buf))
(sketch-redraw)))
(transient-define-suffix sketch-remove-object ()
@@ -645,9 +654,10 @@ values"
(defun sketch-load-definition ()
(interactive)
- (setq sketch-root (read (buffer-string)))
- (with-current-buffer "*sketch*"
- (sketch-redraw)))
+ (let ((def (read (buffer-string))))
+ (with-current-buffer "*sketch*"
+ (setq sketch-root def)
+ (sketch-redraw))))
(defvar sketch-undo-redo nil)
@@ -741,21 +751,54 @@ values"
;;; Modify object
+(defun sketch-translate-object (buffer object-def props coords amount)
+ (dolist (coord coords)
+ (cl-incf (alist-get coord props) amount))
+ (sketch-redraw object-def buffer))
+
+;; TODO 'refactor' subsequent suffixes (e.g. create general function/macro)
(transient-define-suffix sketch-translate-down (args)
- (interactive (list (transient-args 'sketch-modify-object)))
+ (interactive (list (oref transient-current-prefix :value)))
(let* ((object (transient-arg-value "--object=" args))
- (object-def (dom-by-id sketch-svg (format "^a$" object)))
+ (buffer (transient-arg-value "--buffer=" args))
+ (object-def (dom-by-id sketch-svg (format "^%s$" object)))
(props (cadar object-def)))
- (dolist (coord '(y1 y2))
- (cl-incf (alist-get coord props) 10))
- (sketch-redraw object-def)))
+ (sketch-translate-object buffer object-def props '(y1 y2) 1)))
+
+(transient-define-suffix sketch-translate-fast-down (args)
+ (interactive (list (oref transient-current-prefix :value)))
+ (let* ((object (transient-arg-value "--object=" args))
+ (buffer (transient-arg-value "--buffer=" args))
+ (object-def (dom-by-id sketch-svg (format "^%s$" object)))
+ (props (cadar object-def)))
+ (sketch-translate-object buffer object-def props '(y1 y2) 10)))
+
+(transient-define-suffix sketch-translate-up (args)
+ (interactive (list (oref transient-current-prefix :value)))
+ (let* ((object (transient-arg-value "--object=" args))
+ (buffer (transient-arg-value "--buffer=" args))
+ (object-def (dom-by-id sketch-svg (format "^%s$" object)))
+ (props (cadar object-def)))
+ (sketch-translate-object buffer object-def props '(y1 y2) -1)))
+
+(transient-define-suffix sketch-translate-fast-up (args)
+ (interactive (list (oref transient-current-prefix :value)))
+ (let* ((object (transient-arg-value "--object=" args))
+ (buffer (transient-arg-value "--buffer=" args))
+ (object-def (dom-by-id sketch-svg (format "^%s$" object)))
+ (props (cadar object-def)))
+ (sketch-translate-object buffer object-def props '(y1 y2) -10)))
(transient-define-prefix sketch-modify-object ()
"Set object properties."
- :transient-suffix 'transient--do-call
+ :transient-suffix 'transient--do-call
["Properties"
- [("o" "object" "--object=")]]
- [("<down>" "Down" sketch-translate-down)
+ [("o" "object" sketch-modify-object 'transient--do-exit)]]
+ [[("<down>" "down" sketch-translate-down)
+ ("<up>" "up" sketch-translate-up)]
+ [("S-<down>" "fast down" sketch-translate-fast-down)
+ ("S-<up>" "fast up" sketch-translate-fast-up)]]
+ [("l" "Toggle labels" sketch-toggle-labels)
("q" "Quit" transient-quit-one)]
(interactive)
(let* ((object (completing-read "Transform element with id: "
@@ -763,13 +806,21 @@ values"
(buffer (get-buffer-create (format "*sketch-object-%s*" object))))
(display-buffer buffer '(display-buffer-in-side-window . ((side . right)
(window-width . 70))))
(pp (cadar (dom-by-id sketch-svg (format "^%s$" object))) buffer)
- (transient-setup 'sketch-modify-object nil nil :value (list (format
"--object=%s" object)))))
+ (with-current-buffer buffer
+ (emacs-lisp-mode))
+ (transient-setup 'sketch-modify-object
+ nil
+ nil
+ :value (list (format "--object=%s" object)
+ (format "--buffer=%s" buffer)))))
(defun sketch-update-lisp-window (lisp buffer)
;; (let ((sketch sketch-root))
- (with-current-buffer buffer
+ (save-current-buffer
+ (switch-to-buffer-other-window buffer)
(erase-buffer)
- (pp lisp (current-buffer))))
+ (pp lisp (current-buffer))
+ (end-of-buffer)))
(provide 'sketch-mode)
diff --git a/sketch-scratch.el b/sketch-scratch.el
deleted file mode 100644
index d89b298..0000000
--- a/sketch-scratch.el
+++ /dev/null
@@ -1,44 +0,0 @@
-;; (setq svg-scratch (svg-create 100 100))
-;; (svg-rectangle svg-scratch 25 25 50 50 :id "a")
-;; (svg-line svg-scratch 25 25 75 75 :id "b" :stroke-color "black")
-
-;; ;; (svg-remove svg-scratch "a")
-
-;; (insert-image (svg-image (append svg-scratch (nthcdr 2 svg-labels))))
-
-(defun sketch-modify-line-entry (node)
- (let* ((props (copy-alist (cadr node)))
- (id (alist-get 'id props)))
- (assq-delete-all 'id props)
- (vconcat [("id" 4 t)]
- (map 'vector (lambda (prop)
- ;; (let* ((key (car prop))
- ;; (val (cdr prop))
- ;; (length (when (stringp val)
- ;; (length val))))
- (list (symbol-name (car prop))
- (pcase (car prop)
- ((or 'x1 'y1 'x2 'y2) 5)
- ('marker-end 7)
- ('fill 18)
- ('stroke 18)
- (_ 10))
- t))
- props))))
-
-(define-derived-mode sketch-modify-mode tabulated-list-mode "sketch-modify"
- (setq tabulated-list-format (sketch-modify-line-entry (car (dom-by-id svg
"^a$"))))
- (let* ((props (copy-alist (cadar (dom-by-id svg "^a$"))))
- (id (alist-get 'id props)))
- (assq-delete-all 'id props)
- (setq tabulated-list-entries(list
- (list
- nil
- (vconcat (vector id)
- (map 'vector (lambda (prop) (let
((val (cdr prop)))
- (if
(stringp val)
-
val
-
(number-to-string val))))
- props)))))
- (tabulated-list-print)))
-
