;
; japanese-number.l: calculate japanese-style number in the scratchan sl clone for xyzzy
;
; Jul 17, 2013 by FUJIWARA Teruyoshi
;
; Copyright: Copyright (c) 2013 FUJIWARA Teruyoshi
; License:   Distributes under the same terms as xyzzy
;
; Installation:
;   1. Copy this file into /path/to/xyzzy/site-lisp.
;   2. Add "(load-library "japanese-number") in your .xyzzy.
;
; Usage:
;   Evalulate ++, --, **, // operators to replace +, -, *, / in the scratch buffer.
;
; Example:
;   (++ 1�� 1��)
;    => "1��1000"
;
;   (-- 12�� 5�疜)
;    => "11��5000��"
;
;   (** 1�� 1��)
;    => "1000��"
;
;   (// 1�� 1��)
;   =>"1��"
;
; Limitation:
;   Subtraction of very large floating number may not work because of numerical error.
;
(defun read-japanese-number (str)
  (labels ((calc-japanese-scale (str)
             (if str
                 (if (string-match "^[0-9\.]+" str)
                     (read-from-string (match-string 0))
                   0)
               0)))
    (if (string-match "\\([0-9\.]+��\\)?\\([0-9\.]+�疜\\)?\\([0-9\.]+�S��\\)?\\([0-9\.]+�\��\\)?\\([0-9\.]+��\\)?\\([0-9\.]+��\\)?\\([0-9\.]+�S\\)?\\([0-9\.]+�\\\)?\\([0-9\.]+\\)?" str)
        (let ((n1 (match-string 1))
              (n2 (match-string 2))
              (n3 (match-string 3))
              (n4 (match-string 4))
              (n5 (match-string 5))
              (n6 (match-string 6))
              (n7 (match-string 7))
              (n8 (match-string 8))
              (n9 (match-string 9)))
          (+ (* (calc-japanese-scale n1) 100000000)
             (* (calc-japanese-scale n2) 10000000)
             (* (calc-japanese-scale n3) 1000000)
             (* (calc-japanese-scale n4) 100000)
             (* (calc-japanese-scale n5) 10000)
             (* (calc-japanese-scale n6) 1000)
             (* (calc-japanese-scale n7) 100)
             (* (calc-japanese-scale n8) 10)
             (* (calc-japanese-scale n9) 1)))
      0)))

(defun encode-japanese-number (num)
  (cond ((>= num 1000000000000)
         (concat (format nil "~A" (truncate num 1000000000000))
                 "��"
                 (encode-japanese-number (mod num 1000000000000))))
        ((>= num 100000000)
         (concat (format nil "~A" (truncate num 100000000))
                 "��"
                 (encode-japanese-number (mod num 100000000))))
        ((>= num 10000)
         (concat (format nil "~A" (truncate num 10000))
                 "��"
                 (encode-japanese-number (mod num 10000))))
        (t (if (> num 0)
               (format nil "~A" num)
             ""))))

(defmacro direct-string (func &rest body)
  (cons
   func
   (mapcar (lambda (x)
             (read-japanese-number
              (cond ((symbolp x) (string x))
                    ((stringp x) x)
                    ((numberp x) (format nil "~A" x)))))
           body)))

(defmacro ++ (&rest args)
  `(encode-japanese-number (direct-string + ,@args)))

(defmacro -- (&rest args)
  `(encode-japanese-number (direct-string - ,@args)))

(defmacro ** (&rest args)
  `(encode-japanese-number (direct-string * ,@args)))

(defmacro // (&rest args)
  `(encode-japanese-number (direct-string / ,@args)))