Permalink
Browse files

First working (it would seem) implementation

This is the first working implementation of converting
Gregorian date to Korean lunar date and vice vesa.
  • Loading branch information...
1 parent d577cd6 commit 55afdf266afcf1a72c929a8de68e96a97b45b21d @cinsk committed Sep 27, 2011
Showing with 85 additions and 20 deletions.
  1. +10 −1 Rakefile
  2. +68 −13 gencache.el
  3. +7 −6 lunar-ko.el
View
@@ -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"
View
@@ -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)
View
@@ -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))

0 comments on commit 55afdf2

Please sign in to comment.