;;; calendar.scm
;;; Time-stamp: <1998/01/17 21:18:20 narazaki@InetQ.or.jp>
;;; Author: Shuji Narazaki <narazaki@InetQ.or.jp>
;;; Version 1.2

;;; Code:

(if (not (symbol-bound? 'script-fu-calendar-year (the-environment)))
    (define script-fu-calendar-year 1998))
(if (not (symbol-bound? 'script-fu-calendar-month (the-environment)))
    (define script-fu-calendar-month 1))
(if (not (symbol-bound? 'script-fu-calendar-font-name (the-environment)))
    (define script-fu-calendar-font-name "\"courier\""))
(if (not (symbol-bound? 'script-fu-calendar-font-size (the-environment)))
    (define script-fu-calendar-font-size 20))
(if (not (symbol-bound? 'script-fu-calendar-with-label? (the-environment)))
    (define script-fu-calendar-with-label? TRUE))
(if (not (symbol-bound? 'script-fu-calendar-centering? (the-environment)))
    (define script-fu-calendar-centering? FALSE))
(if (not (symbol-bound? 'script-fu-calendar-labels (the-environment)))
    (define script-fu-calendar-labels
      '("Su" "Mo" "Tu" "We" "Th" "Fr" "Sa")
      ;; '("Su" "M" "Tu" "W" "Th" "F" Sa") 
      ))
;; Define hook function softly (You can set the value in another file or
;; through console interactively!)
;; It is should be a function which args are:
;;   img(image), layer(drawable), day(integer), x-position(0-6), y-position (0-5)
(if (not (symbol-bound? 'script-fu-calendar-day-hook (the-environment)))
    (define script-fu-calendar-day-hook
      #f
      ;; Value samples:
      ;; (lambda (img drw day x y) (plug-in-whirl-pinch 1 img drw 90.0 0.0 1.0))
      ;; (lambda (img drw day x y) 
      ;;   (if (< 0 y) (plug-in-shift 1 img drw 5 1))) ; horizontal
      ;; (lambda (img drw day x y) 
      ;;   (if (= x 0) (gimp-invert img drw)))
      ;; (lambda (img drw day x y)
      ;;   (if (< 0 day) (gimp-rotate img drw TRUE (* 2 *pi* (/ day 31)))))
      ))
(if (not (symbol-bound? 'script-fu-calendar-debug? (the-environment)))
    (define script-fu-calendar-debug? #f))

(define (script-fu-calendar img drw year month font-name font-size
			    with-label? ; merge-row? merge-column?
			    centering?)
  (define modulo fmod)
  (define (// x y) 
    (let ((float (/ x y)))
      ( - float (fmod float 1))))
  (define (layer-snap-vertical-to layer font-size)
    (let ((height (car (gimp-drawable-height layer)))
	  (offsets (gimp-drawable-offsets layer)))
     (gimp-layer-set-offsets layer
			     (nth 0 offsets)
			     (+ (nth 1 offsets) font-size (- height)))))
  (define (layer-snap-horizontal-to layer command)
    (let ((width (car (gimp-drawable-width layer)))
	  (offsets (gimp-drawable-offsets layer)))
      (cond ((eq? command 'centering)
	     (gimp-layer-set-offsets layer
				     (- (nth 0 offsets) (/ width 2))
				     (nth 1 offsets)))
	    ((eq? command 'flushleft)
	     (gimp-layer-set-offsets layer
				     (- (nth 0 offsets) width)
				     (nth 1 offsets))))))
  (define (get-the-data-of-the-month year month)
    (let* ((leap-year? (and (= (modulo year 4) 0)
			    (or (not (= (modulo year 100) 0))
				(= (modulo year 400) 0))))
	   (week-day-of-1st-day
	    (let ((day-of-year (+ 1 (* 31 (- month 1))))
		  (prior-years (- year 1)))
	      (if (> month 2)
		  (begin
		    (set! day-of-year (- day-of-year (// (+ 23 (* 4 month)) 10)))
		    (if leap-year? (set! day-of-year (+ day-of-year 1)))))
	      (modulo (+ day-of-year
			 (* 365 prior-years)
			 (// prior-years 4)
			 (- (// prior-years 100))
			 (// prior-years 400))
		      7)))
	   (now-table '(31 28 31 30 31 30 31 31 30 31 30 31))
	   (num-of-day 
	    (let ((now (nth (- month 1) now-table)))
	      (if (and (= month 2) leap-year?)
		  (+ now 1)
		  now)))
	    (num-of-weeks 
	     (cond ((and (< num-of-day 29) (= 0 week-day-of-1st-day)) 4)
		   ((< 35 (+ num-of-day week-day-of-1st-day)) 6)
		   ('else 5))))
      (list week-day-of-1st-day num-of-weeks num-of-day)))
  (define (in-the-month? x y day calendar-data)
    (cond ((= y -1) #t)			; label space
	  ((< day 1) #f)
	  ((< (nth 2 calendar-data) day) #f)
	  ('else #t)))

  (let* ((sizes (gimp-selection-bounds img))
	 (width (if (eq? (car sizes) FALSE)
		    (car (gimp-image-width img))
		    (- (nth 3 sizes) (nth 1 sizes))))
	 (height (if (eq? (car sizes) FALSE)
		     (car (gimp-image-height img))
		     (- (nth 4 sizes) (nth 2 sizes))))
	 (tmp-image (car (gimp-image-new width height RGB)))
	 (produced-layer #f)
	 (calendar-layer #f)
	 (text-layers '())
	 (calendar-data (get-the-data-of-the-month year month))
	 (index (- 1 (nth 0 calendar-data) (if (eq? with-label? TRUE) 7 0)))
	 (num-of-row (+ (nth 1 calendar-data) (if (eq? with-label? TRUE) 1 0)))
	 (row-height (+ font-size
			(max (/ (- height (* font-size num-of-row))
				(- num-of-row 1))
			     0)))
	 (column-width (/ width 7))
	 (dow-index 0)			; day of week
	 (wom-index (if (eq? with-label? TRUE) ; week of month
			-1		; -1 = "Su Mo Tu We.."
			0)))
    (gimp-undo-push-group-start img)
    (while (< wom-index (nth 1 calendar-data))
      (set! dow-index 0)
      (set! y (* (+ wom-index (if (eq? with-label? TRUE) 1 0)) row-height))
      (while (< dow-index 7)
	(set! x (* dow-index column-width))
	(if (in-the-month? dow-index wom-index index calendar-data)
	    (begin
	      (set! text-layers
		    (cons (car (gimp-text tmp-image -1 x y 
					  (if (= wom-index -1)
					      (nth dow-index
						   script-fu-calendar-labels)
					      (number->string index))
					  1 TRUE font-size PIXELS
					  "*" font-name "*" "*" "*" "*"))
			  text-layers))
	      (if (= wom-index -1)
		  (layer-snap-vertical-to (car text-layers) font-size))
	      (layer-snap-horizontal-to (car text-layers)
					(if (eq? centering? TRUE)
					    'centering
					    'flushleft))
	      (if script-fu-calendar-day-hook
		  (script-fu-calendar-day-hook tmp-image (car text-layers)
					       index dow-index wom-index))))
	(set! index (+ index 1))
	(set! dow-index (+ dow-index 1)))
      (set! wom-index (+ wom-index 1)))
    (set! produced-layer
	  (car (gimp-image-merge-visible-layers tmp-image EXPAND-AS-NECESSARY)))
    (set! calendar-layer 
	  (car (gimp-layer-new img
			       (car (gimp-drawable-width produced-layer))
			       (car (gimp-drawable-height produced-layer))
			       1
			       (string-append "Calendar (" (number->string year)
					      "/" (number->string month) ")")
			       100 NORMAL)))
    (if (eq? (car sizes) TRUE)
	(gimp-layer-set-offsets calendar-layer (nth 1 sizes) (nth 2 sizes))
	(gimp-layer-set-offsets calendar-layer
				(max (/ (- (car (gimp-image-width img))
					   (car (gimp-drawable-width calendar-layer)))
					2)
				     0)
				(max (/ (- (car (gimp-image-height img))
					   (car (gimp-drawable-height calendar-layer)))
					2)
				     0)))
    (gimp-edit-clear img calendar-layer) ; required to delete garbage
    (gimp-edit-copy tmp-image produced-layer)
    (gimp-floating-sel-anchor (car (gimp-edit-paste img calendar-layer FALSE)))
    (if (not script-fu-calendar-debug?)
	(gimp-image-delete tmp-image))
    (gimp-image-add-layer img calendar-layer -1)
    (gimp-undo-push-group-end img)
    (set! script-fu-calendar-year year)
    (set! script-fu-calendar-month month)
    (set! script-fu-calendar-font-name font-name)
    (set! script-fu-calendar-font-size font-size)
    (set! script-fu-calendar-with-label? with-label?)
    (set! script-fu-calendar-centering? centering?)
    (gimp-displays-flush)))

(script-fu-register 
 "script-fu-calendar"
 "<Image>/Script-Fu/Render/Calendar on selection"
 "Draw calendar into a new layer which size is *almost* same asthe current selection. "
 "Shuji Narazaki <narazaki@InetQ.or.jp>"
 "Shuji Narazaki"
 "1997"
 "RGB*"
 SF-IMAGE "Image to draw" 0
 SF-DRAWABLE "Drawable (no use)" 0
 SF-VALUE "Year" (number->string script-fu-calendar-year)
 SF-VALUE "Month" (number->string script-fu-calendar-month)
 SF-VALUE "Font name" script-fu-calendar-font-name
 SF-VALUE "Font size" (number->string script-fu-calendar-font-size)
 SF-TOGGLE "With label" script-fu-calendar-with-label?
 ;; SF-TOGGLE "Merge rows" TRUE
 ;; SF-TOGGLE "Merge columns" TRUE
 SF-TOGGLE "Centering" script-fu-calendar-centering?
)

;;; calendar.scm ends here