home *** CD-ROM | disk | FTP | other *** search
/ Maximum CD 2009 December / maximum-cd-2009-12.iso / DiscContents / gimp-2.7.0-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / mkbrush.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2009-08-19  |  8.5 KB  |  262 lines
  1. ; GIMP - The GNU Image Manipulation Program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Make-Brush - a script for the script-fu program
  5. ; by Seth Burgess 1997 <sjburges@ou.edu>
  6. ;
  7. ; 18-Dec-2000 fixed to work with the new convention (not inverted) of
  8. ;             gbr saver (jtl@gimp.org)
  9. ;
  10. ; This program is free software: you can redistribute it and/or modify
  11. ; it under the terms of the GNU General Public License as published by
  12. ; the Free Software Foundation; either version 3 of the License, or
  13. ; (at your option) any later version.
  14. ;
  15. ; This program is distributed in the hope that it will be useful,
  16. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ; GNU General Public License for more details.
  19. ;
  20. ; You should have received a copy of the GNU General Public License
  21. ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22.  
  23.  
  24. (define (script-fu-make-brush-rectangular name width height spacing)
  25.   (let* (
  26.         (img (car (gimp-image-new width height GRAY)))
  27.         (drawable (car (gimp-layer-new img
  28.                                        width height GRAY-IMAGE
  29.                                        "MakeBrush" 100 NORMAL-MODE)))
  30.         (filename (string-append gimp-directory
  31.                                  "/brushes/r"
  32.                                  (number->string width)
  33.                                  "x"
  34.                                  (number->string height)
  35.                                  ".gbr"))
  36.         )
  37.  
  38.     (gimp-context-push)
  39.  
  40.     (gimp-image-undo-disable img)
  41.     (gimp-image-add-layer img drawable 0)
  42.  
  43.     (gimp-context-set-background '(255 255 255))
  44.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  45.  
  46.     (gimp-rect-select img 0 0 width height CHANNEL-OP-REPLACE FALSE 0)
  47.  
  48.     (gimp-context-set-background '(0 0 0))
  49.     (gimp-edit-fill drawable BACKGROUND-FILL)
  50.  
  51.     (file-gbr-save 1 img drawable filename "" spacing name)
  52.     (gimp-image-delete img)
  53.  
  54.     (gimp-context-pop)
  55.  
  56.     (gimp-brushes-refresh)
  57.     (gimp-context-set-brush name)
  58.   )
  59. )
  60.  
  61. (script-fu-register "script-fu-make-brush-rectangular"
  62.   _"_Rectangular..."
  63.   _"Create a rectangular brush"
  64.   "Seth Burgess <sjburges@ou.edu>"
  65.   "Seth Burgess"
  66.   "1997"
  67.   ""
  68.   SF-STRING     _"Name"    "Rectangle"
  69.   SF-ADJUSTMENT _"Width"   '(20 1 200 1 10 0 1)
  70.   SF-ADJUSTMENT _"Height"  '(20 1 200 1 10 0 1)
  71.   SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  72. )
  73.  
  74. (script-fu-menu-register "script-fu-make-brush-rectangular"
  75.                          "<Brushes>")
  76.  
  77.  
  78. (define (script-fu-make-brush-rectangular-feathered name width height
  79.                                                     feathering spacing)
  80.   (let* (
  81.         (widthplus (+ width feathering))
  82.         (heightplus (+ height feathering))
  83.         (img (car (gimp-image-new widthplus heightplus GRAY)))
  84.         (drawable (car (gimp-layer-new img
  85.                                        widthplus heightplus GRAY-IMAGE
  86.                                        "MakeBrush" 100 NORMAL-MODE)))
  87.         (filename (string-append gimp-directory
  88.                                  "/brushes/r"
  89.                                  (number->string width)
  90.                                  "x"
  91.                                  (number->string height)
  92.                                  "f"
  93.                                  (number->string feathering)
  94.                                  ".gbr"))
  95.         )
  96.  
  97.     (gimp-context-push)
  98.  
  99.     (gimp-image-undo-disable img)
  100.     (gimp-image-add-layer img drawable 0)
  101.  
  102.     (gimp-context-set-background '(255 255 255))
  103.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  104.  
  105.     (cond ((< 0 feathering)
  106.      (gimp-rect-select img
  107.            (/ feathering 2) (/ feathering 2)
  108.            width height CHANNEL-OP-REPLACE TRUE feathering))
  109.     ((>= 0 feathering)
  110.      (gimp-rect-select img 0 0 width height CHANNEL-OP-REPLACE FALSE 0)))
  111.  
  112.     (gimp-context-set-background '(0 0 0))
  113.     (gimp-edit-fill drawable BACKGROUND-FILL)
  114.  
  115.     (file-gbr-save 1 img drawable filename "" spacing name)
  116.     (gimp-image-delete img)
  117.  
  118.     (gimp-context-pop)
  119.  
  120.     (gimp-brushes-refresh)
  121.     (gimp-context-set-brush name)
  122.   )
  123. )
  124.  
  125. (script-fu-register "script-fu-make-brush-rectangular-feathered"
  126.   _"Re_ctangular, Feathered..."
  127.   _"Create a rectangular brush with feathered edges"
  128.   "Seth Burgess <sjburges@ou.edu>"
  129.   "Seth Burgess"
  130.   "1997"
  131.   ""
  132.   SF-STRING     _"Name"       "Rectangle"
  133.   SF-ADJUSTMENT _"Width"      '(20 1 200 1 10 0 1)
  134.   SF-ADJUSTMENT _"Height"     '(20 1 200 1 10 0 1)
  135.   SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  136.   SF-ADJUSTMENT _"Spacing"    '(25 1 100 1 10 1 0)
  137. )
  138.  
  139. (script-fu-menu-register "script-fu-make-brush-rectangular-feathered"
  140.                          "<Brushes>")
  141.  
  142.  
  143. (define (script-fu-make-brush-elliptical name width height spacing)
  144.   (let* (
  145.         (img (car (gimp-image-new width height GRAY)))
  146.         (drawable (car (gimp-layer-new img
  147.                                        width height GRAY-IMAGE
  148.                                        "MakeBrush" 100 NORMAL-MODE)))
  149.         (filename (string-append gimp-directory
  150.                                  "/brushes/e"
  151.                                  (number->string width)
  152.                                  "x"
  153.                                  (number->string height)
  154.                                  ".gbr"))
  155.         )
  156.  
  157.     (gimp-context-push)
  158.  
  159.     (gimp-image-undo-disable img)
  160.     (gimp-image-add-layer img drawable 0)
  161.  
  162.     (gimp-context-set-background '(255 255 255))
  163.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  164.     (gimp-context-set-background '(0 0 0))
  165.     (gimp-ellipse-select img 0 0 width height CHANNEL-OP-REPLACE TRUE FALSE 0)
  166.  
  167.     (gimp-edit-fill drawable BACKGROUND-FILL)
  168.  
  169.     (file-gbr-save 1 img drawable filename "" spacing name)
  170.     (gimp-image-delete img)
  171.  
  172.     (gimp-context-pop)
  173.  
  174.     (gimp-brushes-refresh)
  175.     (gimp-context-set-brush name)
  176.   )
  177. )
  178.  
  179. (script-fu-register "script-fu-make-brush-elliptical"
  180.   _"_Elliptical..."
  181.   _"Create an elliptical brush"
  182.   "Seth Burgess <sjburges@ou.edu>"
  183.   "Seth Burgess"
  184.   "1997"
  185.   ""
  186.   SF-STRING     _"Name"    "Ellipse"
  187.   SF-ADJUSTMENT _"Width"   '(20 1 200 1 10 0 1)
  188.   SF-ADJUSTMENT _"Height"  '(20 1 200 1 10 0 1)
  189.   SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  190. )
  191.  
  192. (script-fu-menu-register "script-fu-make-brush-elliptical"
  193.                          "<Brushes>")
  194.  
  195.  
  196. (define (script-fu-make-brush-elliptical-feathered name
  197.                                                    width height
  198.                                                    feathering spacing)
  199.   (let* (
  200.         (widthplus (+ feathering width)) ; add 3 for blurring
  201.         (heightplus (+ feathering height))
  202.         (img (car (gimp-image-new widthplus heightplus GRAY)))
  203.         (drawable (car (gimp-layer-new img
  204.                                        widthplus heightplus GRAY-IMAGE
  205.                                        "MakeBrush" 100 NORMAL-MODE)))
  206.         (filename (string-append gimp-directory
  207.                                  "/brushes/e"
  208.                                  (number->string width)
  209.                                  "x"
  210.                                  (number->string height)
  211.                                  "f"
  212.                                  (number->string feathering)
  213.                                  ".gbr"))
  214.         )
  215.  
  216.     (gimp-context-push)
  217.  
  218.     (gimp-image-undo-disable img)
  219.     (gimp-image-add-layer img drawable 0)
  220.  
  221.     (gimp-context-set-background '(255 255 255))
  222.     (gimp-drawable-fill drawable BACKGROUND-FILL)
  223.  
  224.     (cond ((> feathering 0)   ; keep from taking out gimp with stupid entry.
  225.         (gimp-ellipse-select img
  226.            (/ feathering 2) (/ feathering 2)
  227.            width height CHANNEL-OP-REPLACE
  228.            TRUE TRUE feathering))
  229.           ((<= feathering 0)
  230.         (gimp-ellipse-select img 0 0 width height
  231.            CHANNEL-OP-REPLACE TRUE FALSE 0)))
  232.  
  233.     (gimp-context-set-background '(0 0 0))
  234.     (gimp-edit-fill drawable BACKGROUND-FILL)
  235.  
  236.     (file-gbr-save 1 img drawable filename "" spacing name)
  237.     (gimp-image-delete img)
  238.  
  239.     (gimp-context-pop)
  240.  
  241.     (gimp-brushes-refresh)
  242.     (gimp-context-set-brush name)
  243.   )
  244. )
  245.  
  246. (script-fu-register "script-fu-make-brush-elliptical-feathered"
  247.   _"Elli_ptical, Feathered..."
  248.   _"Create an elliptical brush with feathered edges"
  249.   "Seth Burgess <sjburges@ou.edu>"
  250.   "Seth Burgess"
  251.   "1997"
  252.   ""
  253.   SF-STRING     _"Name"       "Ellipse"
  254.   SF-ADJUSTMENT _"Width"      '(20 1 200 1 10 0 1)
  255.   SF-ADJUSTMENT _"Height"     '(20 1 200 1 10 0 1)
  256.   SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  257.   SF-ADJUSTMENT _"Spacing"    '(25 1 100 1 10 1 0)
  258. )
  259.  
  260. (script-fu-menu-register "script-fu-make-brush-elliptical-feathered"
  261.                          "<Brushes>")
  262.