; 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.
; Revision: January 2012 - added Hungarian translation (thanks to petrikp)
; January 2013 - added Russian translation (thanks to Leonid)
; January 2013 - Serbian, Croatian, Slovenian, Macedonian (thanks to Skynet)
; 'layout'
; 0 = Allow week 6
; 1 = Force week 6
; 2 = Wrap w6 to w1
; 3 = Wrap w6 to w5
(define sg-calendar-languages '("English" "German" "Italian" "Spanish"
"French" "Hungarian" "Polish" "Russian"
"Serbian latin" "Serbian cyrilic" "Croatian" "Slovenian"
"Macedonian" "Swedish") )
(define sg-calendar-months '( ("January" "February" "March" "April"
"May" "June" "July" "August"
"September" "October" "November" "December" )
; German
("Januar" "Februar" "März" "April"
"Mai" "Juni" "Juli" "August"
"September" "Oktober" "November" "Dezember" )
; Italian
("Gennaio" "Febbraio" "Marzo" "Aprile"
"Maggio" "Giugno" "Luglio" "Agosto"
"Settembre" "Ottobre" "Novembre" "Dicembre" )
; Spanish
("Enero" "Febrero" "Marzo" "Abril"
"Mayo" "Junio" "Julio" "Agosto"
"Septiembre" "Octubre" "Noviembre" "Diciembre" )
; French
("Janvier" "Février" "Mars" "Avril"
"Mai" "Juin" "Juillet" "Août"
"Septembre" "Octobre" "Novembre" "Décembre")
; Hungarian
("Január" "Február" "Március" "Április"
"Május" "Június" "Július" "Augusztus"
"Szeptember" "Október" "November" "December" )
; Polish
("Styczeń" "Luty" "Marzec" "Kwiecień"
"Maj" "Czerwiec" "Lipiec" "Sierpień"
"Wrzesień" "Październik" "Listopad" "Grudzień" )
; Russian
("Январь" "Февраль" "Март" "Апрель"
"Май" "Июнь" "Июль" "Август"
"Сентябрь" "Октябрь" "Ноябрь" "Декабрь" )
; Serbian latin
("Januar" "Februar" "Mart" "April"
"Maj" "Jun" "Jul" "Avgust"
"Septembar" "Oktobar" "Novembar" "Decembar")
; Serbian cyrillic
("Јануар" "Фебруар" "Март" "Април"
"Мај" "Јун" "Јул" "Август"
"Септембар" "Октобар" "Новембар" "Децембар")
; Croatian
("Siječanj" "Veljača" "Ožujak" "Travanj"
"Svibanj" "Lipanj" "Srpanj" "Kolovoz"
"Rujan" "Listopad" "Studeni" "Prosinac" )
; Slovenian
("Januar" "Februar" "Marec" "April"
"Maj" "Junij" "Julij" "Avgust"
"September" "Oktober" "November" "December")
; Macedonian
("Коложег" "Сечко" "Цутар" "Тревен"
"Косар" "Жетвар" "Златец" "Житар"
"Гроздобер" "Листопад" "Студен" "Снежник")
; Swedish
("Januari" "Februari" "Mars" "April"
"Maj" "Juni" "Juli" "Augusti"
"September" "Oktober" "November" "December" )
))
(define sg-calendar-weekdays '( ("Monday" "Tuesday" "Wednesday" "Thursday"
"Friday" "Saturday" "Sunday" )
; German
("Montag" "Dienstag" "Mittwoch" "Donnerstag"
"Freitag" "Samstag" "Sonntag" )
; Italian
("Lunedi" "Martedi" "Mercoledi" "Giovedi"
"Venerdi" "Sabato" "Domenica" )
; Spanish
("Lunes" "Martes" "Miercoles" "Jueves"
"Viernes" "Sabado" "Domingo" )
; French
("Lundi" "Mardi" "Mercredi" "Jeudi"
"Vendredi" "Samedi" "Dimanche" )
; Hungarian
("vasárnap" "hétfő" "kedd" "szerda"
"csütörtök" "péntek" "szombat" )
; Polish
("Poniedziałek" "Wtorek" "Środa" "Czwartek"
"Piątek" "Sobota" "Niedziela" )
; Russian
("Понедельник" "Вторник" "Среда" "Четверг"
"Пятница" "Суббота" "Воскресенье" )
; Serbian latin
("Ponedeljak" "Utorak" "Sreda" "Četvrtak"
"Petak" "Subota" "Nedelja")
; Serbian cyrillic
("Понедељак" "Уторак" "Среда" "Четвртак"
"Петак" "Субота" "Недеља")
; Croatian
("Ponedjeljak" "Utorak" "Srijeda" "Četvrtak"
"Petak" "Subota" "Nedjelja")
; Slovenian
("Ponedeljek" "Torek" "Sreda" "Četrtek"
"Petek" "Sobota" "Nedelja")
; Маcedonian
("Понеделник" "Вторник" "Среда" "Четврток"
"Петок" "Сабота" "Недела")
; Swedish
("Måndag" "Tisdag" "Onsdag" "Torsdag"
"Fredag" "Lördag" "Söndag")
))
;; Perform a crude search for the largest font that will fit within
;; the cell (this algorithm could be better!)
;
(define (sg-calendar-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) ) )
(define (script-fu-sg-calendar image drawable lang month year sunday? letters-in-day layout text-font number-font fontsize% justify? border border-color gravity)
;; 'leap-year' returns one if given year is a leap year, else zero
;
(define (leap-year yy)
(if (= (modulo yy 4) 0)
(if (or (> (modulo yy 100) 0) (= (modulo yy 400) 0))
1
0 )
0 ) )
;; Given a Gregorian date, the following computes the number of days that have elapsed since
;; March 1st, 0000. This date is chosen as an absolute reference
;; so that leap days occur at the "end of the year" (simplifying
;; calculations). For lack of a better name, I shall call this a
;; "martius date" after the Roman word for the month of March.
;
(define (gregorian->martius yy mm dd)
(set! mm (modulo (+ mm 9) 12))
(set! yy (- yy (truncate (/ mm 10))))
(inexact->exact (+ (trunc (* 365 yy))
(trunc (/ yy 4))
(- (trunc (/ yy 100)))
(trunc (/ yy 400))
(round (* mm 30.6)) dd -1 )) )
;; Given a Gregorian date, return the day of the week (0=Sunday, 1=Monday,...)
;
(define (day-of-week yy mm dd)
(modulo (+ (gregorian->martius yy mm dd) 3) 7) )
;; The following converts from an absolute number of days since
;; March 1st, 0000 (i.e., a "martius date") to a Gregorian date
;; A list is returned containing '(year month day)
;
(define (martius->gregorian mdays)
(let* ((yy 0)
(mm 0)
(mi 0)
(dd 0) )
(set! yy (truncate (+ (/ mdays 365.2425) (/ 1.4780 365.2425))))
(set! dd (- mdays (truncate (* yy 365.2425))))
(when (< dd 0)
(set! yy (- yy 1))
(set! dd (- mdays (truncate (* yy 365.2425)))) )
(set! mi (inexact->exact (truncate (/ (+ 0.52 dd) 30.60))))
(set! mm (+ (modulo (+ mi 2) 12) 1))
(set! yy (+ yy (truncate (/ (+ mi 2) 12))))
(set! dd (+ (- dd (round (* mi 30.6))) 1))
(list yy mm dd) ) )
;; Create a list of floats evenly distributed between start and end
;
(define (algebraic-prog start end elements)
(let ((elements (inexact->exact elements))
(incr (if (zero? start)
(/ end (- elements 1))
(/ (- (/ end start) 1) (- elements 1)) ) ) )
(let
loop ((cnt (- elements 1))
(lis (if (zero? start)
'(0)
'(1) ) ) )
(if (zero? cnt)
(if (zero? start)
(reverse lis)
(map * (reverse lis) (make-list elements start)) )
(loop (- cnt 1) (cons (+ (car lis) incr) lis)) ) ) ) )
;; Create a frame layer for a cell
;
(define (create-cell-frame x y w h)
(let* ((frame-layer (car (gimp-layer-new image
w h
RGBA-IMAGE "Cell #1"
100 NORMAL-MODE ))) )
(gimp-drawable-fill frame-layer TRANSPARENT-FILL)
(gimp-image-add-layer image frame-layer -1)
(gimp-layer-set-offsets frame-layer x y)
(gimp-rect-select image (+ x border) (+ y border) (- w (* 2 border)) (- h (* 2 border)) CHANNEL-OP-REPLACE FALSE 0)
(gimp-selection-invert image)
(gimp-context-set-background border-color)
(gimp-edit-fill frame-layer BACKGROUND-FILL)
(gimp-selection-none image)
frame-layer ) )
;; Create the text layer for a cell-frame
;
(define (create-cell-text text font fontsize gravity frame-layer)
(let* ((text-layer (car (gimp-text-fontname image -1
0 0
text (* 2 border)
TRUE fontsize
PIXELS font )))
(x-align 0)
(y-align 0) )
(if (or (= gravity 0) (= gravity 1) (= gravity 2))
(set! y-align -1)
(when (or (= gravity 6) (= gravity 7) (= gravity 8))
(set! y-align 1) ) )
(if (or (= gravity 0) (= gravity 3) (= gravity 6))
(set! x-align -1)
(when (or (= gravity 2) (= gravity 5) (= gravity 8))
(set! x-align 1) ) )
(fu-align-layers frame-layer text-layer x-align y-align)
text-layer
)
)
;; align layer(s) with a base-layer (layers can be either a single layer or a list of layers)
;; vert-align and horiz-align
;; -1 = LEFT, 0 = CENTER, 1 = RIGHT
;
(define (fu-align-layers base-layer layers vert-align horiz-align)
(let* ((anchor-x (car (gimp-drawable-offsets base-layer)))
(anchor-y (cadr (gimp-drawable-offsets base-layer)))
(width (car (gimp-drawable-width base-layer)))
(height (car (gimp-drawable-height base-layer))) )
(unless (pair? layers)
(set! layers (list layers)) )
(if (>= vert-align 0)
(if (= vert-align 0)
(set! anchor-x (+ anchor-x (/ width 2)))
(set! anchor-x (+ anchor-x width)) ) )
(if (>= horiz-align 0)
(if (= horiz-align 0)
(set! anchor-y (+ anchor-y (/ height 2)))
(set! anchor-y (+ anchor-y height)) ) )
(while (pair? layers)
(let* (
(layer (car layers))
(ref-x (car (gimp-drawable-offsets layer)))
(ref-y (cadr (gimp-drawable-offsets layer)))
(orig-x ref-x)
(orig-y ref-y)
(offset-x 0)
(offset-y 0)
)
(set! width (car (gimp-drawable-width layer)))
(set! height (car (gimp-drawable-height layer)))
(if (>= vert-align 0)
(if (= vert-align 0)
(set! ref-x (+ ref-x (/ width 2)))
(set! ref-x (+ ref-x width))
)
)
(if (>= horiz-align 0)
(if (= horiz-align 0)
(set! ref-y (+ ref-y (/ height 2)))
(set! ref-y (+ ref-y height))
)
)
(set! offset-x (+ orig-x (- anchor-x ref-x)))
(set! offset-y (+ orig-y (- anchor-y ref-y)))
(gimp-layer-set-offsets layer offset-x offset-y)
)
(set! layers (cdr layers))
)
)
)
;; return a list of visible layers
;
(define (fu-get-visible-layers image)
(let loop ((layers (vector->list (cadr (gimp-image-get-layers image))))
(viewables nil) )
(if (null? layers)
(if (null? viewables)
'()
(reverse viewables) )
(loop (cdr layers)
(if (zero? (car (gimp-drawable-get-visible (car layers))))
viewables
(cons (car layers) viewables) ) ) ) ) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main definition starts here ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let* ((bg-layer 0)
(x1 0)
(x2 0)
(y1 0)
(y2 0)
(X's '())
(Y's '())
(x's '())
(y's '())
(row 0)
(total-rows 6)
(col 0)
(text-fontsize 6)
(number-fontsize 6)
(firstday (day-of-week year (+ month 1) 1))
(days-in-month (vector 31 (+ 28 (leap-year year)) 31 30 31 30 31 31 30 31 30 31))
(i 0)
(frames nil)
(frame-layer 0)
(cal-days nil)
(dates-layer 0)
(visibles '())
(buffer "")
(layers nil)
(orig-bg (car (gimp-context-get-background)))
(orig-sel 0)
(months (list->vector (list-ref sg-calendar-months lang)))
(weekday-strings (list->vector (map (lambda (x)
(substring x
0
(min (+ letters-in-day 1)
(string-length x) ) ) )
(list-ref sg-calendar-weekdays lang) )))
)
(gimp-context-push)
(gimp-image-undo-group-start image)
(set! orig-sel (car (gimp-selection-save image)))
(set! buffer (car (gimp-edit-named-copy drawable "buffer")))
(set! bg-layer (car (gimp-edit-named-paste drawable buffer FALSE)))
(gimp-floating-sel-to-layer bg-layer)
(gimp-buffer-delete buffer)
(let loop ((pos (- (car (gimp-image-get-layer-position image drawable)) 1)))
(if (zero? pos)
#t
(begin
(gimp-image-lower-layer image bg-layer)
(loop (- pos 1)) )))
(set! x1 (+ border (car (gimp-drawable-offsets bg-layer))))
(set! x2 (- (+ x1 (car (gimp-drawable-width bg-layer))) (* 2 border)))
(set! y1 (+ border (cadr (gimp-drawable-offsets bg-layer))))
(set! y2 (- (+ y1 (car (gimp-drawable-height bg-layer))) (* 2 border)))
(set! X's (map round (algebraic-prog x1 x2 8)))
(set! Y's (map round (algebraic-prog y1 y2 7))) ;; 1 row for header + five rows for weeks
(set! x's X's)
(set! y's Y's)
(set! visibles (fu-get-visible-layers image))
(set! months (list->vector (list-ref sg-calendar-months lang)))
(set! weekday-strings (list->vector (map (lambda (x)
(substring x
0
(min (+ letters-in-day 1)
(string-length x) ) ) )
(list-ref sg-calendar-weekdays lang) )))
(unless (= sunday? TRUE)
(set! firstday (modulo (- firstday 1) 7))
)
(when (or (= layout 1) (and (= layout 0) (> (+ firstday (vector-ref days-in-month month)) 35)))
(set! Y's (map round (algebraic-prog y1 y2 8))) ;; 1 row for header + six rows for weeks
(set! y's Y's)
(set! total-rows 7)
)
;; Add header row with day labels
;; Determine fontsize for days
(set! text-fontsize (apply min (map (lambda (text)
(sg-calendar-calc-fontsize text
text-font
80
(- (cadr X's) (car X's) (* 2 border))
(- (cadr Y's) (car Y's) (* 2 border)) ) )
(vector->list weekday-strings) ) ) )
(gimp-progress-update (/ 1 (* total-rows 7)))
(set! x's X's)
(while (< i 7)
(set! frames (cons (create-cell-frame (car x's) ; cell upper-left x
(car y's) ; cell upper-left y
(round (- (cadr x's) (car x's))) ; width
(round (- (cadr y's) (car y's)))) ; height
frames))
(set! cal-days (cons (create-cell-text (vector-ref weekday-strings (modulo (- i sunday? ) 7))
text-font
text-fontsize
7 ;; center text in cell
(car frames))
cal-days ))
(set! i (+ i 1))
(gimp-progress-update (/ (+ i 1) (* total-rows 7)))
(set! x's (cdr x's))
)
(set! row (+ row 1))
(set! y's (cdr y's))
(set! x's X's)
(set! i 0)
;; Determine fontsize for numbers
(if (< fontsize% 80)
(set! number-fontsize (sg-calendar-calc-fontsize "30" number-font fontsize% (- (cadr X's) (car X's) (* 4 border)) (- (cadr Y's) (car Y's) (* 4 border))))
(set! number-fontsize (sg-calendar-calc-fontsize "30" number-font fontsize% (- (cadr X's) (car X's) (* 2 border)) (- (cadr Y's) (car Y's) (* 2 border))))
)
;; create grid of "cells"
;; grid contains cells for the days
;; Each cell has a transparent layer with optional border and
;; valid days have a text layer holding the day number.
;; the day of the month is "0" if cell is not in month
;;
(if (= layout 2)
(while (> (- (+ firstday (vector-ref days-in-month month)) i) 35)
(set! frames (cons (create-cell-frame (car x's) ; cell upper-left x
(car y's) ; cell upper-left y
(round (- (cadr x's) (car x's))) ; width
(round (- (cadr y's) (car y's)))) ; height
frames))
(let* (
(date (+ (- 36 firstday) i))
(date-str (number->string date))
)
(set! cal-days (cons (create-cell-text date-str number-font number-fontsize gravity (car frames)) cal-days))
)
(set! i (+ i 1))
(gimp-progress-update (/ (+ i 8) (* total-rows 7)))
(set! x's (cdr x's))
(set! col (+ col 1))
)
)
(let* (
(bindle-x (car x's))
)
(while (< i firstday)
(set! i (+ i 1))
(gimp-progress-update (/ (+ i 8) (* total-rows 7)))
(set! x's (cdr x's))
)
(unless (= i col)
(set! frames (cons (create-cell-frame bindle-x ; cell upper-left x
(car y's) ; cell upper-left y
(round (- (car x's) bindle-x)) ; width
(round (- (cadr y's) (car y's)))) ; height
frames))
(set! col i)
)
)
(while (< row total-rows)
(while (and (< col 7) (< i (+ (vector-ref days-in-month month) firstday)))
(set! frames (cons (create-cell-frame (car x's) ; cell upper-left x
(car y's) ; cell upper-left y
(round (- (cadr x's) (car x's))) ; width
(round (- (cadr y's) (car y's)))) ; height
frames))
(let* (
(date (+ (- i firstday) 1))
(date-str (if (and (= justify? TRUE) (< date 10))
(string-append " " (number->string date))
(number->string date)))
(double-day 0)
(cal-day 0)
)
(set! cal-day (create-cell-text date-str number-font number-fontsize gravity (car frames)))
(if (= layout 3) ;; if needed, squeeze two dates into text cell (e.g., 23/30, 24/31)
(when (and (> (+ firstday (vector-ref days-in-month month)) 35)
(= row 5)
(<= (+ date 7) (vector-ref days-in-month month)))
(gimp-edit-clear cal-day)
(set! double-day (create-cell-text date-str number-font (* number-fontsize 0.5) 0 cal-day))
(set! cal-day (car (gimp-image-merge-down image double-day EXPAND-AS-NECESSARY)))
(set! double-day (create-cell-text (number->string (+ date 7)) number-font (* number-fontsize 0.5) 8 cal-day))
(set! cal-day (car (gimp-image-merge-down image double-day EXPAND-AS-NECESSARY)))
)
)
(set! cal-days (cons cal-day cal-days))
)
(set! i (+ i 1))
(gimp-progress-update (/ (+ i 8) (* total-rows 7)))
(set! x's (cdr x's))
(set! col (+ col 1))
)
(unless (or (< i (+ (vector-ref days-in-month month) firstday)) (= col 7))
(let* (
(bindle-x (car x's))
)
(while (< col 7)
(set! i (+ i 1))
(set! x's (cdr x's))
(set! col (+ col 1))
)
(set! frames (cons (create-cell-frame bindle-x ; cell upper-left x
(car y's) ; cell upper-left y
(round (- (car x's) bindle-x)) ; width
(round (- (cadr y's) (car y's)))) ; height
frames))
(set! i (+ i 1))
(set! x's (cdr x's))
(set! col (+ col 1))
(if (= col 7)
(set! col 0)
)
)
)
(set! row (+ row 1))
(set! col 0)
(set! x's X's)
(set! y's (cdr y's))
)
(gimp-image-set-active-layer image bg-layer)
(set! frame-layer (car (gimp-layer-new-from-drawable bg-layer image)))
(gimp-image-add-layer image frame-layer -1)
(gimp-layer-add-alpha frame-layer)
(gimp-selection-none image)
(gimp-edit-clear frame-layer)
(gimp-context-set-background border-color)
(gimp-rect-select image x1 y1 (round (- x2 x1)) (round (- y2 y1)) CHANNEL-OP-REPLACE FALSE 0)
(gimp-selection-invert image)
(unless (= border 0)
(gimp-edit-fill frame-layer BACKGROUND-FILL)
)
(map (lambda (x) (gimp-drawable-set-visible x FALSE)) visibles)
(map (lambda (x) (gimp-drawable-set-visible x FALSE)) cal-days)
(set! frame-layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
(gimp-drawable-set-visible frame-layer FALSE)
(map (lambda (x) (gimp-drawable-set-visible x TRUE)) cal-days)
(set! dates-layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
(gimp-layer-resize dates-layer
(car (gimp-drawable-width frame-layer))
(car (gimp-drawable-height frame-layer))
(- (car (gimp-drawable-offsets dates-layer)) (car (gimp-drawable-offsets frame-layer)))
(- (cadr (gimp-drawable-offsets dates-layer)) (cadr (gimp-drawable-offsets frame-layer))))
(map (lambda (x) (gimp-drawable-set-visible x TRUE)) visibles)
(gimp-drawable-set-visible frame-layer TRUE)
(gimp-drawable-set-name dates-layer (string-append (vector-ref months month) ", " (number->string year)))
(gimp-drawable-set-name frame-layer (vector-ref months month))
(gimp-context-set-background orig-bg)
(gimp-progress-update 1)
(gimp-displays-flush)
(gimp-context-pop)
(gimp-selection-load orig-sel)
(gimp-image-remove-channel image orig-sel)
(gimp-image-remove-layer image bg-layer)
(gimp-image-set-active-layer image drawable)
(gimp-image-undo-group-end image)
(list dates-layer frame-layer)
)
)
(define (script-fu-sg-calendar-year orig-image orig-drawable
lang
year
start-month
end-month
num-cols
padding
sunday? letters-in-day layout text-font number-font fontsize% justify? border border-color gravity)
(define (algebraic-prog start end elements)
(let ((elements (inexact->exact elements))
(incr (if (zero? start)
(/ end (- elements 1))
(/ (- (/ end start) 1) (- elements 1)) ) ) )
(let
loop ((cnt (- elements 1))
(lis (if (zero? start)
'(0)
'(1) ) ) )
(if (zero? cnt)
(if (zero? start)
(reverse lis)
(map * (reverse lis) (make-list elements start)) )
(loop (- cnt 1) (cons (+ (car lis) incr) lis)) ) ) ) )
; adjust input parameter so january is now first month
; Remember: december was first in the SF-OPTION list so that
; the default setting would be Jan to Dec
(set! end-month (modulo (pred end-month) 12))
(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 (= (car (gimp-selection-is-empty orig-image)) TRUE)
(set! bounds (cdr bounds))
(set! orig-x (+ orig-x (car bounds)))
(set! orig-y (+ 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* ((num-months (succ (modulo (- end-month start-month) 12)))
(num-cols (min (truncate num-cols) num-months))
(width (car (gimp-drawable-width layer)))
(height (car (gimp-drawable-height layer)))
(x 0)
(y 0)
(w (floor (/ width num-cols)))
(num-rows (ceiling (/ num-months num-cols)))
(h (floor (/ height num-rows)))
(w-sel (/ (- width (* width padding 0.01)) num-cols))
(h-sel w-sel) ; assume square month initially
(x-offsets '())
(y-offsets '())
(temp-layer 0)
(month-index 0)
(month-fontsize 6)
(extents '()) )
(when (< h (+ h-sel (* h-sel padding 0.01))) ; shrink month height to make room for banner
(set! h-sel (- h (* h padding 0.009))) ; increase vertical padding a bit
(set! w-sel h-sel) ; re-calculate horizontal layout
)
(set! month-fontsize (apply min (map (lambda (text)
(sg-calendar-calc-fontsize text text-font 100 w-sel (- h h-sel)) )
(list-ref sg-calendar-months lang) )))
(set! y (+ (cadr (gimp-text-get-extents-fontname (car (list-ref sg-calendar-months lang))
month-fontsize
PIXELS
text-font ))
2) )
(set! y-offsets (if (> num-rows 1)
(map truncate (algebraic-prog y (- height h-sel) num-rows))
(list y) ))
(while (pair? y-offsets)
(set! x-offsets (if (> num-cols 1)
(map truncate (algebraic-prog 0 (- width w-sel) num-cols))
(list (/ (- width w-sel) 2)) ))
(while (and (pair? x-offsets) (< month-index num-months))
(set! x (car x-offsets))
(set! y (car y-offsets))
(gimp-rect-select image x y w-sel h-sel 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)
(let ((month (modulo (+ start-month month-index) 12)))
(script-fu-sg-calendar image temp-layer lang month year sunday?
letters-in-day layout text-font number-font
fontsize% justify? border border-color gravity)
(gimp-image-remove-layer image temp-layer)
(set! extents (gimp-text-get-extents-fontname (list-ref (list-ref sg-calendar-months lang) month)
month-fontsize
PIXELS
text-font ))
(set! temp-layer (car (gimp-text-fontname image -1
(+ x (/ (- w-sel (car extents)) 2))
(- y (cadr extents) (/ (cadddr extents) -2))
(list-ref (list-ref sg-calendar-months lang) month)
0 TRUE
month-fontsize PIXELS text-font ))))
(set! x-offsets (cdr x-offsets))
(set! month-index (succ month-index)) )
(set! y-offsets (cdr y-offsets)) ) )
;; 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"
"Calendar..."
"Generate a calendar overlay for current layer"
"Saul Goode"
"Saul Goode"
"10/26/09, updated Jan 2012"
"RGB*,GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-OPTION "Language" sg-calendar-languages
SF-OPTION "Month" (car sg-calendar-months)
SF-ADJUSTMENT "Year" '( 2013 1753 2050 1 10 0 1 )
SF-TOGGLE "Sunday first" TRUE
SF-OPTION "Day format" '("S M T ..." "Su Mo Tu ..." "Sun Mon Tue ...")
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 "Text font" "Sans"
SF-FONT "Number 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"
"<Image>/Filters/Render"
)
(script-fu-register "script-fu-sg-calendar-year"
"Calendar year..."
"Generate a calendar for current layer"
"Saul Goode"
"Saul Goode"
"Dec 2010, updated Jan 2012"
"RGB*,GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
SF-OPTION "Language" sg-calendar-languages
SF-ADJUSTMENT "Year" '( 2013 1753 2050 1 10 0 1 )
SF-OPTION "Start Month" (car sg-calendar-months)
SF-OPTION "End Month" (cons (car (last (car sg-calendar-months))) (butlast (car sg-calendar-months)))
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 "Day format" '("S M T ..." "Su Mo Tu ..." "Sun Mon Tue ...")
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 "Text font" "Sans"
SF-FONT "Number 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"
)