Function: strokes-xpm-for-stroke

strokes-xpm-for-stroke is an interactive and byte-compiled function defined in strokes.el.gz.

Signature

(strokes-xpm-for-stroke &optional STROKE BUFNAME B/W-ONLY)

Documentation

Create an XPM pixmap for the given STROKE in buffer " *strokes-xpm*".

If STROKE is not supplied, then strokes-last-stroke will be used. Optional BUFNAME to name something else. The pixmap will contain time information via rainbow dot colors where each individual strokes begins. Optional B/W-ONLY non-nil will create a mono pixmap, not intended for trying to figure out the order of strokes, but rather for reading the stroke as a character in some language.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/strokes.el.gz
(defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only)
  "Create an XPM pixmap for the given STROKE in buffer \" *strokes-xpm*\".
If STROKE is not supplied, then `strokes-last-stroke' will be used.
Optional BUFNAME to name something else.
The pixmap will contain time information via rainbow dot colors
where each individual strokes begins.
Optional B/W-ONLY non-nil will create a mono pixmap, not intended
for trying to figure out the order of strokes, but rather for reading
the stroke as a character in some language."
  (interactive)
  (save-excursion
    (let ((buf (get-buffer-create (or bufname " *strokes-xpm*")))
	  (stroke (strokes-eliminate-consecutive-redundancies
		   (strokes-fill-stroke
		    (strokes-renormalize-to-grid (or stroke
						     strokes-last-stroke)
						 31))))
	  (lift-flag t)
	  (rainbow-chars (list ?R ?O ?Y ?G ?B ?P))) ; ROYGBIV without indigo
      (set-buffer buf)
      (erase-buffer)
      (insert strokes-xpm-header)
      (cl-loop repeat 33 do
               (insert ?\")
               (insert-char ?\s 33)
               (insert "\",")
               (newline)
               finally
               (forward-line -1)
               (end-of-line)
               (insert "}\n"))
      (cl-loop for point in stroke
               for x = (car-safe point)
               for y = (cdr-safe point) do
               (cond ((consp point)
                      ;; draw a point, and possibly a starting-point
                      (if (and lift-flag (not b/w-only))
                          ;; mark starting point with the appropriate color
                          (let ((char (or (car rainbow-chars) ?\.)))
                            (cl-loop for i from 0 to 2 do
                                     (cl-loop for j from 0 to 2 do
                                              (goto-char (point-min))
                                              (forward-line (+ 15 i y))
                                              (forward-char (+ 1 j x))
                                              (delete-char 1)
                                              (insert char)))
                            (setq rainbow-chars (cdr rainbow-chars)
                                  lift-flag nil))
                        ;; Otherwise, just plot the point...
                        (goto-char (point-min))
                        (forward-line (+ 16 y))
                        (forward-char (+ 2 x))
                        (subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
                     ((strokes-lift-p point)
                      ;; a lift--tell the loop to X out the next point...
                      (setq lift-flag t))))
      (when (called-interactively-p 'interactive)
	(pop-to-buffer " *strokes-xpm*")
	;;	(xpm-mode 1)
	(goto-char (point-min))
	(put-image (create-image (buffer-string) 'xpm t :ascent 100)
		   (line-end-position))))))