; 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.

; Change these to reasonable values
;
(define STW-default-output-dir "/home/saul/GIMP/Work/Output/")
(define STW-default-message-file "/home/saul/GIMP/Work/STW_follower_profile.csv")

; The following fontsizes are tested in order until one is found that
; allows the message to fit within the bounds of the message template
; layer. If this search is unsuccessful then the message layer is 
; added using the last fontsize and the resulting image saved as an
; XCF file with "ERROR-" prepended to the name.
;
(define STW-fontsizes '(16 12 10 9 8 7 6))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Nothing below should need changing
;
(define (script-fu-sg-STW-acknowledge template-image 
                                      template-layer 
                                      output-dir 
                                      message-file
                                      save-png
                                      save-xcf )
  ; A template image must contain at least two layers with the following
  ; names:
  (define avatar-templatename "Avatar") 
  (define message-templatename "Message")

  ; These template layers can be in one of two forms: either the layer
  ; has no layermask and the boundaries of the layer determine the 
  ; location and size of the content, or the layer's mask provides 
  ; size and location of the content (permitting the layer to be any
  ; arbitrary size). These template layers are typically hidden (or
  ; have their Opacity zeroed) but alternatively could provide a
  ; background.
  
  ; The avatar template layer defines the position and boundaries of where
  ; the user profile picture is to appear.

  ; Should undersized profile pictures be scaled up to entirely fill
  ; the avatar template region? (If #f then undersized avatars will 
  ; be centered within the template region.)
  ;
  (define avatar-upscale? #t)

  ; Should oversized profile pictures be scaled down to fit within the 
  ; avatar template bounds?
  ;
  (define avatar-downscale? #t)
  ; Read characters until end-of-line
  ; Note: the optional 'port' argument is only used during
  ;       interactive debugging.
  ;
  (define (readln . port)
    (let ((getch (if (pair? port)
                   (lambda () (read-char (car port)))
                   read-char )))
      (let loop ((char (getch))
                (result "") )
        (if (eof-object? char)
          #f 
          (if (eqv? char #\newline)
            result
            (loop (getch) (string-append result (make-string 1 char))) )))))

  ; return bounds (xywh) of either layer or its mask
  ; Note: using a mask ensures cropping
  ;
  (define (get-template-bounds layer)
    (let* ((image (car (gimp-item-get-image layer))) 
           (mask (car (gimp-layer-get-mask layer))))
      (if (= mask -1)
        (list (car (gimp-drawable-offsets layer)) 
              (cadr (gimp-drawable-offsets layer))
              (car (gimp-drawable-width layer)) 
              (car (gimp-drawable-height layer))) 
        (let ((orig-sel (car (gimp-selection-save image))))
          (gimp-image-select-item image CHANNEL-OP-REPLACE mask)
          (let* ((bounds (cdr (gimp-selection-bounds image)))
                 (x (car bounds))
                 (y (cadr bounds)))
            (gimp-selection-load orig-sel)
            (gimp-image-remove-channel image orig-sel)
            (list x y (- (caddr bounds) x) (- (cadddr bounds) y)))))))

  ; scale layer to fit bounds while maintaining aspect ratio
  ;
  (define (fit-layer layer bounds)
    (let* ((x (car bounds))
           (y (cadr bounds))
           (w (caddr bounds))
           (h (cadddr bounds))
           (layer-width (car (gimp-drawable-width layer)))
           (layer-height (car (gimp-drawable-height layer)))
           (aspect (/ layer-height layer-width)))
      (gimp-layer-add-alpha layer)
      (if (< (/ w layer-width) (/ h layer-height))
        (begin
          (gimp-layer-scale-full layer 
                                 w
                                 (* w aspect)
                                 TRUE 
                                 INTERPOLATION-CUBIC)
          (gimp-layer-set-offsets layer x (+ y (/ (- h (* w aspect)) 2) )))
        (begin 
          (gimp-layer-scale-full layer 
                                 (/ h aspect)
                                 h
                                 TRUE 
                                 INTERPOLATION-CUBIC)
            (gimp-layer-set-offsets layer (+ x (/ (- w (/ h aspect)) 2)) y)))))

  (define (center-layer layer bounds)
    (let* ((x (car bounds))
           (y (cadr bounds))
           (w (caddr bounds))
           (h (cadddr bounds))
           (layer-width (car (gimp-drawable-width layer)))
           (layer-height (car (gimp-drawable-height layer))))
      (gimp-layer-set-offsets layer
                              (- (+ x (/ w 2)) (/ layer-width  2))
                              (- (+ y (/ h 2)) (/ layer-height 2)))))

  (define (retrieve-avatar dst-image src-image avatar-upscale? avatar-downscale? bounds)
    (let* ((avatar (car (gimp-layer-new-from-drawable (car (gimp-image-get-active-layer src-image))
                                                      dst-image )))
           (w (car (gimp-drawable-width avatar)))
           (h (car (gimp-drawable-height avatar)))
           (target-width (caddr bounds))
           (target-height (cadddr bounds))
           (aspect (/ h w)))
      (gimp-image-insert-layer dst-image avatar 0 -1)
      (if (or (and avatar-upscale?
                   (or (< w target-width)
                       (< h target-height)))
              (and avatar-downscale?
                   (or (> w target-width)
                       (> h target-height))))
        (fit-layer avatar bounds)
        (center-layer avatar bounds))))
        
  ; MAIN PROCEDURE                            
  ; Retrieve the template layers
  (let ((avatar-template (car (gimp-image-get-layer-by-name template-image avatar-templatename)))
        (message-template (car (gimp-image-get-layer-by-name template-image message-templatename))))
    (if (member -1 (list avatar-template message-template))
      (gimp-message "Image is not an acknowledgement template")
      (with-input-from-file message-file 
        (lambda ()
          (readln) ; skip CSV header line
          (let loop-message ((message-line (readln)))
            (when message-line
              (let* ((image (car (gimp-image-duplicate template-image)))
                     (avatar-template (car (gimp-image-get-layer-by-name image avatar-templatename)))
                     (message-template (car (gimp-image-get-layer-by-name image message-templatename)))
                     (message-info (strbreakup message-line ","))
                     (addressee (car message-info))
                     (name-text (cadr message-info))
                     (avatar-uri (caddr message-info))
                     (message-text (apply string-append (cdddr message-info)))
                     (message (string-append name-text ",\n" message-text)))
                ; Process avatar image
                (let ((avatar-image (car (file-uri-load RUN-NONINTERACTIVE
                                                        (string-append name-text
                                                                       ".jpg")
                                                        avatar-uri 
                                                        ))))
                  (gimp-image-set-active-layer image avatar-template)
                  (retrieve-avatar image 
                                   avatar-image 
                                   avatar-upscale? 
                                   avatar-downscale? 
                                   (get-template-bounds avatar-template))
                  (gimp-item-set-name (car (gimp-image-get-active-layer image))
                                      "Picture")
                  (gimp-image-delete avatar-image))
                ; Process message
                (let ((bounds (get-template-bounds message-template)))
                  (let loop-message-fontsize ((fontsizes STW-fontsizes))
                    (let* ((fontsize (car fontsizes))
                           (test-layer (car (gimp-text-fontname image 
                                                                -1 
                                                                (car bounds)
                                                                (cadr bounds)
                                                                message
                                                                0 
                                                                TRUE 
                                                                fontsize 
                                                                PIXELS 
                                                                (car (gimp-context-get-font))))))
                       (gimp-text-layer-resize test-layer 
                                               (caddr bounds)  
                                               (car (gimp-image-height image)))
                       (gimp-text-layer-set-justification test-layer TEXT-JUSTIFY-LEFT)
                       (let ((message-layer (car (gimp-layer-copy test-layer TRUE))))
                         (plug-in-autocrop-layer RUN-NONINTERACTIVE image test-layer)
                         (if (and (>= (+ (car bounds) (caddr bounds))
                                      (+ (car (gimp-drawable-offsets test-layer)) 
                                         (car (gimp-drawable-width test-layer))))
                                  (>= (+ (cadr bounds) (cadddr bounds))
                                      (+ (cadr (gimp-drawable-offsets test-layer)) 
                                         (car (gimp-drawable-height test-layer)))))
                           (begin ; text message fits
                             (gimp-image-remove-layer image test-layer)
                             (gimp-image-set-active-layer image message-template)
                             (gimp-image-insert-layer image message-layer 0 -1)
                             (gimp-text-layer-resize message-layer 
                                               (caddr bounds)  
                                               (cadddr bounds))
                             (let ((basename (string-append output-dir
                                                            DIR-SEPARATOR
                                                            addressee)))
                               (unless (zero? save-xcf)
                                 (gimp-xcf-save 0 
                                                image 
                                                -1  
                                                (string-append basename ".xcf")
                                                (string-append basename ".xcf")))
                               (let ((layer (car (gimp-image-flatten image)))) 
                                 (if (zero? save-png)
                                   (file-jpeg-save RUN-NONINTERACTIVE 
                                                   image 
                                                   layer
                                                   (string-append basename ".jpg")
                                                   (string-append basename ".jpg")
                                                   0.92 ; compression
                                                   0 ; smoothing 
                                                   1 ; optimize 
                                                   1 ; progressive 
                                                   "" ; comment 
                                                   0 ; subsmp (0-4)
                                                   1 ; baseline 
                                                   0 ; restart 
                                                   0 ;dct 
                                                   )
                                   (file-png-save2 RUN-NONINTERACTIVE 
                                                   image 
                                                   layer
                                                   (string-append basename ".png")
                                                   (string-append basename ".png")
                                                   FALSE ; interlace
                                                   9 ; compression
                                                   FALSE ; bkgd
                                                   (car (gimp-drawable-has-alpha layer))
                                                   FALSE ; offs
                                                   FALSE ; phys
                                                   FALSE ; time
                                                   TRUE  ; comment
                                                   FALSE ; svtrans
                                                   ))))
                             (gimp-image-delete image))
                           ; text message did not fit
                           (if (null? (cdr fontsizes))
                             (begin ; No more sizes to try
                               (gimp-image-remove-layer image test-layer)
                               (gimp-image-insert-layer image message-layer 0 -1)
                               (let ((filename (string-append output-dir
                                                              DIR-SEPARATOR
                                                              "ERROR-"
                                                              addressee
                                                              ".xcf")))
                                 (gimp-xcf-save 0 image -1  filename filename))
                                 (gimp-image-delete image))
                             (begin
                               (gimp-layer-delete message-layer)
                               (gimp-image-remove-layer image test-layer)
                               (loop-message-fontsize (cdr fontsizes))))))))
                (loop-message (readln)))))
            (let loop ((obj (read))) ; work-around for a GIMP bug
              (unless (eof-object? obj)
                (loop (read))))))))))
                
                
(script-fu-register "script-fu-sg-STW-acknowledge"
 "Create Acknowledgementss..."
 "Create STW aknowledgements from template image"
 "Saul Goode"
 "Saul Goode"
 "December 2014"
 "RGB*,GRAY*"
 SF-IMAGE    "Image"    0
 SF-DRAWABLE "Drawable" 0
 SF-DIRNAME "Output Folder" STW-default-output-dir
 SF-FILENAME "Messages File" STW-default-message-file
 SF-TOGGLE "Save as PNG (else JPEG)" FALSE
 SF-TOGGLE "Save XCF copy" FALSE
 )

(script-fu-menu-register "script-fu-sg-STW-acknowledge"
 "<Image>/Filters/STW"
 )
