First working (it would seem) implementation

This is the first working implementation of converting Gregorian date to Korean lunar date and vice vesa.
cinsk · Sep 27, 2011 · 55afdf2 · 55afdf2
1 parent d577cd6
commit 55afdf2
Show file tree

Hide file tree

Showing 3 changed files with 85 additions and 20 deletions.
diff --git a/Rakefile b/Rakefile
@@ -3,7 +3,7 @@ require 'rake/clean'
 
 task :default => [:generate]
 
-SRC = FileList['script/lunar-ko-*.rb']
+SRC = FileList['script/lunar-ko-mdays.rb']
 
 SRC.each do |script|
   target = File.basename(script.sub(/\.rb$/, ".el"))
@@ -16,3 +16,12 @@ SRC.each do |script|
   task :generate => target
 end
 
+CLEAN.include("cache.dat")
+task :cachedata => ["script/lunar-ko-cache.rb"] do |t|
+  sh "./script/lunar-ko-cache.rb -dscript/ko-lunar.db > cache.dat"
+end
+
+file "lunar-ko-cache.el" => [:cachedata] do |t|
+  sh "emacs -q -L . --batch -l gencache -f lunar-ko-generate-cache cache.dat lunar-ko-cache.el"
+end
+task :generate => "lunar-ko-cache.el"
diff --git a/gencache.el b/gencache.el
@@ -20,15 +20,38 @@
 
 ;;; Commentary:
 
-;; 
+;; In my first implementation, I used to generate "lunar-ko-cache.el"
+;; using a Ruby script, since Ruby does have support for sqlite3
+;; database.  In that implementation, I generate (julian . kld) pair
+;; where JULIAN is the Astronomical Julian Day(AJD) number, and KLD is
+;; the numerical representation of Korean lunar date.
+;;
+;; Unfortunately, the Emacs algorithm that convert Gregorian date to
+;; julian day number is different from that of Ruby.  For example,
+;;
+;; Gregorian  Emacs AJD Ruby AJD
+;; ---------- --------- ---------
+;; 1582-10-04 2299149.5 2299159.5
+;; 1582-10-05 2299150.5 N/A
+;; ...        ...       N/A
+;; 1582-10-14 2299159.5 N/A
+;; 1582-10-15 2299160.5 2299160.5
+;;
+;; (Note that Gregorian calendar starts from 1582-10-15.)
+;;
+;; Thus, I first create intermediate file using Ruby to read sqlite3
+;; database, then using Emacs lisp to generate "lunar-ko-cache.el".
 
 ;;; Code:
 
 (require 'calendar)
 
+;; To run:
 ;;
-;;emacs -L . -l gencache --batch --eval '(lunar-ko-generate-cache "./script/cache.dat" "cache.el"))'
+;; $ emacs -q -L . -l gencache --batch \
+;;   -f lunar-ko-generate-cache "./script/cache.dat" "cache.el"
 ;;
+;; See "Rakefile" for more.
 
 ;
 ; TODO: consult `batch-byte-compile' and modify
@@ -42,23 +65,50 @@ Julian day number.  See also `calendar-astro-date-string'."
   (calendar-astro-from-absolute
    (calendar-absolute-from-gregorian date)))
 
-(defun lunar-ko-generate-cache (srcfile &optional outfile)
+(defvar cache-header
+  (format ";;; lunar-ko-cache.el --- cache data for Korean lunar calendar
+
+;; Automatically generated by gencache.el in %s
+
+(defconst korean-lunar-cache
+  [" (current-time-string))
+  "cache header")
+
+(defvar cache-tail
+  "]
+\"Solar to Korean lunar cache\")
+
+(provide 'lunar-ko-cache)"
+  "cache tail")
+
+(defun lunar-ko-generate-cache (&optional srcfile outfile)
   (let ((coding-system-for-read 'utf-8)
         (coding-system-for-write 'utf-8))
+    (if (and noninteractive
+             (consp command-line-args-left)
+             (> (length command-line-args-left) 0))
+        (setq srcfile (car command-line-args-left)
+              outfile (cadr command-line-args-left)))
     (let* ((srcpath (expand-file-name srcfile))
            (outpath (expand-file-name 
                      (or outfile
-                         (replace-regexp-in-string "\\.[^.]*$" ".el" srcfile)))))
+                         (replace-regexp-in-string
-      (message "srcpath: %s" srcpath)
+                          "\\.[^.]*$" ".el" srcfile)))))
-      (message "outpath: %s" outpath)
+      ;;(message "srcpath: %s" srcpath)
-      (message "args: %S" command-line-args-left)
+      ;;(message "outpath: %s" outpath)
-      (let ((srcbuf (find-file-noselect srcpath t t))
+      ;;(message "args: %S" command-line-args-left)
+
+      (if (not (file-readable-p srcpath))
+          (error "error: cannot find %s" srcpath))
+      (let ((srcbuf (find-file-noselect srcpath t))
             (outbuf (create-file-buffer outpath)))
         (save-current-buffer
           (set-buffer outbuf)
           (setq buffer-file-name outpath)
           ;;(setq buffer-file-coding-system 'utf-8)
-          (emacs-lisp-mode))
+          ;;(set-buffer-multibyte t)
+          (emacs-lisp-mode)
+          (insert cache-header))
         (save-current-buffer
           (set-buffer srcbuf)
           (goto-char (point-min))
@@ -69,7 +119,9 @@ Julian day number.  See also `calendar-astro-date-string'."
                   (month (string-to-number (match-string-no-properties 2)))
                   (day (string-to-number (match-string-no-properties 3)))
                   (lunar (match-string-no-properties 4))
-                  (text (match-string-no-properties 5)))
+                  (text (string-to-multibyte (match-string-no-properties 5))))
+              (if (string-match "???001001$" lunar)
+                  (message "Generating cache for ..%d.." year))
               (save-current-buffer
                 (set-buffer outbuf)
                 (goto-char (point-max))
@@ -80,10 +132,13 @@ Julian day number.  See also `calendar-astro-date-string'."
                                   lunar text)))))))
         (save-current-buffer
           (set-buffer outbuf)
+          (goto-char (point-max))
+          (insert cache-tail)
           (save-buffer))
-        (kill-buffer srcbuf)
+        (when nil
-        (kill-buffer outbuf)))))
+          (kill-buffer srcbuf)
-
+          (kill-buffer outbuf))
+        ))))
 
 
 (provide 'gencache)

diff --git a/lunar-ko.el b/lunar-ko.el
@@ -147,7 +147,7 @@ of (MONTH DAY YEAR).  See also `calendar-astro-goto-day-number'."
   ;; `korean-lunar-cache' is generated by Ruby, we cannot convert the
   ;; julian date in `korean-lunar-cache' if DATE is prior to
   ;; 1582-10-*.
-  (assert (> date 2299177) "out of range: %S")
+  ;;(assert (> date 2299177) "out of range: %S")
   (calendar-gregorian-from-absolute 
    (floor (calendar-astro-to-absolute date))))
 
@@ -262,20 +262,21 @@ is the index value of the vector in `korean-lunar-months' (0-12)."
 
 The internal form is like (MONTH-INDEX DAY YEAR), where MONTH-INDEX
 is the index value of the vector in `korean-lunar-months' (0-12)."
-  (let* ((month (lunar-ko-month impl))
+  (let* ((midx (lunar-ko-month impl))
          (day (lunar-ko-day impl))
          (year (lunar-ko-year impl))
          (entry (or cache
                     (gethash year korean-lunar-months)))
          (leap-month (car entry)))
-    (cond ((null leap-month) (list (1+ month) day year))
+    (cond ((null leap-month) (list (1+ midx) day year))
-          ((< month leap-month) (list (1+ month) day year))
+          ((< midx leap-month) (list (1+ midx) day year))
-          ((= month leap-month) (list (1+ month) day year t))
+          ((= midx leap-month) (list midx day year t))
-          ((> month leap-month) (list month day year)))))
+          ((> midx leap-month) (list midx day year)))))
 
 (defun lunar-ko-advance (ldatespec days)
   "Return the lunar date, advanced DAYS days from LDATESPEC."
   (let ((date (lunar-ko-date-to-impl ldatespec)))
+    (setq days (round days))
     (while (> days 0)
       (let* ((year (lunar-ko-year date))
              (entry (gethash year korean-lunar-months))