#|
彫僲栚偺斦柺傪弌椡偡傞丅
偙偺僼傽僀儖傪僶僀僩僐儞僷僀儖偟偰丄嶌惉偝傟偨
habuki-board.lc傪site-lisp偵曻傝崬傓丅
*scratch*偵偰(load-library "habuki-board")
傪昡壙偡傞丅暘偐傞恖偼揔摉偵丅

偦偆偟偨傜丄habuki-mode傪屇傃弌偟婯懃傪撉傒崬傫偩屻丄
(habuki-make-catalog "~/habuki-catalog.txt" 10)
偲偐傪昡壙偡傞偲僼傽僀儖偑弌棃傞偺偱丄
報嶞偟偰傒傞偲攝楍偑堦棗偱偒傞丅
巊偄廔傢偭偨傜habuki-board.lc偼幪偰偰栤戣側偄丅

偙偺僼傽僀儖偼habuki.l偺晅榐偱偁傞丅
徻嵶偼habuki.l傪尒傞偙偲丅
|#

(in-package "habuki")

(export
 '(habuki-board
   habuki-make-catalog))

(defun habuki-board-fundamental ()
  (setq habuki-board-figure
	(list (copy-string "丂+乗乗乗乗乗+丂+乗乗乗乗乗+丂")
	      (copy-string "丂|丂丂丂丂丂|丂|丂丂丂丂丂|丂")
	      (copy-string "+乗乗乗乗乗乗+乗+乗乗乗乗乗乗+")
	      (copy-string "|丂|丂丂丂丂|丂丂|丂丂丂丂|丂|")
	      (copy-string "+乗+乗乗乗乗+乗乗+乗乗乗乗+乗+")
	      (copy-string " 丂|丂丂丂丂|丂丂|丂丂丂丂|丂 ")
	      (copy-string " 丂+乗乗乗乗+乗乗+乗乗乗乗+丂 ")
	      (copy-string "丂丂丂丂|丂丂|丂|丂丂|丂丂丂丂")
	      (copy-string "丂丂丂丂+乗乗+丂+乗乗+丂丂丂  "))))

(setq board-position
      (map 'list
	   #'cons
	   "23456890-^qwertyuiop@[sdfghjkl;:vbm,"
	   '(      (2 1) (3 1) (4 1) (5 1) (6 1)  (10 1) (11 1) (12 1) (13 1) (14 1)
	     (1 3) (3 3) (4 3) (5 3) (6 3) (8 3)  (9 3)  (11 3) (12 3) (13 3) (14 3) (16 3)
	           (3 5) (4 5) (5 5) (6 5) (8 5)  (9 5)  (11 5) (12 5) (13 5) (14 5)
	     (5 7) (6 7)  (10 7) (11 7))))

(defun habuki-board-replace (p c)
  (and p c
       (setf (elt (elt habuki-board-figure (second p)) (first p)) c)))

(defun habuki-board-finger-replace (p c)
  (and p c
       (setf (elt (elt habuki-board-figure (1+ (second p))) (first p)) c)))

(defun habuki-board (root input)
  (habuki-board-fundamental)
  (and (> (length root) 0)
       (habuki-board-replace '(16 8) (elt root 0)))
  (dolist (pos habuki-char)
    (let* ((word (gethash (list root (concat input (string pos))) *habuki-rule-table*))
	   (c (elt word 0))
	   (display-char (or (and (null word) #\丂)
			     (and (string-match "^#p" word) #\仩)
			     (and (string-match "^#c" word) #\仮)
			     (and (string-match "^##" word) #\仈)
			     (and (string-match "^#s" word) #\仚)
			     (cdr (assoc c help-appearance))
			     c)))
      (habuki-board-replace (cdr (assoc pos board-position)) display-char)))
  (or (not input)
      (when (= (length input) 1)
	(habuki-board-finger-replace (cdr (assoc (char input 0) board-position)) #\仠))
      (when (= (length input) 2)
	(or (when (equal (elt input 0) (elt input 1))
	      (habuki-board-finger-replace (cdr (assoc (char input 0) board-position)) #\仧))
	    (and (habuki-board-finger-replace (cdr (assoc (char input 0) board-position)) #\仠)
		 (habuki-board-finger-replace (cdr (assoc (char input 1) board-position)) #\仜)))))
  habuki-board-figure)

(defun print-habuki-board (fp root input &optional (margin nil))
  (dolist (x (habuki-board root input))
    (format fp "~A~%" x))
  (unless margin
    (format fp "~%")))

(defun habuki-make-catalog (file row)
  (long-operation
    (let ((y 0)
	  (root ""))
      (with-open-file (catalog file :direction :output
			  :if-exists :append :if-does-not-exist :create)
	(mapc #'(lambda (rule-file)
		  (when (and rule-file
			     (file-exist-p rule-file))
		    (with-open-file (in rule-file :direction :input)
		      (let (buff from to)
			(while (setq buff (read-line in nil))
			  (setq buff (string-trim " \t" buff))
			  (or (string-match "^%" buff)
			      (and (string-match "^#s" buff)
				   (setq from (1+ (string-match "\"" buff)))
				   (setq to (string-match "\"" buff from))
				   (print-habuki-board catalog (setq root (substring buff from to)) ""
						       (= (setq y (or (and (eq (1+ y) row) 0)
								      (1+ y))) 0)))
			      (and (setq to (string-match ">#p" buff))
				   (print-habuki-board catalog root (substring buff 0 to)
						       (= (setq y (or (and (eq (1+ y) row) 0)
								      (1+ y))) 0)))
			      ))))))
	      *habuki-normal-rule*))))
  (format t "~D峴偱愜傝曉偡偲椙偄傛丅~%侾峴30帤偩偐傜丄揔摉偵抜慻傒偟偰偹丅" (1- (* 10 row))))
