; 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.
;; Unfortunately, we can't guarantee what order the scripts will loaded,
;; so we must replicate the following language translations defined in
;; sg-calendar.scm.
(define sg-calendar-languages '("English" "German" "Italian" "Spanish"
"French" "Hungarian" "Polish" "Russian"
"Serbian latin" "Serbian cyrilic" "Croatian" "Slovenian"
"Macedonian" "Swedish" "Catalan") )
;; Each of the following translations are comprised of a list of:
;; (months) (days) (day-abbreviations)
;; If the day-abbreviations is #f then the letters-in-day parameter is
;; used to generate the abbreviation from the full day name.
;;
;; Languages appear in the order that they were contributed.
;;
(define sg-calendar-translations
'(( ; "English"
("January" "February" "March" "April"
"May" "June" "July" "August"
"September" "October" "November" "December")
("Monday" "Tuesday" "Wednesday" "Thursday"
"Friday" "Saturday" "Sunday")
#f)
( ; "German"
("Januar" "Februar" "März" "April"
"Mai" "Juni" "Juli" "August"
"September" "Oktober" "November" "Dezember")
("Montag" "Dienstag" "Mittwoch" "Donnerstag"
"Freitag" "Samstag" "Sonntag")
#f)
( ; "Italian"
("Gennaio" "Febbraio" "Marzo" "Aprile"
"Maggio" "Giugno" "Luglio" "Agosto"
"Settembre" "Ottobre" "Novembre" "Dicembre")
("Lunedi" "Martedi" "Mercoledi" "Giovedi"
"Venerdi" "Sabato" "Domenica")
#f)
( ; "Spanish"
("Enero" "Febrero" "Marzo" "Abril"
"Mayo" "Junio" "Julio" "Agosto"
"Septiembre" "Octubre" "Noviembre" "Diciembre")
("Lunes" "Martes" "Miercoles" "Jueves"
"Viernes" "Sabado" "Domingo")
#f)
( ; "French"
("Janvier" "Février" "Mars" "Avril"
"Mai" "Juin" "Juillet" "Août"
"Septembre" "Octobre" "Novembre" "Décembre")
("Lundi" "Mardi" "Mercredi" "Jeudi"
"Vendredi" "Samedi" "Dimanche")
#f)
( ; "Hungarian"
("Január" "Február" "Március" "Április"
"Május" "Június" "Július" "Augusztus"
"Szeptember" "Október" "November" "December")
("vasárnap" "hétfő" "kedd" "szerda"
"csütörtök" "péntek" "szombat")
#f)
( ; "Polish"
("Styczeń" "Luty" "Marzec" "Kwiecień"
"Maj" "Czerwiec" "Lipiec" "Sierpień"
"Wrzesień" "Październik" "Listopad" "Grudzień")
("Poniedziałek" "Wtorek" "Środa" "Czwartek"
"Piątek" "Sobota" "Niedziela")
#f)
( ; "Russian"
("Январь" "Февраль" "Март" "Апрель"
"Май" "Июнь" "Июль" "Август"
"Сентябрь" "Октябрь" "Ноябрь" "Декабрь")
("Понедельник" "Вторник" "Среда" "Четверг"
"Пятница" "Суббота" "Воскресенье")
#f)
( ; "Serbian latin"
("Januar" "Februar" "Mart" "April"
"Maj" "Jun" "Jul" "Avgust"
"Septembar" "Oktobar" "Novembar" "Decembar")
("Ponedeljak" "Utorak" "Sreda" "Četvrtak"
"Petak" "Subota" "Nedelja")
#f)
( ; "Serbian cyrilic"
("Јануар" "Фебруар" "Март" "Април"
"Мај" "Јун" "Јул" "Август"
"Септембар" "Октобар" "Новембар" "Децембар")
("Понедељак" "Уторак" "Среда" "Четвртак"
"Петак" "Субота" "Недеља")
#f)
( ; "Croatian"
("Siječanj" "Veljača" "Ožujak" "Travanj"
"Svibanj" "Lipanj" "Srpanj" "Kolovoz"
"Rujan" "Listopad" "Studeni" "Prosinac")
("Ponedjeljak" "Utorak" "Srijeda" "Četvrtak"
"Petak" "Subota" "Nedjelja")
#f)
( ; "Slovenian"
("Januar" "Februar" "Marec" "April"
"Maj" "Junij" "Julij" "Avgust"
"September" "Oktober" "November" "December")
("Ponedeljek" "Torek" "Sreda" "Četrtek"
"Petek" "Sobota" "Nedelja")
#f)
( ; "Macedonian"
("Коложег" "Сечко" "Цутар" "Тревен"
"Косар" "Жетвар" "Златец" "Житар"
"Гроздобер" "Листопад" "Студен" "Снежник")
("Понеделник" "Вторник" "Среда" "Четврток"
"Петок" "Сабота" "Недела")
#f)
( ; "Swedish"
("Januari" "Februari" "Mars" "April"
"Maj" "Juni" "Juli" "Augusti"
"September" "Oktober" "November" "December")
("Måndag" "Tisdag" "Onsdag" "Torsdag"
"Fredag" "Lördag" "Söndag")
#f)
( ; "Catalan"
("Gener" "Febrer" "Març" "Abril"
"Maig" "Juny" "Juliol" "Agost"
"Setembre" "Octubre" "Novembre" "Desembre")
("Dilluns" "Dimarts" "Dimecres" "Dijous"
"Divendres" "Dissabte" "Diumenge")
("DL" "DT" "DC" "DJ" "DV" "DS" "DG"))
))
(define (script-fu-sg-platonic-calendar edge-length
ym-layout ; 0 = under, 1=year-month, 2=month-year, 3=equal, 4=lg month, 5=lg yr
; the following are common to script-fu-sg-calendar
lang year sunday? letters-in-day
layout text-font number-font font-size%
justify? gravity
use-facet-image facet-image)
(define (deg->rad x)
(/ (* x *pi*) 180) )
(define (rad->deg x)
(/ (* x 180) *pi*) )
; polar to rectangular
; Returns a pair (x . y)
;
(define (p->r rad ang)
(cons (* rad (cos (/ ang (/ 180 *pi*))))
(* rad (sin (/ ang (/ 180 *pi*)))) ))
; return a list of pairs containing the anchor points of a path's stroke
; For example, ((x0 . y0) (x1 . y1) (x2 . y2) (x3 . y3) (x4 . y4))
; If stroke is not supplied then first stroke is assumed
;
(define (get-anchors path . stroke)
(let ((stroke (if (null? stroke)
(vector-ref (cadr (gimp-vectors-get-strokes path)) 0)
(car stroke) )))
(let loop ((points (vector->list (caddr (gimp-vectors-stroke-get-points path stroke))))
(anchors '()) )
(if (null? points)
(if (null? anchors)
'()
(reverse anchors) )
(loop (cdddr (cdddr points))
(cons (cons (cadr (cdddr points)) (cadr points)) anchors) )))))
; Reverse the direction of a path's polygonal stroke. Works by creating
; a new (reversed) stroke and removing the original.
; Returns the new stroke.
; If stroke is not supplied then first stroke is assumed.
;
(define (reverse-pent path . stroke)
(let* ((stroke (if (null? stroke)
(vector-ref (cadr (gimp-vectors-get-strokes path)) 0)
(car stroke) ))
(anchors (get-anchors path stroke))
(new-stroke 0) )
; mangle list order because strokes are built in reverse order
(set! anchors (reverse (append (list (car anchors)) (reverse (cdr anchors)))))
(set! new-stroke (car (gimp-vectors-bezier-stroke-new-moveto path
(caar anchors)
(cdar anchors) )))
(gimp-vectors-remove-stroke path stroke)
(let loop ((anchors (cdr anchors)))
(if (null? anchors)
new-stroke
(begin
(gimp-vectors-bezier-stroke-lineto path new-stroke (caar anchors) (cdar anchors))
(loop (cdr anchors)) )))))
; For debugging only
; (define (print-points path)
; (let* ((stroke (vector-ref (cadr (gimp-vectors-get-strokes path)) 0)))
; (display (gimp-vectors-stroke-get-points path stroke)) ))
; Create a new pentagon (a polygonal path with five anchor points)
; xya is a list containing the x and y coordinates, and the angle (in degrees) of the first edge
; Returns the path ID of the created pentagon.
; Note: the name of the month pentagrams is their numeric index (Jan=0, Feb=1, Mar=2,...)
; Note to programmers: the bezier-stroke-line-to routine prepends new points to
; the start of the stroke!
;
(define (make-pent image name xya)
(let* ((path (car (gimp-vectors-new image name)))
(stroke 0)
(x (car xya))
(y (cadr xya))
(banner-angle (caddr xya))
(points (list (cons x y))) )
(gimp-image-add-vectors image path 0)
(let loop ((count 4)
(x (+ x (car (p->r edge-length banner-angle))))
(y (+ y (cdr (p->r edge-length banner-angle))))
(angle 72) )
(if (zero? count)
points
(begin
(set! points (cons (cons x y) points))
(loop (- count 1)
(+ x (car (p->r edge-length (+ banner-angle angle))))
(+ y (cdr (p->r edge-length (+ banner-angle angle))))
(modulo (+ angle 72) 360) ))))
(set! stroke (car (gimp-vectors-bezier-stroke-new-moveto path (caar points) (cdar points))))
(set! points (cdr points))
(while (pair? points)
(gimp-vectors-bezier-stroke-lineto path stroke (caar points) (cdar points))
(set! points (cdr points)) )
(gimp-vectors-stroke-close path stroke)
path ))
; pent-ref returns a list containing the starting xy coords and angle (in degrees) of
; the nth path segment. (This list can then be passed to make-pent.)
; (x y angle)
;
(define (pent-ref pent index)
(let* ((points (get-anchors pent))
(x0 (car (list-ref points index)))
(y0 (cdr (list-ref points index)))
(x1 (car (list-ref points (modulo (+ index 1) 5))))
(y1 (cdr (list-ref points (modulo (+ index 1) 5))))
(ang (atan (- y1 y0) (- x1 x0))) )
(list x0
y0
(* 180 ang (/ *pi*)) )))
; Renders rotated month calendar calendar within the pentagons of their associated
; month. The path's name is the index of the month (Jan=0, Feb=1, Mar=2,...)
;
(define (make-months target-layer pents)
(let* ((pent (car pents))
(month-image (car (gimp-image-new edge-length (ceiling (/ (* edge-length 7) 6)) RGB)))
(month-layer (car (gimp-layer-new month-image
edge-length edge-length
RGBA-IMAGE "tmp" 100 NORMAL-MODE )))
(xya (pent-ref pent 0))
(buffer "")
(floated 0)
(month (string->number (car (gimp-vectors-get-name pent)))) ; path name = month (0-11)
(month-name (list-ref (car (list-ref sg-calendar-translations lang)) month))
(year-name (number->string year))
(date-layer 0)
(month-text-layer 0) ; layer for month banner
(year-text-layer 0) ; layer for year banner
(y/m-ratio (cond
((= 4 ym-layout) 0.35)
((= 5 ym-layout) 0.60)
(else 0.50) ))
(month-size 0)
(year-size 0)
(banner-height 0)
(banners (map (lambda (x) (list-ref (list-ref sg-calendar-months lang)
(string->number (car (gimp-vectors-get-name x))) ))
pents )) )
; Render first month so that size banner and footer can be determined.
(gimp-image-add-layer month-image month-layer 0)
(gimp-drawable-fill month-layer TRANSPARENT-FILL)
(gimp-layer-set-offsets month-layer 0 (- (car (gimp-image-height month-image))
(car (gimp-drawable-height month-layer)) ))
(set! date-layer (car (script-fu-sg-calendar month-image
month-layer
lang
month
year
sunday? ; Sunday first
letters-in-day
layout ; (0=allow 6, 1=force 6, 2=wrap to w1, 3=wrap to w5)
text-font
number-font
font-size% ; text size as % of cell size
justify? ; right justify single-digit numbers
0 ; no borders
'(0 0 0) ; border color (ignored)
gravity )))
(gimp-image-set-active-layer month-image date-layer)
(plug-in-autocrop-layer RUN-NONINTERACTIVE month-image date-layer)
(set! banner-height (cadr (gimp-drawable-offsets date-layer)))
; compute sizes of the year and month text based on layer
(if (< ym-layout 3)
(begin ; single line banner (one of "May", "2011 May", "May 2011" for example)
(unless (zero? ym-layout) ; "0" means year will be underneath calendar
(if (= 1 ym-layout)
(set! banners (map (lambda (x) (string-append year-name " " x)) banners))
(set! banners (map (lambda (x) (string-append x " " year-name)) banners)) ))
(set! month-size (apply min
(map (lambda (banner)
(sg-calendar-calc-fontsize banner
text-font
(if (zero? ym-layout) 90 100)
edge-length
banner-height ))
banners )))
(set! year-size month-size)
)
(begin ; year on top of month (either equal size, smaller, or larger than month text)
; ym-layout is vertical
(set! month-size (apply min
(map (lambda (banner)
(sg-calendar-calc-fontsize banner
text-font
100
edge-length
(truncate (* banner-height (- 1 y/m-ratio))) ))
banners )))
(set! year-size (sg-calendar-calc-fontsize year-name
text-font
100
edge-length
(truncate (* banner-height y/m-ratio)) ))))
(while (pair? pents)
(if (< ym-layout 3)
(begin ; single line of banner text above calendar
(set! month-text-layer (car (gimp-text-fontname month-image -1
0 0 (car banners) 0 TRUE month-size PIXELS text-font )))
(gimp-image-set-active-layer month-image month-text-layer)
(plug-in-autocrop-layer RUN-NONINTERACTIVE month-image month-text-layer)
(gimp-layer-set-offsets month-text-layer
(/ (- edge-length (car (gimp-drawable-width month-text-layer))) 2) ; center horiz
(- (+ banner-height 2)
(/ (+ banner-height (car (gimp-drawable-height month-text-layer))) 2) ))
(when (zero? ym-layout) ; render year layer underneath calendar
(set! year-text-layer (car (gimp-text-fontname month-image -1 0 0 year-name 0 TRUE year-size PIXELS text-font)))
(gimp-layer-set-offsets year-text-layer
(/ (- edge-length (car (gimp-drawable-width year-text-layer))) 2)
(+ (ceiling (/ (* edge-length 7) 6))) )
(gimp-image-resize month-image
(car (gimp-image-width month-image))
(+ (car (gimp-drawable-height year-text-layer))
(cadr (gimp-drawable-offsets year-text-layer)) )
0
0 )))
(begin ; two lines of banner text above calendar (year over month)
(set! month-text-layer (car (gimp-text-fontname month-image -1
0 0 month-name 0 TRUE month-size PIXELS text-font )))
(gimp-image-set-active-layer month-image month-text-layer)
(plug-in-autocrop-layer RUN-NONINTERACTIVE month-image month-text-layer)
(gimp-layer-set-offsets month-text-layer
(/ (- edge-length (car (gimp-drawable-width month-text-layer))) 2) ; center horiz
(+ 2
(* banner-height y/m-ratio)
(/ (- (* banner-height (- 1 y/m-ratio))
(car (gimp-drawable-height month-text-layer))) 2) ))
(set! year-text-layer (car (gimp-text-fontname month-image -1
0 0
(number->string year)
0 TRUE year-size PIXELS text-font )))
(gimp-image-set-active-layer month-image year-text-layer)
(plug-in-autocrop-layer RUN-NONINTERACTIVE month-image year-text-layer)
(gimp-layer-set-offsets year-text-layer
(/ (- edge-length (car (gimp-drawable-width year-text-layer))) 2)
(+ 1
(/ (- (cadr (gimp-drawable-offsets month-text-layer))
(car (gimp-drawable-height year-text-layer)) )
2) ))))
(gimp-layer-resize-to-image-size month-layer)
(set! month-layer (car (gimp-image-merge-visible-layers month-image CLIP-TO-IMAGE)))
; now transfer the layer to 'image'
(set! buffer (car (gimp-edit-named-copy month-layer month-name)))
(set! floated (car (gimp-edit-named-paste target-layer buffer FALSE)))
(gimp-buffer-delete buffer)
(gimp-floating-sel-to-layer floated)
(gimp-layer-set-offsets floated (car xya) (cadr xya))
(gimp-drawable-transform-rotate floated
(deg->rad (caddr xya)) ; delta-y delta-x for end points
FALSE
(car xya) (cadr xya)
TRANSFORM-FORWARD
INTERPOLATION-CUBIC
TRUE 3 TRANSFORM-RESIZE-ADJUST )
(gimp-drawable-set-name floated month-name)
(set! pents (cdr pents))
(set! banners (cdr banners))
(unless (null? pents)
(set! pent (car pents))
(set! month (string->number (car (gimp-vectors-get-name pent))))
(set! month-name (list-ref (list-ref sg-calendar-months lang) month ))
(set! xya (pent-ref pent 0))
(gimp-image-delete month-image)
(set! month-image (car (gimp-image-new edge-length (ceiling (/ (* edge-length 7) 6)) RGB)))
(set! month-layer (car (gimp-layer-new month-image
edge-length edge-length
RGBA-IMAGE "tmp" 100 NORMAL-MODE )))
(gimp-image-add-layer month-image month-layer 0)
(gimp-layer-set-offsets month-layer 0 (- (car (gimp-image-height month-image))
(car (gimp-drawable-height month-layer)) ))
(gimp-drawable-fill month-layer TRANSPARENT-FILL)
(set! date-layer (car (script-fu-sg-calendar month-image
month-layer
lang
month
year
sunday? ; Sunday first
letters-in-day
layout ; (0=allow 6, 1=force 6, 2=wrap to w1, 3=wrap to w5)
text-font
number-font
font-size% ; text size as % of cell size
justify? ; right justify single-digit numbers
0 ; no borders
'(0 0 0) ; border color (ignored)
gravity )))
(gimp-image-set-active-layer month-image date-layer)
(plug-in-autocrop-layer RUN-NONINTERACTIVE month-image date-layer)
(set! banner-height (* 0.9 (cadr (gimp-drawable-offsets date-layer)))) ))
(gimp-image-delete month-image)
)
)
; Renders a properly sized and rotated facet from the given facet image.
; If the facet image has more than one layer, those layers are
; "cycled through" bottom-to-top (repeated if necessary).
; If the source layer is not chain linked, it will be resized to fit
; the facet (centered); else the upper-left region of the layer is used.
;
(define (copy-facets target-image target-layer facet-image facets pents)
(let* ((x (ceiling (* edge-length (cos (deg->rad 72)))))
(width (+ 1 edge-length (* 2 x)))
(height (ceiling (+ 1 (* edge-length (+ (cos (deg->rad 18)) (sin (deg->rad 36)))))))
(image (car (gimp-image-new width height RGB)))
(layer (car (gimp-layer-new image width height RGB-IMAGE "target" 100 NORMAL-MODE)))
(frame (make-pent image "tmp" (list x 0 0)))
(xya '())
(buffer "")
(floated 0)
(tmp-layer 0)
(channel 0)
(new-facets '()) )
(gimp-image-undo-freeze facet-image)
(set! channel (car (gimp-selection-save facet-image)))
(gimp-selection-none facet-image)
(gimp-image-add-layer image layer 0)
(while (pair? pents)
(set! xya (pent-ref (car pents) 0))
(set! buffer (car (gimp-edit-named-copy (car facets) "tmp")))
(set! tmp-layer (car (gimp-edit-named-paste layer buffer FALSE)))
(gimp-buffer-delete buffer)
(gimp-floating-sel-to-layer tmp-layer)
(when (zero? (car (gimp-drawable-get-linked (car facets))))
(let* ((layer-width (car (gimp-drawable-width tmp-layer)))
(layer-height (car (gimp-drawable-height tmp-layer)))
(aspect (/ layer-height layer-width)) )
(if (> (/ width layer-width) (/ height layer-height))
(begin
(gimp-layer-scale-full tmp-layer
width
(* width aspect)
TRUE
INTERPOLATION-LANCZOS)
(gimp-layer-set-offsets tmp-layer 0 (/ (- height (* width aspect)) 2)) )
(begin
(gimp-layer-scale-full tmp-layer
(/ height aspect)
height
TRUE
INTERPOLATION-LANCZOS)
(gimp-layer-set-offsets tmp-layer (/ (- width (/ height aspect)) 2) 0) ))))
(gimp-vectors-to-selection frame CHANNEL-OP-REPLACE TRUE FALSE 0 0)
(set! buffer (car (gimp-edit-named-copy tmp-layer "tmp")))
(set! floated (car (gimp-edit-named-paste target-layer buffer FALSE)))
(gimp-buffer-delete buffer)
(gimp-floating-sel-to-layer floated)
(gimp-layer-set-offsets floated (- (car xya) x) (cadr xya))
(gimp-drawable-transform-rotate floated
(deg->rad (caddr xya)) ; delta-y delta-x for end points
FALSE
(+ (car xya) 0) (cadr xya)
TRANSFORM-FORWARD
INTERPOLATION-CUBIC
TRUE 3 TRANSFORM-RESIZE-ADJUST )
(gimp-drawable-set-name floated (car (gimp-drawable-get-name (car facets))))
(gimp-image-lower-layer-to-bottom target-image floated)
(gimp-image-raise-layer target-image floated)
(set! new-facets (cons floated new-facets))
(set! pents (cdr pents))
(set! facets (cdr facets))
)
(gimp-image-delete image)
(gimp-selection-load channel)
(gimp-image-remove-channel facet-image channel)
(gimp-image-undo-thaw facet-image)
new-facets
)
)
(define (make-tab image name pent)
(let* ((xya (append (butlast (pent-ref pent 2)) (cddr (pent-ref pent 1))))
(tab (car (gimp-vectors-new image name)))
(stroke 0) )
(gimp-image-add-vectors image tab 0)
(set! stroke (car (gimp-vectors-bezier-stroke-new-moveto tab (car xya) (cadr xya))))
(gimp-vectors-bezier-stroke-lineto tab
stroke
(+ (car xya) (car (p->r (/ edge-length 3) (caddr xya))))
(+ (cadr xya) (cdr (p->r (/ edge-length 3) (caddr xya)))) )
(set! xya (pent-ref pent 3))
(gimp-vectors-bezier-stroke-lineto tab
stroke
(- (car xya) (car (p->r (/ edge-length 3) (caddr xya))))
(- (cadr xya) (cdr (p->r (/ edge-length 3) (caddr xya)))) )
(gimp-vectors-bezier-stroke-lineto tab
stroke
(car xya)
(cadr xya) )
(set! xya (append (butlast (pent-ref pent 3)) (cddr (pent-ref pent 2))))
(gimp-vectors-bezier-stroke-lineto tab
stroke
(+ (car xya) (car (p->r (/ edge-length 3) (caddr xya))))
(+ (cadr xya) (cdr (p->r (/ edge-length 3) (caddr xya)))) )
(set! xya (pent-ref pent 4))
(gimp-vectors-bezier-stroke-lineto tab
stroke
(- (car xya) (car (p->r (/ edge-length 3) (caddr xya))))
(- (cadr xya) (cdr (p->r (/ edge-length 3) (caddr xya)))) )
(gimp-vectors-bezier-stroke-lineto tab
stroke
(car xya)
(cadr xya) )
tab ))
;; MAIN PROCEDURE STARTS HERE
(let* ((image 0) (bg-layer 0) (folds-layer 0)
(stroke 0)
(jan 0) (feb 0) (mar 0) (apr 0) (may 0) (jun 0)
(jul 0) (aug 0) (sep 0) (oct 0) (nov 0) (dec 0)
(ref 0) (tmp 0) (tab-mar 0) (tab-apr 0) (tab-may 0) (tab-jun 0)
(pents '())
(tabs '())
(xya '())
(facets '())
(text-layers '())
(facet-layers '())
(surface-layer 0)
(text-layer 0) )
(set! image (car (gimp-image-new (* 6 edge-length) (* 8 edge-length) RGB)))
(gimp-display-new image)
(gimp-image-undo-disable image)
(gimp-context-push)
(set! bg-layer (car (gimp-layer-new image
(car (gimp-image-width image))
(car (gimp-image-height image))
RGB-IMAGE
"Background"
100
NORMAL-MODE )))
(gimp-image-add-layer image bg-layer 0)
(gimp-drawable-fill bg-layer BACKGROUND-FILL)
(set! jan (make-pent image "0" (list (* 2.2 edge-length) (* 2.9 edge-length) 252)))
(set! ref (car (gimp-vectors-copy jan)))
(gimp-image-add-vectors image ref 0) ; not necessary
(gimp-vectors-set-name ref "ref")
(reverse-pent ref)
(set! feb (make-pent image "1" (pent-ref ref 0)))
(set! mar (make-pent image "2" (pent-ref ref 1)))
(set! apr (make-pent image "3" (pent-ref ref 2)))
(set! may (make-pent image "4" (pent-ref ref 3)))
(set! jun (make-pent image "5" (pent-ref ref 4)))
(gimp-image-remove-vectors image ref)
(set! ref (car (gimp-vectors-copy feb)))
(gimp-image-add-vectors image ref 0) ; not necessary
(gimp-vectors-set-name ref "ref")
(reverse-pent ref)
(set! tmp (make-pent image "tmp" (pent-ref ref 2)))
(gimp-image-remove-vectors image ref)
(set! ref (car (gimp-vectors-copy tmp)))
(gimp-image-remove-vectors image tmp)
(gimp-image-add-vectors image ref 0) ; not necessary
(gimp-vectors-set-name ref "ref")
(reverse-pent ref)
(set! dec (make-pent image "11" (pent-ref ref 1)))
(gimp-image-remove-vectors image ref)
(set! ref (car (gimp-vectors-copy dec)))
(gimp-image-add-vectors image ref 0) ; not necessary
(gimp-vectors-set-name ref "ref")
(reverse-pent ref)
(set! jul (make-pent image "6" (pent-ref ref 1)))
(set! aug (make-pent image "7" (pent-ref ref 2)))
(set! sep (make-pent image "8" (pent-ref ref 3)))
(set! oct (make-pent image "9" (pent-ref ref 4)))
(set! nov (make-pent image "10" (pent-ref ref 0)))
(gimp-image-remove-vectors image ref)
(set! pents (list jan feb mar apr may jun jul aug sep oct nov dec))
(set! tab-jun (make-tab image "tab-jun" jun))
(set! tabs (cons tab-jun tabs))
(set! tab-may (make-tab image "tab-may" may))
(set! tabs (cons tab-may tabs))
(set! tab-apr (make-tab image "tab-apr" apr))
(set! tabs (cons tab-apr tabs))
(set! tab-mar (make-tab image "tab-mar" mar))
(set! tabs (cons tab-mar tabs))
(make-months bg-layer pents)
(set! text-layers (butlast (vector->list (cadr (gimp-image-get-layers image)))))
(when (and (= use-facet-image TRUE) (= (car (gimp-image-is-valid facet-image)) TRUE))
(set! facets (vector->list (cadr (gimp-image-get-layers facet-image))))
(while (<= (length facets) 12)
(set! facets (append facets facets)) )
(set! facets (reverse (list-tail facets (- (length facets) 12))))
(copy-facets image bg-layer facet-image facets pents) )
(gimp-context-set-paint-method "gimp-paintbrush")
(gimp-context-set-foreground '(128 128 128))
(gimp-context-set-brush "Circle (01)")
(set! folds-layer (car (gimp-layer-new image
(car (gimp-image-width image))
(car (gimp-image-height image))
RGBA-IMAGE
"Folds"
100
NORMAL-MODE )))
(gimp-image-add-layer image folds-layer 0)
(gimp-drawable-fill folds-layer TRANSPARENT-FILL)
(map (lambda (path)
(gimp-edit-stroke-vectors folds-layer path))
(append tabs pents) )
(map (lambda (layer) (gimp-drawable-set-visible layer FALSE))
(vector->list (cadr (gimp-image-get-layers image))) )
(unless (null? facet-layers)
(map (lambda (layer) (gimp-drawable-set-visible layer TRUE))
facet-layers )
(set! surface-layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
(gimp-drawable-set-name surface-layer "All facets")
(gimp-layer-resize-to-image-size surface-layer)
(gimp-drawable-set-visible surface-layer FALSE) )
(map (lambda (layer) (gimp-drawable-set-visible layer TRUE))
text-layers )
(set! text-layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
(gimp-drawable-set-name text-layer "All text")
(gimp-layer-resize-to-image-size text-layer)
(map (lambda (layer) (gimp-drawable-set-visible layer TRUE))
(vector->list (cadr (gimp-image-get-layers image))) )
(gimp-image-set-active-layer image bg-layer)
(gimp-selection-none image)
(gimp-context-pop)
(gimp-image-undo-enable image)
(gimp-displays-flush)
)
)
(script-fu-register "script-fu-sg-platonic-calendar"
"Platonic calendar..."
"Generate a dodecahedron with a monthly calendar on each face"
"Saul Goode"
"Saul Goode"
"updated Jan 2012"
""
SF-ADJUSTMENT "Edge length" '(400 100 1500 1 10 0 1)
SF-OPTION "Banner format" '("Year at bottom" "Year then Month (horiz)" "Month then Year(horiz)"
"Year over Month equal size" "Large Month under Year" "Small Month under Year" )
SF-OPTION "Language" sg-calendar-languages
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)" '( 85 0 100 1 10 0 1)
SF-TOGGLE "Right Justify" TRUE
SF-OPTION "Date Position" '( "top-left" "top-center" "top-right" "left-center" "center" "right-center" "bottom-left" "bottom-center" "bottom-right")
SF-TOGGLE "Use facet image" FALSE
SF-IMAGE "Image" 0
)
(script-fu-menu-register "script-fu-sg-platonic-calendar"
"<Image>/File/Create"
)