GIMP Script-fu

Artifact [24db8209ca]
Login

Artifact 24db8209ca2d63faf75c032a1af2d3b961370ca5:


; 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-pseudo-depth-map image layer amount focal-plane-black)
  (define (displace layer amount)
    (let ((base-layer (car (gimp-layer-copy layer FALSE)))
          (map-layer (car (gimp-layer-copy layer FALSE))) )
      (gimp-image-insert-layer image map-layer 0 -1)
      (gimp-context-set-default-colors)
      (gimp-image-select-item image CHANNEL-OP-REPLACE map-layer)
      (unless (zero? focal-plane-black)
        (gimp-context-set-foreground '(80 80 80)) )
      (gimp-drawable-fill map-layer FOREGROUND-FILL)
      (gimp-edit-fill map-layer BACKGROUND-FILL)
      (gimp-selection-none image)
      (gimp-item-set-visible map-layer FALSE)
      (gimp-image-insert-layer image base-layer 0 -1)
      (gimp-levels base-layer HISTOGRAM-ALPHA 0 255 1.0 255 255)
      (let ((layers
        (let loop ((cnt 7)
                   (amounts (list (list (- (* 0.707 amount)) (- (* 0.707 amount)))
                                  (list 0 (- amount)) 
                                  (list (* 0.707 amount) (- (* 0.707 amount)))
                                  (list (- amount) 0)         
                                  (list amount 0)
                                  (list (- (* 0.707 amount)) (* 0.707 amount))    
                                  (list 0 amount)     
                                  (list (* 0.707 amount) (* 0.707 amount)) ))
                   (layers '()) )
          (if (zero? cnt)
            layers 
            (let ((new-layer (car (gimp-layer-copy base-layer FALSE))))
              (gimp-image-insert-layer image new-layer 0 -1)
              (gimp-layer-set-opacity new-layer (* cnt 12.5))
              (plug-in-displace RUN-NONINTERACTIVE 
                                image 
                                new-layer 
                                (caar amounts)
                                (cadar amounts) 
                                TRUE 
                                TRUE 
                                map-layer
                                map-layer
                                2 )
              (loop (pred cnt)
                    (cdr amounts)
                    (cons new-layer layers) ))))))
        (map (lambda (layer) (gimp-image-merge-down image layer EXPAND-AS-NECESSARY))
             (reverse layers) ))
      (gimp-image-remove-layer image map-layer)
      (car (gimp-image-get-active-layer image)) ))
  ; starts here
  (set! amount (truncate amount))
  (gimp-image-undo-group-start image)
  (gimp-context-push)
  (let ((layers 
    (let loop ((step amount)
               (disp-layers '()) )
      (if (zero? step)
        disp-layers
        (let ((displaced-layer (displace layer step)))
          (gimp-layer-set-opacity displaced-layer (- 100 (* 100 (/ (- amount step) amount))))
          (loop (pred step)
                (cons displaced-layer disp-layers) ))))))
    (map (lambda (layer) (gimp-image-merge-down image layer EXPAND-AS-NECESSARY))
         (reverse (butlast layers)) ))
  (gimp-context-pop)
  (gimp-displays-flush)
  (gimp-image-undo-group-end image)
  )

(script-fu-register "script-fu-sg-pseudo-depth-map"
  "Pseudo Depth Map..."
  "Create new pseudo-3D layer using layer's alpha channel as depth map"
  "Saul Goode"
  "Saul Goode"
  "May 2011"
  "RGB*, GRAY*"
  SF-IMAGE    "Image" 0
  SF-DRAWABLE "Layer" 0
  SF-ADJUSTMENT "Defocus amount" '(5 1 25 1 10 0 1)
  SF-OPTION "Focal Plane" '("Gray" "Black")
  )

(script-fu-menu-register "script-fu-sg-pseudo-depth-map"
 "<Image>/Filters/Map"
 )