home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_gimp.idb / usr / freeware / share / gimp / scripts / slide.scm.z / slide.scm
Encoding:
GIMP Script-Fu Script  |  1999-07-21  |  6.6 KB  |  256 lines
  1. ; The GIMP -- an image manipulation program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ; 
  4. ; This program is free software; you can redistribute it and/or modify
  5. ; it under the terms of the GNU General Public License as published by
  6. ; the Free Software Foundation; either version 2 of the License, or
  7. ; (at your option) any later version.
  8. ; 
  9. ; This program is distributed in the hope that it will be useful,
  10. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ; GNU General Public License for more details.
  13. ; 
  14. ; You should have received a copy of the GNU General Public License
  15. ; along with this program; if not, write to the Free Software
  16. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ;
  18. ;
  19. ; slide.scm   version 0.30   12/13/97
  20. ;
  21. ; CHANGE-LOG:
  22. ; 0.20 - first public release
  23. ; 0.30 - some code cleanup
  24. ;        now uses the rotate plug-in to improve speed
  25. ;
  26. ; !still in development!
  27. ; TODO: - change the script so that the film is rotated, not the image
  28. ;       - antialiasing
  29. ;       - make 'add background' an option
  30. ;       - ?
  31. ;
  32. ; Copyright (C) 1997 Sven Neumann (neumanns@uni-duesseldorf.de) 
  33. ;  
  34. ; makes your picture look like a slide
  35. ;
  36. ; The script works on RGB and grayscale images that contain only 
  37. ; one layer. The image is cropped to fit into an aspect ratio of 1:1,5.
  38. ; It creates a copy of the image or can optionally work on the original. 
  39. ; The script uses the current background color to create a background 
  40. ; layer.
  41.  
  42.  
  43. (define (crop width height ratio)
  44.   (cond ((>= width (* ratio height)) (* ratio height))
  45.     ((< width (* ratio height))   width)))
  46.  
  47.  
  48. (define (script-fu-slide img 
  49.              drawable
  50.              text
  51.              number
  52.              font-family
  53.              font-color
  54.              work-on-copy)
  55.   (let* ((type (car (gimp-drawable-type-with-alpha drawable)))
  56.      (image (cond ((= work-on-copy TRUE) 
  57.                (car (gimp-channel-ops-duplicate img)))
  58.               ((= work-on-copy FALSE) 
  59.                img)))
  60.      (owidth (car (gimp-image-width image)))
  61.      (oheight (car (gimp-image-height image)))
  62.      (ratio (if (>= owidth oheight) (/ 3 2) 
  63.                                 (/ 2 3)))
  64.      (crop-width (crop owidth oheight ratio)) 
  65.      (crop-height (/ crop-width ratio))
  66.      (width (* (max crop-width crop-height) 1.05))
  67.      (height (* (min crop-width crop-height) 1.5))
  68.      (hole-width (/ width 20))
  69.      (hole-space (/ width 8))
  70.      (hole-height (/ width 12))
  71.      (hole-radius (/ hole-width 4))
  72.      (hole-start (- (/ (rand 1000) 1000) 0.5))
  73.      (old-bg (car (gimp-palette-get-background)))
  74.      (old-fg (car (gimp-palette-get-foreground)))
  75.      (film-layer (car (gimp-layer-new image 
  76.                       width 
  77.                       height 
  78.                       type 
  79.                       "Film" 
  80.                       100 
  81.                       NORMAL)))
  82.      (bg-layer (car (gimp-layer-new image 
  83.                     width 
  84.                     height 
  85.                     type 
  86.                     "Background" 
  87.                     100 
  88.                     NORMAL)))
  89.      (pic-layer (car (gimp-image-active-drawable image)))
  90.      (numbera (string-append number "A")))
  91.  
  92.  
  93.   (gimp-image-disable-undo image)
  94.  
  95. ; add an alpha channel to the image
  96.   (gimp-layer-add-alpha pic-layer)
  97.  
  98. ; crop, resize and eventually rotate the image 
  99.   (gimp-crop image 
  100.          crop-width 
  101.          crop-height 
  102.          (/ (- owidth crop-width) 2)
  103.          (/ (- oheight crop-height) 2))
  104.   (gimp-image-resize image 
  105.              width 
  106.              height 
  107.              (/ (- width crop-width) 2)
  108.              (/ (- height crop-height) 2))
  109.   (if (< ratio 1) (plug-in-rotate 1
  110.                   image 
  111.                   pic-layer
  112.                   1
  113.                   FALSE)) 
  114.  
  115. ; add the background layer
  116.   (gimp-drawable-fill bg-layer BG-IMAGE-FILL)
  117.   (gimp-image-add-layer image bg-layer -1)
  118.  
  119. ; add the film layer
  120.   (gimp-palette-set-background '(0 0 0))
  121.   (gimp-drawable-fill film-layer BG-IMAGE-FILL)
  122.  
  123. ; add the text
  124.   (gimp-palette-set-foreground font-color)
  125.   (gimp-floating-sel-anchor (car (gimp-text image
  126.                         film-layer
  127.                         (+ hole-start (* -0.25 width))
  128.                         (* 0.01 height)
  129.                         text
  130.                         0
  131.                         TRUE
  132.                         (* 0.040 height) PIXELS
  133.                         "*" font-family "*" "*" "*" "*" )))
  134.   (gimp-floating-sel-anchor (car (gimp-text image
  135.                         film-layer
  136.                         (+ hole-start (* 0.75 width))
  137.                         (* 0.01 height)
  138.                         text
  139.                         0
  140.                         TRUE
  141.                         (* 0.040 height) PIXELS
  142.                         "*" font-family "*" "*" "*" "*" )))
  143.   (gimp-floating-sel-anchor (car (gimp-text image
  144.                         film-layer          
  145.                         (+ hole-start (* 0.35 width))
  146.                         (* 0.01 height)
  147.                         number
  148.                         0
  149.                         TRUE
  150.                         (* 0.050 height) PIXELS
  151.                         "*" font-family "*" "*" "*" "*" )))
  152.   (gimp-floating-sel-anchor (car (gimp-text image
  153.                         film-layer          
  154.                         (+ hole-start (* 0.35 width))
  155.                         (* 0.95 height)
  156.                         number
  157.                         0
  158.                         TRUE
  159.                         (* 0.050 height) PIXELS
  160.                         "*" font-family "*" "*" "*" "*" )))
  161.   (gimp-floating-sel-anchor (car (gimp-text image
  162.                           film-layer          
  163.                           (+ hole-start (* 0.85 width))
  164.                           (* 0.95 height)
  165.                           numbera
  166.                           0
  167.                           TRUE
  168.                           (* 0.045 height) PIXELS
  169.                           "*" font-family "*" "*" "*" "*" )))
  170.  
  171. ; create a mask for the holes and cut them out
  172.   (let* ((film-mask (car (gimp-layer-create-mask film-layer WHITE-MASK)))
  173.      (hole hole-start)
  174.      (top-y (* height 0.06))
  175.      (bottom-y(* height 0.855))) 
  176.     (gimp-selection-none image)
  177.     (while (< hole 8)
  178.        (gimp-rect-select image 
  179.                  (* hole-space hole)
  180.                  top-y
  181.                  hole-width
  182.                  hole-height
  183.                  ADD
  184.                  FALSE
  185.                  0)     
  186.        (gimp-rect-select image 
  187.                  (* hole-space hole)
  188.                  bottom-y
  189.                  hole-width
  190.                  hole-height
  191.                  ADD
  192.                  FALSE
  193.                  0)
  194.        (set! hole (+ hole 1)))
  195.  
  196.     (gimp-palette-set-foreground '(0 0 0))
  197.     (gimp-edit-fill image film-mask)
  198.     (gimp-selection-none image)
  199.     (plug-in-gauss-rle 1 image film-mask hole-radius TRUE TRUE)
  200.     (gimp-threshold image film-mask 127 255)
  201.  
  202.     (gimp-image-add-layer image film-layer -1)
  203.     (gimp-image-add-layer-mask image film-layer film-mask))
  204.  
  205. ; reorder the layers
  206.   (gimp-image-raise-layer image pic-layer)
  207.   (gimp-image-raise-layer image pic-layer)
  208.  
  209. ; clean up after the script
  210.   (gimp-selection-none image)
  211.   (gimp-palette-set-background old-bg)
  212.   (gimp-palette-set-foreground old-fg)
  213.   (gimp-image-enable-undo image)
  214.   (if (= work-on-copy TRUE) (gimp-display-new image))
  215.   (gimp-displays-flush)))
  216.  
  217. (script-fu-register "script-fu-slide" 
  218.             "<Image>/Script-Fu/Decor/Slide"
  219.             "Gives the image the look of a slide"
  220.             "Sven Neumann (neumanns@uni-duesseldorf.de)"
  221.             "Sven Neumann"
  222.             "12/13/1997"
  223.             "RGB GRAY"
  224.             SF-IMAGE "Image" 0
  225.             SF-DRAWABLE "Drawable" 0
  226.             SF-VALUE "Text" "\"The GIMP\""
  227.             SF-VALUE "Number" "\"32\""
  228.             SF-VALUE "Font" "\"Utopia\""
  229.             SF-COLOR "Font Color" '(255 180 0)
  230.             SF-TOGGLE "Work on copy" TRUE) 
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.