;;; Extract background/foreground from animation
;;; v. 0.1

(define (bgmask-diff-layers img layer1 layer2 threshold buffer)
  (let* ((layer1-copy (car (gimp-layer-copy layer1 FALSE)))
         (layer2-copy (car (gimp-layer-copy layer2 FALSE))))
    (gimp-image-insert-layer img layer1-copy 0 0)
    (gimp-image-insert-layer img layer2-copy 0 0)
    (gimp-layer-set-mode layer2-copy DIFFERENCE-MODE)
    (let ((layer (car (gimp-image-merge-down img layer2-copy 2))))
      (cond ((> buffer 0)
             (gimp-desaturate layer)
             (gimp-levels layer 0 threshold (min (+ threshold buffer) 255) 1 0 255)
             )
            (else (gimp-threshold layer threshold 255)))
      layer)))

(define (bgmask-remove-alpha-channel layer)
  (let ((mask (car (gimp-layer-create-mask layer ADD-ALPHA-TRANSFER-MASK))))
    (gimp-layer-add-mask layer mask)
    (gimp-layer-remove-mask layer MASK-DISCARD)))

;; Averaging color values with opacity, the reference guide:
;; Ln - opacity 100/n
;; ...
;; L3 - opacity 100/3
;; L2 - opacity 100/2
;; L1 - opacity 100/1

(define (bgmask-average-layers img lst get-layer no-alpha)
  (let ((i 1)
        (res #f))
    (for-each
     (lambda (x)
       (let* ((layer (get-layer x))
              (opacity (car (gimp-layer-get-opacity layer))))
         (cond ((> i 1)
                (gimp-layer-set-opacity layer (/ opacity i))
                (set! res (car (gimp-image-merge-down img layer 2))))
               (else (set! res layer)))
         (set! i (+ i 1))))
     lst)
    (if (and res no-alpha) (bgmask-remove-alpha-channel res))
    res))

(define (bgmask-diff-matrix img layer other-layers threshold)
  (bgmask-average-layers img other-layers
                         (lambda (other-layer)
                           (bgmask-diff-layers img layer other-layer threshold 0))
                         #f))

(define (bgmask-produce-premasks img prime-matrix matrices)
  (map
   (lambda (matrix)
     (let ((prime-copy (car (gimp-layer-copy prime-matrix FALSE)))
           (pos (car (gimp-image-get-item-position img matrix))))
       (gimp-image-insert-layer img prime-copy 0 pos)
       (gimp-layer-set-mode prime-copy DIFFERENCE-MODE)
       (let ((merged (car (gimp-image-merge-down img prime-copy 2))))
         (gimp-threshold merged 1 255)
         ;;(gimp-invert merged)
         merged)))
   matrices))

(define (bgmask-mask-common img mask-layer)
  (let ((mask (car (gimp-layer-create-mask mask-layer ADD-COPY-MASK))))
    (gimp-layer-add-mask mask-layer mask)
    (gimp-layer-remove-mask mask-layer MASK-APPLY))
  (gimp-context-push)
  (gimp-context-set-antialias FALSE)
  (gimp-context-set-feather FALSE)
  (gimp-image-select-item img CHANNEL-OP-REPLACE mask-layer)
  (gimp-context-pop))

(define (bgmask-create-layer-with-mask img source-layer mask-layer)
  (let ((layer (car (gimp-layer-copy source-layer TRUE))))
    (gimp-image-insert-layer img layer 0 0)
    (bgmask-mask-common img mask-layer)
    (gimp-edit-clear layer)
    (gimp-selection-none img)
    (gimp-image-remove-layer img mask-layer)
    layer))

(define (bgmask-diff-median img layers threshold)
  (for-each (lambda (layer) (gimp-item-set-visible layer TRUE)) layers)
  (let* ((nl (length layers)) (i 0)
         (matrices (map (lambda (layer)
                          (gimp-progress-update (/ i nl)) (set! i (+ i 1))
                          (bgmask-diff-matrix img layer layers threshold))
                        layers))
         (prime-matrix #f))
    (for-each
     (lambda (matrix)
       (let ((matrix-copy (car (gimp-layer-copy matrix FALSE))))
         (gimp-image-insert-layer img matrix-copy 0 0)
         (if prime-matrix
             (begin
               (gimp-layer-set-mode matrix-copy DARKEN-ONLY-MODE)
               (set! prime-matrix (car (gimp-image-merge-down img matrix-copy 2))))
             (set! prime-matrix matrix-copy))))
     matrices)
    (set! matrices (bgmask-produce-premasks img prime-matrix matrices))
    (gimp-image-remove-layer img prime-matrix)
    (gimp-progress-update 1)
    (let* ((components (let loop ((li layers)
                                  (mi matrices))
                         (cond ((null? li) '())
                               (else (cons (bgmask-create-layer-with-mask img (car li) (car mi))
                                           (loop (cdr li) (cdr mi)))))))
           (background (bgmask-average-layers img components (lambda (x) x) #t)))
      (gimp-item-set-name background "Background [bg]")
      (gimp-image-reorder-item img background 0 (car (gimp-image-get-layers img)))
      background)))

(define (bgmask-get-layers img)
  (reverse (vector->list (cadr (gimp-image-get-layers img)))))

(define (bgmask-image-copy img)
  (let ((newimg (car (gimp-image-new
                      (car (gimp-image-width img))
                      (car (gimp-image-height img))
                      0)))
        (layers (bgmask-get-layers img)))
    (for-each
     (lambda (layer)
       (let ((layer-copy (car (gimp-layer-new-from-drawable layer newimg))))
         (gimp-image-insert-layer newimg layer-copy 0 0)))
     layers)
    newimg))

(define (bgmask-all-layers img threshold)
  ;;(gimp-image-undo-group-start img)
  (let ((newimg (bgmask-image-copy img)))
    (gimp-image-undo-disable newimg)
    (bgmask-diff-median newimg (bgmask-get-layers newimg) threshold)
    (gimp-image-undo-enable newimg)
    (gimp-display-new newimg))
  ;;(gimp-image-undo-group-end img)
  (gimp-displays-flush))

(define (script-fu-bgmask-all-layers img threshold)
  (bgmask-all-layers img threshold))
         
(script-fu-register
 "script-fu-bgmask-all-layers"
 "Extract background..."
 "Extract background from animation frames"
 "Timofei Shatrov"
 "Copyright 2012"
 "October 27, 2012"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image to use"       0
 SF-ADJUSTMENT "Threshold" '(10 1 255 1 5 0 SF-SPINNER)
 )

(script-fu-menu-register "script-fu-bgmask-all-layers" "<Image>/Script-Fu/BgMask")

(define (bgmask-mask-against-background img bg layers threshold buffer)
  (gimp-image-undo-group-start img)
  (let ((nl (length layers)) (i 0))
    (for-each
     (lambda (layer)
       (gimp-progress-update (/ i nl)) (set! i (+ i 1))
       (let ((diff (bgmask-diff-layers img bg layer threshold buffer)))
         (bgmask-mask-common img diff)
         (let ((mask (car (gimp-layer-create-mask layer ADD-SELECTION-MASK))))
           (gimp-layer-add-mask layer mask))
         (gimp-selection-none img)
         (gimp-image-remove-layer img diff)))
     layers))
  (gimp-image-undo-group-end img)
  (gimp-displays-flush))

(define (script-fu-mask-against-background img threshold buffer)
  (let* ((layers (bgmask-get-layers img)))
    (bgmask-mask-against-background img (car layers) (cdr layers) threshold buffer)))
         
(script-fu-register
 "script-fu-mask-against-background"
 "Mask against background..."
 "Create difference masks for all layers compared to bottom layer"
 "Timofei Shatrov"
 "Copyright 2012"
 "October 27, 2012"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image to use"       0
 SF-ADJUSTMENT "Threshold" '(10 1 255 1 5 0 SF-SPINNER)
 SF-ADJUSTMENT "Buffer" '(0 0 50 1 5 0 SF-SPINNER)
 )

(script-fu-menu-register  "script-fu-mask-against-background" "<Image>/Script-Fu/BgMask")

(define (bgmask-walk-layers-recursive img test fn)
  (let loop ((layers (cadr (gimp-image-get-layers img))))
    (vector-for-each
     (lambda (layer)
       (cond ((test layer) (fn layer))
             ((is-true? gimp-item-is-group layer)
              (loop (cadr (gimp-item-get-children layer))))))
     layers)))

(define (bgmask-is-true? fn item)
  ;; does fn return '(TRUE) ?
  (= (car (fn item)) TRUE))

(define (script-fu-average-linked-layers img delete-originals no-alpha)
  (gimp-image-undo-group-start img)
  (let ((layers '()) (originals '())) 
    (bgmask-walk-layers-recursive 
     img (lambda (layer) (bgmask-is-true? gimp-item-get-linked layer))
     (lambda (layer)
       (gimp-item-set-linked layer FALSE)
       (let ((layer-copy (car (gimp-layer-copy layer FALSE))))
         (gimp-image-insert-layer img layer-copy 0 0)
         (gimp-item-set-visible layer-copy TRUE)
         (set! originals (cons layer originals))
         (set! layers (cons layer-copy layers)))))
    (let ((res (bgmask-average-layers img (reverse layers) (lambda (x) x) (= no-alpha TRUE))))
      (gimp-item-set-name res "Average"))
    (if (= delete-originals TRUE)
        (for-each (lambda (layer) (gimp-image-remove-layer img layer)) originals)))
  (gimp-image-undo-group-end img)
  (gimp-displays-flush))

(script-fu-register
 "script-fu-average-linked-layers"
 "Average linked layers..."
 "Create a layer from linked layers with averaged pixel values"
 "Timofei Shatrov"
 "Copyright 2012"
 "October 28, 2012"
 "RGB RGBA GRAY GRAYA"
 SF-IMAGE     "Image to use"       0
 SF-TOGGLE "Delete originals" 0
 SF-TOGGLE "Remove alpha from result" 0
 )

(script-fu-menu-register  "script-fu-average-linked-layers" "<Image>/Script-Fu/BgMask")