;;; dragon-char.lisp
;;; Copyright (c) 2015 Devon Sean McCullough
;;; Licensed under the GNU GPLv3

;;; TODO
;;; maybe tilt numbers to face stroke direction

(defvar resistor-colors #(black brown red orange yellow green blue violet gray white)
  "Resistor color names as a vector of symbols.")

(defvar color-loop '#1=(black brown red orange yellow green blue violet gray . #1#)
   "Circular list resistor color codes 0-8, omitting white.")

(defun read-dragon-char-file (file &optional histogram)
  "Read FILE and return a list of svg path commands as lists
of (c x y ...) e.g., a file of
A 0.0 0.1
B 0.2 0.3
C 0.4 0.5
D 0.6 0.7
L 0.8 0.9
produces ((#\M 0.0 0.1) (#\C 0.2 0.3 0.4 0.5 0.6 0.7) (#\L 0.8 0.9)).
Optional HISTOGRAM records first char of each line."
  (with-open-file (char file)
    (loop
       with data = '()
       for line = (read-line char nil)
       for (k x y) = (ignore-errors
		       (with-input-from-string (in line)
			 (list (read-char in) (read in) (read in))))
       for c = (cdr (assoc k '((#\A . #\M)
			       (#\B . #\C) (#\C . #\Space) (#\D . #\Space)
			       (#\L . #\L))))
       unless line
       return (nreverse data)
       do
	 (case c
	   ((#\M #\C #\L)
	    (push (list c x y) data))
	   (#\Space
	    (nconc (car data) (list x y))))
	 (when (and histogram
		    k)
	   (incf (aref histogram (char-code k)))))))

(defun dragon-char (&optional order)
  "Render the 1506 Chinese characters at
http://dragon-char.cvs.sourceforge.net/viewvc/dragon-char/dragon-data
as a bunch of /tmp/*.svg files.
Optional ORDER to colorize stroke order."
  (let* ((wild "~/Downloads/dragon-data/characters/*.char")
	 (dir (directory wild))
	 (hist (make-array 256 :initial-element 0))
	 (ld (length dir))
	 (lh (length hist)))
    (dolist (file dir)
      ;;(format *debug-io* "~&file = ~S~&" file)
      (let ((path (read-dragon-char-file file hist))
	    (n 0)
	    x y)
	(with-open-file (svg (make-pathname :defaults file
					    :directory '(:absolute "tmp")
					    :type "svg")
			     :direction ':output
			     :if-exists ':supersede)
	  (princ
	   "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"
\"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">
<svg width=\"10cm\" height=\"10cm\" viewBox=\"0 0 600 600\"
     xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"
     xmlns:xlink=\"http://www.w3.org/1999/xlink\">
  <g transform=\"translate(100,100) scale(500)\">
    <rect x=\"0\" y=\"0\" width=\"1\" height=\"1\"
          fill=\"none\" stroke=\"red\" stroke-width=\"0.002\"/>
" svg)
	  (dolist (command path)
	    (let* ((color (nth n color-loop))
		   (last2 (last command 2))
		   (nx (first last2))
		   (ny (second last2))) 
	      (unless (char= #\M (first command))
		(when order 
		  (let* ((dx (- nx x))
			 (dy (- ny y))
			 (d (sqrt (+ (* dx dx)
				     (* dy dy))))
			 (k (/ 0.05 (if (zerop d) 1 d)))			   
			 (tx (- x (* k dx) 0.05))
			 (ty (- y (* k dy))))
		    ;; (when (zerop d) (format *debug-io* "~&dot ~A ~D ~D,~D~&" file n x y))
		    (unless (zerop d)
		      (incf n)
		      (format svg "    <text x=\"~F\" y=\"~F\" font-size=\"0.1\" fill=\"~A\">~D</text>~%"
			      tx ty color n))))
		(format svg "    <path d=\"M~D,~D~{~C~D,~D~@{ ~D,~D~}~}\" stroke=\"~A\" fill=\"none\" stroke-linecap=\"round\" stroke-width=\"0.02\"/>~%"
			x y command color))
	      (setq x nx
		    y ny)))
	  (princ "  </g>
</svg>" svg))))
    (let ((sh (reduce #'+ hist)))
      (format t "~&~A has ~D files totaling ~D lines.~&"
	      wild ld sh)
      (dotimes (i lh)
	(let ((h (aref hist i)))
	  (unless (zerop h)
	    (format t "~&~:C	#x~2,'0X	~6D	~5,2,2F%	~4,2F~&"
		    (code-char i) i h (/ h sh) (/ h ld))))))))

;;; dragon-char.lisp end

CL-USER> (load "dragon-char.lisp")
CL-USER> (dragon-char t)
~/Downloads/dragon-data/characters/*.char has 1506 files totaling 40573 lines.
Return	#x0D	    18	 0.04%	0.01
#	#x23	  1494	 3.68%	0.99
A	#x41	 14168	34.92%	9.41
B	#x42	  3514	 8.66%	2.33
C	#x43	  3514	 8.66%	2.33
D	#x44	  3514	 8.66%	2.33
L	#x4C	 14351	35.37%	9.53
NIL