Display SVG-formatted scsnowman in Emacs.

scsnowman-scratch.el

(require 'svg)

(defun svg-path (svg d &rest args)
  "Create a path D in SVG."
  (svg--append
   svg
   (dom-node 'path
	     `((d . ,d)
	       ,@(svg--arguments svg args)))))

(defun scsnowman-insert ()
  "Insert SVG-formatted scsnowman image."
  (interactive)
  ;; https://github.com/aminophen/scsnowman/blob/master/scsnowman-normal.def
  (let ((svg (svg-create 100 100)))
    ;; body
    (svg-path svg (concat
                   "M50 28 C 64 28, 76 35,"
		   " 76 45 C 76 49, 72 53,"
		   " 67 56 C 79 59, 84 68,"
		   " 84 75 C 84 87, 75 92,"
		   " 68 92 "
		   "L32 92 C 25 92, 16 87,"
		   " 16 75 C 16 68, 21 59,"
		   " 33 56 C 28 53, 24 49,"
		   " 24 45 C 24 35, 36 28,"
		   " 50 28 "
                   "Z")
              :stroke-color "black"
              :fill-color "transparent")
    ;; eyes
    (svg-ellipse svg 40 44 2 3 :fill-color "black")
    (svg-ellipse svg 60 44 2 3 :fill-color "black")
    ;; mouth
    (svg-path svg "M40 52 C 45 55, 55 55, 60 52" :stroke-color "black" :fill-color "transparent")
    ;; hat
    (svg-path svg (concat
                   "M58 10 "
                   "L77 19 "
                   "L74 39 C 66 40, 50 34,"
		   " 46 28 "
                   "L58 10 "
                   "Z")
              :stroke-color "green"
              :fill-color "green")
    ;; arms
    (svg-path svg (concat
		   "M20 69 C 19 67, 14 59,"
		   " 13 58 C 12 57, 10 57,"
		   "  7 56 C  4 54,  6 54,"
		   "  8 54 C  9 54, 11 56,"
		   " 12 56 C 14 54, 14 53,"
		   " 15 51 C 16 49, 16 51,"
		   " 16 52 C 16 54, 14 56,"
		   " 15 57 C 16 58, 21 65,"
		   " 22 67 C 23 69, 21 70,"
		   " 20 69 "
		   "Z")
	      :stroke-color "brown"
	      :fill-color "brown")
    (svg-path svg (concat
		   "M80 69 C 81 67, 86 59,"
		   " 87 58 C 88 57, 90 57,"
		   " 93 56 C 96 54, 94 54,"
		   " 92 54 C 91 54, 89 56,"
		   " 88 56 C 86 54, 86 53,"
		   " 85 51 C 84 49, 84 51,"
		   " 84 52 C 84 54, 86 56,"
		   " 85 57 C 84 58, 79 65,"
		   " 78 67 C 77 69, 79 70,"
		   " 80 69 "
		   "Z")
	      :stroke-color "brown"
	      :fill-color "brown")
    ;; muffler
    (svg-path svg (concat
                   "M27 52 C 42 62, 58 62,"
		   " 73 52 C 75 56, 76 56,"
		   " 77 59 C 77 61, 75 63,"
		   " 73 63 C 74 67, 74 69,"
		   " 76 74 C 75 75, 72 76,"
		   " 66 77 C 66 73, 65 70,"
		   " 63 66 C 42 70, 32 65,"
		   " 24 59 C 25 55, 26 53,"
		   " 27 52 "
                   "Z")
              :stroke-color "none"
              :fill-color "red")
    ;; snow
    (svg-circle svg  7 72 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 13 45 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg  8 32 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 23 24 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 42 11 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 74 11 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 88 27 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 92 47 4 :stroke-color "skyblue" :fill-color "transparent")
    (svg-circle svg 94 77 4 :stroke-color "skyblue" :fill-color "transparent")

    (svg-insert-image svg)))

(require 'posframe)

(defun scsnowman-posframe-show ()
  (interactive)
  (let ((buf (get-buffer-create " *scsnowman*")))
    (with-current-buffer buf
      (erase-buffer)
      (scsnowman-insert))
    (posframe-show buf
                   :background-color "white"
                   :internal-border-width 2
                   :internal-border-color "black"
                   :poshandler #'posframe-poshandler-window-center)))

(defun scsnowman-posframe-delete ()
  (interactive)
  (posframe-delete (get-buffer " *scsnowman*")))