From 55afdf266afcf1a72c929a8de68e96a97b45b21d Mon Sep 17 00:00:00 2001 From: Seong-Kook Shin Date: Tue, 27 Sep 2011 09:15:54 +0900 Subject: [PATCH] First working (it would seem) implementation This is the first working implementation of converting Gregorian date to Korean lunar date and vice vesa. --- Rakefile | 11 +++++++- gencache.el | 81 ++++++++++++++++++++++++++++++++++++++++++++--------- lunar-ko.el | 13 +++++---- 3 files changed, 85 insertions(+), 20 deletions(-) diff --git a/Rakefile b/Rakefile index 3509caf..74bf4c8 100644 --- 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 index 16b198b..4c70658 100644 --- 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))))) - (message "srcpath: %s" srcpath) - (message "outpath: %s" outpath) - (message "args: %S" command-line-args-left) - (let ((srcbuf (find-file-noselect srcpath t t)) + (replace-regexp-in-string + "\\.[^.]*$" ".el" srcfile))))) + ;;(message "srcpath: %s" srcpath) + ;;(message "outpath: %s" outpath) + ;;(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) - (kill-buffer outbuf))))) - + (when nil + (kill-buffer srcbuf) + (kill-buffer outbuf)) + )))) (provide 'gencache) diff --git a/lunar-ko.el b/lunar-ko.el index c91976d..fc26806 100644 --- 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)) - ((< month leap-month) (list (1+ month) day year)) - ((= month leap-month) (list (1+ month) day year t)) - ((> month leap-month) (list month day year))))) + (cond ((null leap-month) (list (1+ midx) day year)) + ((< midx leap-month) (list (1+ midx) day year)) + ((= midx leap-month) (list midx day year t)) + ((> 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))