[elpa] externals/sketch-mode 0f870a1 20/38: Implement load from definition buffer & modify object functionality

[ELPA Syncer]

branch: externals/sketch-mode
commit 0f870a1e2dceb4975bc794043c3be4e9b84a628f
Author: Daniel Nicolai <dalanicolai@gmail.com>
Commit: Daniel Nicolai <dalanicolai@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)))
-