home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 February / PCWorld_2001-02_cd.bin / Software / Topware / gimp / gimp-setup-20001226.exe / Main / weave.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2000-12-27  |  11.4 KB  |  368 lines
  1. ; The GIMP -- an image manipulation program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Weave script --- make an image look as if it were woven
  5. ; Copyright (C) 1997 Federico Mena Quintero
  6. ; federico@nuclecu.unam.mx
  7. ;
  8. ; This program is free software; you can redistribute it and/or modify
  9. ; it under the terms of the GNU General Public License as published by
  10. ; the Free Software Foundation; either version 2 of the License, or
  11. ; (at your option) any later version.
  12. ;
  13. ; This program is distributed in the hope that it will be useful,
  14. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ; GNU General Public License for more details.
  17. ;
  18. ; You should have received a copy of the GNU General Public License
  19. ; along with this program; if not, write to the Free Software
  20. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. ; Copies the specified rectangle from/to the specified drawable
  24.  
  25. (define (copy-rectangle img drawable x1 y1 width height dest-x dest-y)
  26.   (gimp-rect-select img x1 y1 width height REPLACE FALSE 0)
  27.   (gimp-edit-copy drawable)
  28.   (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  29.     (gimp-layer-set-offsets floating-sel dest-x dest-y)
  30.     (gimp-floating-sel-anchor floating-sel))
  31.   (gimp-selection-none img))
  32.  
  33. ; Creates a single weaving tile
  34.  
  35. (define (create-weave-tile ribbon-width ribbon-spacing shadow-darkness shadow-depth)
  36.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  37.      (darkness (* 255 (/ (- 100 shadow-darkness) 100)))
  38.      (img (car (gimp-image-new tile-size tile-size RGB)))
  39.      (drawable (car (gimp-layer-new img tile-size tile-size RGB_IMAGE "Weave tile" 100 NORMAL))))
  40.     (gimp-image-undo-disable img)
  41.     (gimp-image-add-layer img drawable 0)
  42.  
  43.     (gimp-palette-set-background '(0 0 0))
  44.     (gimp-edit-fill drawable BG-IMAGE-FILL)
  45.  
  46.     ; Create main horizontal ribbon
  47.  
  48.     (gimp-palette-set-foreground '(255 255 255))
  49.     (gimp-palette-set-background (list darkness darkness darkness))
  50.  
  51.     (gimp-rect-select img
  52.               0
  53.               ribbon-spacing
  54.               (+ (* 2 ribbon-spacing) ribbon-width)
  55.               ribbon-width
  56.               REPLACE
  57.               FALSE
  58.               0)
  59.     (gimp-blend drawable
  60.         FG-BG-RGB
  61.         NORMAL
  62.         BILINEAR
  63.         100
  64.         (- 100 shadow-depth)
  65.         REPEAT-NONE
  66.         FALSE
  67.         0
  68.         0
  69.         (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2)
  70.         0
  71.         0
  72.         0)
  73.  
  74.     ; Create main vertical ribbon
  75.  
  76.     (gimp-rect-select img
  77.               (+ (* 2 ribbon-spacing) ribbon-width)
  78.               0
  79.               ribbon-width
  80.               (+ (* 2 ribbon-spacing) ribbon-width)
  81.               REPLACE
  82.               FALSE
  83.               0)
  84.     (gimp-blend drawable
  85.         FG-BG-RGB
  86.         NORMAL
  87.         BILINEAR
  88.         100
  89.         (- 100 shadow-depth)
  90.         REPEAT-NONE
  91.         FALSE
  92.         0
  93.         0
  94.         0
  95.         (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2)
  96.         0
  97.         0)
  98.  
  99.     ; Create the secondary horizontal ribbon
  100.  
  101.     (copy-rectangle img
  102.             drawable
  103.             0
  104.             ribbon-spacing
  105.             (+ ribbon-width ribbon-spacing)
  106.             ribbon-width
  107.             (+ ribbon-width ribbon-spacing)
  108.             (+ (* 2 ribbon-spacing) ribbon-width))
  109.  
  110.     (copy-rectangle img
  111.             drawable
  112.             (+ ribbon-width ribbon-spacing)
  113.             ribbon-spacing
  114.             ribbon-spacing
  115.             ribbon-width
  116.             0
  117.             (+ (* 2 ribbon-spacing) ribbon-width))
  118.  
  119.     ; Create the secondary vertical ribbon
  120.  
  121.     (copy-rectangle img
  122.             drawable
  123.             (+ (* 2 ribbon-spacing) ribbon-width)
  124.             0
  125.             ribbon-width
  126.             (+ ribbon-width ribbon-spacing)
  127.             ribbon-spacing
  128.             (+ ribbon-width ribbon-spacing))
  129.  
  130.     (copy-rectangle img
  131.             drawable
  132.             (+ (* 2 ribbon-spacing) ribbon-width)
  133.             (+ ribbon-width ribbon-spacing)
  134.             ribbon-width
  135.             ribbon-spacing
  136.             ribbon-spacing
  137.             0)
  138.  
  139.     ; Done
  140.  
  141.     (gimp-image-undo-enable img)
  142.  
  143.     (list img drawable)))
  144.  
  145. ; Creates a complete weaving mask
  146.  
  147. (define (create-weave width height ribbon-width ribbon-spacing shadow-darkness shadow-depth)
  148.   (let* ((tile (create-weave-tile ribbon-width ribbon-spacing shadow-darkness shadow-depth))
  149.      (tile-img (car tile))
  150.      (tile-layer (cadr tile))
  151.       (weaving (plug-in-tile 1 tile-img tile-layer width height TRUE)))
  152.     (gimp-image-delete tile-img)
  153.     weaving))
  154.  
  155. ; Creates a single tile for masking
  156.  
  157. (define (create-mask-tile ribbon-width ribbon-spacing
  158.               r1-x1 r1-y1 r1-width r1-height
  159.               r2-x1 r2-y1 r2-width r2-height
  160.               r3-x1 r3-y1 r3-width r3-height)
  161.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  162.      (img (car (gimp-image-new tile-size tile-size RGB)))
  163.      (drawable (car (gimp-layer-new img tile-size tile-size RGB_IMAGE "Mask" 100 NORMAL))))
  164.     (gimp-image-undo-disable img)
  165.     (gimp-image-add-layer img drawable 0)
  166.  
  167.     (gimp-palette-set-background '(0 0 0))
  168.     (gimp-edit-fill drawable BG-IMAGE-FILL)
  169.  
  170.     (gimp-rect-select img r1-x1 r1-y1 r1-width r1-height REPLACE FALSE 0)
  171.     (gimp-rect-select img r2-x1 r2-y1 r2-width r2-height ADD FALSE 0)
  172.     (gimp-rect-select img r3-x1 r3-y1 r3-width r3-height ADD FALSE 0)
  173.  
  174.     (gimp-palette-set-background '(255 255 255))
  175.     (gimp-edit-fill drawable BG-IMAGE-FILL)
  176.     (gimp-selection-none img)
  177.  
  178.     (gimp-image-undo-enable img)
  179.  
  180.     (list img drawable)))
  181.  
  182. ; Creates a complete mask image
  183.  
  184. (define (create-mask final-width final-height
  185.              ribbon-width ribbon-spacing
  186.              r1-x1 r1-y1 r1-width r1-height
  187.              r2-x1 r2-y1 r2-width r2-height
  188.              r3-x1 r3-y1 r3-width r3-height)
  189.   (let* ((tile (create-mask-tile ribbon-width ribbon-spacing
  190.                  r1-x1 r1-y1 r1-width r1-height
  191.                  r2-x1 r2-y1 r2-width r2-height
  192.                  r3-x1 r3-y1 r3-width r3-height))
  193.      (tile-img (car tile))
  194.      (tile-layer (cadr tile))
  195.      (mask (plug-in-tile 1 tile-img tile-layer final-width final-height TRUE)))
  196.     (gimp-image-delete tile-img)
  197.     mask))
  198.  
  199. ; Creates the mask for horizontal ribbons
  200.  
  201. (define (create-horizontal-mask ribbon-width ribbon-spacing final-width final-height)
  202.   (create-mask final-width
  203.            final-height
  204.            ribbon-width
  205.            ribbon-spacing
  206.            0
  207.            ribbon-spacing
  208.            (+ (* 2 ribbon-spacing) ribbon-width)
  209.            ribbon-width
  210.            0
  211.            (+ (* 2 ribbon-spacing) ribbon-width)
  212.            ribbon-spacing
  213.            ribbon-width
  214.            (+ ribbon-width ribbon-spacing)
  215.            (+ (* 2 ribbon-spacing) ribbon-width)
  216.            (+ ribbon-width ribbon-spacing)
  217.            ribbon-width))
  218.  
  219. ; Creates the mask for vertical ribbons
  220.  
  221. (define (create-vertical-mask ribbon-width ribbon-spacing final-width final-height)
  222.   (create-mask final-width
  223.            final-height
  224.            ribbon-width
  225.            ribbon-spacing
  226.            (+ (* 2 ribbon-spacing) ribbon-width)
  227.            0
  228.            ribbon-width
  229.            (+ (* 2 ribbon-spacing) ribbon-width)
  230.            ribbon-spacing
  231.            0
  232.            ribbon-width
  233.            ribbon-spacing
  234.            ribbon-spacing
  235.            (+ ribbon-width ribbon-spacing)
  236.            ribbon-width
  237.            (+ ribbon-width ribbon-spacing)))
  238.  
  239. ; Adds a threads layer at a certain orientation to the specified image
  240.  
  241. (define (create-threads-layer img width height length density orientation)
  242.   (let* ((drawable (car (gimp-layer-new img width height RGBA_IMAGE "Threads" 100 NORMAL)))
  243.      (dense (/ density 100.0)))
  244.     (gimp-image-add-layer img drawable -1)
  245.     (gimp-palette-set-background '(255 255 255))
  246.     (gimp-edit-fill drawable BG-IMAGE-FILL)
  247.     (plug-in-noisify 1 img drawable FALSE dense dense dense dense)
  248.     (plug-in-c-astretch 1 img drawable)
  249.     (cond ((eq? orientation 'horizontal)
  250.        (plug-in-gauss-rle 1 img drawable length TRUE FALSE))
  251.       ((eq? orientation 'vertical)
  252.        (plug-in-gauss-rle 1 img drawable length FALSE TRUE)))
  253.     (plug-in-c-astretch 1 img drawable)
  254.     drawable))
  255.  
  256. (define (create-complete-weave width
  257.                    height
  258.                    ribbon-width
  259.                    ribbon-spacing
  260.                    shadow-darkness
  261.                    shadow-depth
  262.                    thread-length
  263.                    thread-density
  264.                    thread-intensity)
  265.   (let* ((weave (create-weave width height ribbon-width ribbon-spacing shadow-darkness shadow-depth))
  266.      (w-img (car weave))
  267.      (w-layer (cadr weave))
  268.  
  269.      (h-layer (create-threads-layer w-img width height thread-length thread-density 'horizontal))
  270.      (h-mask (car (gimp-layer-create-mask h-layer WHITE-MASK)))
  271.  
  272.      (v-layer (create-threads-layer w-img width height thread-length thread-density 'vertical))
  273.      (v-mask (car (gimp-layer-create-mask v-layer WHITE-MASK)))
  274.  
  275.      (hmask (create-horizontal-mask ribbon-width ribbon-spacing width height))
  276.      (hm-img (car hmask))
  277.      (hm-layer (cadr hmask))
  278.  
  279.      (vmask (create-vertical-mask ribbon-width ribbon-spacing width height))
  280.      (vm-img (car vmask))
  281.      (vm-layer (cadr vmask)))
  282.  
  283.     (gimp-image-add-layer-mask w-img h-layer h-mask)
  284.     (gimp-selection-all hm-img)
  285.     (gimp-edit-copy hm-layer)
  286.     (gimp-image-delete hm-img)
  287.     (gimp-floating-sel-anchor (car (gimp-edit-paste h-mask FALSE)))
  288.     (gimp-layer-set-opacity h-layer thread-intensity)
  289.     (gimp-layer-set-mode h-layer MULTIPLY)
  290.  
  291.     (gimp-image-add-layer-mask w-img v-layer v-mask)
  292.     (gimp-selection-all vm-img)
  293.     (gimp-edit-copy vm-layer)
  294.     (gimp-image-delete vm-img)
  295.     (gimp-floating-sel-anchor (car (gimp-edit-paste v-mask FALSE)))
  296.     (gimp-layer-set-opacity v-layer thread-intensity)
  297.     (gimp-layer-set-mode v-layer MULTIPLY)
  298.  
  299.     ; Uncomment this if you want to keep the weaving mask image
  300.     ; (gimp-display-new (car (gimp-channel-ops-duplicate w-img)))
  301.  
  302.     (list w-img
  303.       (car (gimp-image-flatten w-img)))))
  304.  
  305. ; The main weave function
  306.  
  307. (define (script-fu-weave img
  308.              drawable
  309.              ribbon-width
  310.              ribbon-spacing
  311.              shadow-darkness
  312.              shadow-depth
  313.              thread-length
  314.              thread-density
  315.              thread-intensity)
  316.   (let* ((old-fg-color (car (gimp-palette-get-foreground)))
  317.      (old-bg-color (car (gimp-palette-get-background)))
  318.  
  319.      (d-img (car (gimp-drawable-image drawable)))
  320.      (d-width (car (gimp-drawable-width drawable)))
  321.      (d-height (car (gimp-drawable-height drawable)))
  322.      (d-offsets (gimp-drawable-offsets drawable))
  323.  
  324.      (weaving (create-complete-weave d-width
  325.                      d-height
  326.                      ribbon-width
  327.                      ribbon-spacing
  328.                      shadow-darkness
  329.                      shadow-depth
  330.                      thread-length
  331.                      thread-density
  332.                      thread-intensity))
  333.      (w-img (car weaving))
  334.      (w-layer (cadr weaving)))
  335.  
  336.     (gimp-selection-all w-img)
  337.     (gimp-edit-copy w-layer)
  338.     (gimp-image-delete w-img)
  339.     (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  340.       (gimp-layer-set-offsets floating-sel
  341.                   (car d-offsets)
  342.                   (cadr d-offsets))
  343.       (gimp-layer-set-mode floating-sel MULTIPLY)
  344.       (gimp-floating-sel-to-layer floating-sel))
  345.  
  346.     (gimp-palette-set-foreground old-fg-color)
  347.     (gimp-palette-set-background old-bg-color)
  348.     (gimp-displays-flush)))
  349.  
  350. ; Register!
  351.  
  352. (script-fu-register "script-fu-weave"
  353.             _"<Image>/Script-Fu/Alchemy/Weave..."
  354.             "Weave effect like Alien Skin"
  355.             "Federico Mena Quintero"
  356.             "Federico Mena Quintero"
  357.             "June 1997"
  358.             "RGB* GRAY*"
  359.             SF-IMAGE "Image to Weave" 0
  360.             SF-DRAWABLE "Drawable to Weave" 0
  361.             SF-ADJUSTMENT _"Ribbon Width"     '(30  0 256 1 10 1 1)
  362.             SF-ADJUSTMENT _"Ribbon Spacing"   '(10  0 256 1 10 1 1)
  363.             SF-ADJUSTMENT _"Shadow Darkness"  '(75  0 100 1 10 1 1)
  364.             SF-ADJUSTMENT _"Shadow Depth"     '(75  0 100 1 10 1 1)
  365.             SF-ADJUSTMENT _"Thread Length"    '(200 0 256 1 10 1 1)
  366.             SF-ADJUSTMENT _"Thread Density"   '(50  0 100 1 10 1 1)
  367.             SF-ADJUSTMENT _"Thread Intensity" '(100 0 512 1 10 1 1))
  368.