; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.

(define (script-fu-sg-calendar-year orig-image orig-drawable 
                                    year 
                                    num-cols 
                                    padding
                                    sunday? layout font fontsize% justify? border border-color gravity)

  ;; Perform a crude search for the largest font that will fit within
  ;; the given dimensions
  ;
  (define (calc-fontsize text font fontsize% width height)
    (let* ((fontsize 6) ;; minimum possible fontsize
           (extents nil)
           (last-extents nil)
           (last-fontsize 3)
           (adjust 2) )
      (set! extents (gimp-text-get-extents-fontname text fontsize PIXELS font))
      (set! width (* width fontsize% 0.01))
      (set! height (* height fontsize% 0.01))
      (while (and (<> last-fontsize fontsize) (not (equal? extents last-extents)))
        (if (or (> (car extents) width) (> (cadr extents) height))
          (begin 
            (set! fontsize last-fontsize)
            (set! adjust (+ (* (- adjust 1) 0.5) 1)) )
          (begin
            (set! last-extents extents)
            (set! last-fontsize fontsize) ) )
        (set! fontsize (truncate (* fontsize adjust)))
        (set! extents (gimp-text-get-extents-fontname text fontsize PIXELS font)) )
      (max fontsize 6) ) )

  (let* ((image 0)
         (orig-x (car (gimp-drawable-offsets orig-drawable)))
         (orig-y (cadr (gimp-drawable-offsets orig-drawable)))
         (orig-sel 0)
         (bounds (gimp-drawable-mask-intersect orig-drawable))
         (buffer "")
         (layer 0)
         (display 0) )
    (gimp-image-undo-group-start orig-image)
    (set! orig-sel (car (gimp-selection-save orig-image)))
    (unless (zero? (car bounds))
      (set! bounds (cdr bounds))
      (set! orig-x (car bounds))
      (set! orig-y (cadr bounds))
      (gimp-rect-select orig-image orig-x orig-y (caddr bounds) (cadddr bounds) CHANNEL-OP-REPLACE FALSE 0) )
    (set! buffer (car (gimp-edit-named-copy orig-drawable "buffer")))
    (set! image (car (gimp-edit-named-paste-as-new buffer)))
    (gimp-image-undo-disable image)
    (set! display (car (gimp-display-new image)))
    (set! layer (car (gimp-image-get-active-layer image)))
    (gimp-buffer-delete buffer)
    (let* ((x1 0)
           (y1 0)
           (x2 (car (gimp-drawable-width layer)))
           (y2 (car (gimp-drawable-height layer)))
           (width (- x2 x1))
           (height (- y2 y1))
           (x x1)
           (y y1)
           (w (/ width num-cols))
           (h (/ height (ceiling (/ 12 num-cols))))
           (pad-factor (/ (- 100 padding) 100))
           (w-l (* w pad-factor))
           (h-l (* w pad-factor))
           (temp-layer 0)
           (month 0)
           (month-fontsize 6)
           (extents '()) )
      (when (< h (/ h-l pad-factor)) ; need to shrink calendar width
        (set! h-l (* h (* pad-factor 0.9))) ; increase vertical padding a bit
        (set! w-l h-l) )
      (set! month-fontsize (apply min (map (lambda (text) 
                                               (calc-fontsize text font 100 w-l (- h h-l)) )
                                           sg-calendar-months ) ) )
      (while (< y y2)
        (while (and (< x x2) (< month 12))
          (gimp-rect-select image (+ x (/ (- w w-l) 2)) (+ y (- h h-l)) w-l h-l CHANNEL-OP-REPLACE FALSE 0)
          (set! buffer (car (gimp-edit-named-copy layer "buffer")))
          (gimp-floating-sel-to-layer (car (gimp-edit-named-paste layer buffer FALSE)))
          (set! temp-layer (car (gimp-image-get-active-layer image)))
          (gimp-buffer-delete buffer)
          (script-fu-sg-calendar image temp-layer month year sunday? layout font fontsize% justify? border border-color gravity)
          (gimp-image-remove-layer image temp-layer)
          (set! extents (gimp-text-get-extents-fontname (list-ref sg-calendar-months month) 
                                                        month-fontsize 
                                                        PIXELS 
                                                        font ))
          (set! temp-layer (car (gimp-text-fontname image -1 
                                                    (+ x (/ (- w (car extents)) 2))
                                                    (- (+ y (- h h-l)) (cadr extents) 2)
                                                    (list-ref sg-calendar-months month) 
                                                    0 FALSE 
                                                    month-fontsize PIXELS font )))
          (set! x (+ x w))
          (set! month (+ month 1)) )
        (set! x x1)
        (set! y (+ y h)) ) )
    ;; Now, transfer the rendered layers to original image
    (gimp-selection-none image)
    (let loop ((layers (cdr (reverse (vector->list (cadr (gimp-image-get-layers image))))))
               (target-layer orig-drawable) )
      (if (null? layers)
        #t
        (begin
          (let ((x (car (gimp-drawable-offsets (car layers))))
                (y (cadr (gimp-drawable-offsets (car layers))))
                (pos (car (gimp-image-get-layer-position orig-image target-layer))) )
            (set! target-layer (car (gimp-layer-new-from-drawable (car layers) orig-image)))
            (gimp-image-add-layer orig-image target-layer pos)
            (gimp-layer-set-offsets target-layer (+ orig-x x) (+ orig-y y)) )
          (loop (cdr layers) target-layer) ) ) )
          
    (gimp-selection-load orig-sel)
    (gimp-image-remove-channel orig-image orig-sel)
    (gimp-image-set-active-layer orig-image orig-drawable)
    (gimp-image-undo-group-end orig-image)
    (gimp-display-delete display)
    (gimp-displays-flush)
    )
  )

(script-fu-register "script-fu-sg-calendar-year"
  "Calendar year..."
  "Generate a calendar for current layer"
  "Saul Goode"
  "Saul Goode"
  "Dec 2010"
  "RGB*,GRAY*"
  SF-IMAGE    "Image"    0
  SF-DRAWABLE "Drawable"  0
  SF-ADJUSTMENT "Year" '( 2011 1753 2050 1 10 0 1 )
  SF-ADJUSTMENT "Columns" '( 4 1 12 1 10 0 1 )
  SF-ADJUSTMENT "Padding" '( 10 0 80 1 10 0 1 )
  
  SF-TOGGLE "Sunday first" TRUE
  SF-OPTION "Layout" '( "Allow 6-week span" "Force 6-week span" "Wrap Week 6 to Week 1" "Wrap Week 6 to Week 5")
  SF-FONT "Font" "Sans" 
  SF-ADJUSTMENT "Font Size (% of maximum)" '( 100 0 100 1 10 0 1)
  SF-TOGGLE "Right Justify" TRUE
  SF-ADJUSTMENT "Border width" '( 1 0 5 1 1 0 1 )
  SF-COLOR "Border color" '(0 0 0)
  SF-OPTION "Date Position" '( "top-left" "top-center" "top-right" "left-center" "center" "right-center" "bottom-left" "bottom-center" "bottom-right")
  )
(script-fu-menu-register "script-fu-sg-calendar-year"
  "<Image>/Filters/Render"
  )
