home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 April / PCWorld_2001-04_cd.bin / Software / Topware / gimp / gimp-setup-20001226.exe / Main / mkbrush.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2000-12-27  |  10.5 KB  |  324 lines
  1. ; The GIMP -- an 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 2 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, write to the Free Software
  22. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24.  
  25. (define (script-fu-make-brush-rectangular description width height spacing )
  26.     (begin
  27.         (let* (
  28.             (img (car (gimp-image-new width height GRAY)))
  29.              (drawable (car (gimp-layer-new img width height GRAY_IMAGE "MakeBrush" 100 NORMAL)))
  30.  
  31.      ; Save old foregound and background colors
  32.  
  33.      (old-fg-color (car (gimp-palette-get-foreground)))
  34.      (old-bg-color (car (gimp-palette-get-background)))
  35.  
  36.      ; construct variables 
  37.  
  38.      (data-dir (car (gimp-gimprc-query "gimp_dir")))
  39.      (filename (string-append data-dir
  40.                "/brushes/r"
  41.                (number->string width)
  42.                "x"
  43.                (number->string height)
  44.                ".gbr")
  45.                )
  46.      (desc (string-append description " "
  47.                   (number->string width)
  48.                   "x"
  49.                   (number->string height)
  50.                   )
  51.       )
  52.     )
  53.  
  54.     (gimp-image-undo-disable img)
  55.     (gimp-image-add-layer img drawable 0)
  56.  
  57. ; Actual code starts...
  58.     (gimp-palette-set-background '(255 255 255))
  59.     (gimp-drawable-fill drawable BG-IMAGE-FILL)
  60.     (gimp-palette-set-background '(0 0 0))
  61.     (gimp-rect-select img 0 0 width height REPLACE FALSE 0)
  62.     
  63.     (gimp-edit-fill    drawable BG-IMAGE-FILL)
  64.     (file-gbr-save 1 img drawable filename "" spacing desc)
  65.     
  66.     (gimp-brushes-refresh)
  67.     (gimp-brushes-set-brush desc)
  68.  
  69. ; Terminate, restoring old bg.
  70.  
  71.     (gimp-selection-none img)
  72.     (gimp-palette-set-foreground old-fg-color)
  73.     (gimp-palette-set-background old-bg-color)
  74.     (gimp-image-undo-enable img)
  75.     (gimp-image-delete img)
  76.     )
  77.   )
  78. )
  79.  
  80. ; Register with the PDB
  81.  
  82. (script-fu-register "script-fu-make-brush-rectangular"
  83.             _"<Toolbox>/Xtns/Script-Fu/Make Brush/Rectangular..."
  84.             "Create size of brush"
  85.             "Seth Burgess <sjburges@ou.edu>"
  86.             "Seth Burgess"
  87.             "1997"
  88.             ""
  89.             SF-STRING     _"Description" "Rectangle"
  90.             SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
  91.             SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
  92.             SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  93.             )
  94.  
  95.  
  96. (define (script-fu-make-brush-rectangular-feathered description width height feathering spacing)
  97.     (begin
  98.         (let* (
  99.             (widthplus (+ width feathering))
  100.             (heightplus (+ height feathering))
  101.             (img (car (gimp-image-new widthplus heightplus GRAY)))
  102.              (drawable (car (gimp-layer-new img widthplus heightplus GRAY_IMAGE "MakeBrush" 100 NORMAL)))
  103.  
  104.      ; Save old foregound and background colors
  105.  
  106.      (old-fg-color (car (gimp-palette-get-foreground)))
  107.      (old-bg-color (car (gimp-palette-get-background)))
  108.      
  109.     (data-dir (car (gimp-gimprc-query "gimp_dir")))
  110.     (filename (string-append data-dir
  111.                "/brushes/r"
  112.                (number->string width)
  113.                "x"
  114.                (number->string height)
  115.                "f"
  116.                (number->string feathering)
  117.                ".gbr")
  118.                )
  119.      (desc (string-append description " "
  120.                   (number->string width)
  121.                   "x"
  122.                   (number->string height)
  123.                   ","
  124.                   (number->string feathering)
  125.                   )
  126.       )
  127.     )
  128.  
  129.     (gimp-image-undo-disable img)
  130.     (gimp-image-add-layer img drawable 0)
  131.  
  132. ; Actual code starts...
  133.     (gimp-palette-set-background '(255 255 255))
  134.     (gimp-drawable-fill drawable BG-IMAGE-FILL)
  135.     (gimp-palette-set-background '(0 0 0))
  136.     (cond ((< 0 feathering)
  137.            (gimp-rect-select img (/ feathering 2) (/ feathering 2) width height REPLACE TRUE feathering))
  138.           ((>= 0 feathering)
  139.            (gimp-rect-select img 0 0 width height REPLACE FALSE 0))
  140.           )
  141.     (gimp-edit-fill    drawable BG-IMAGE-FILL)
  142.     (file-gbr-save 1 img drawable filename "" spacing desc)
  143.     
  144.     (gimp-brushes-refresh)
  145.     (gimp-brushes-set-brush desc)
  146.  
  147. ; Terminate, restoring old bg.
  148.  
  149.     (gimp-selection-none img)
  150.     (gimp-palette-set-foreground old-fg-color)
  151.     (gimp-palette-set-background old-bg-color)
  152.     (gimp-image-undo-enable img)
  153.     (gimp-image-delete img)
  154.     )
  155.   )
  156. )
  157.  
  158. ; Register with the PDB
  159.  
  160. (script-fu-register "script-fu-make-brush-rectangular-feathered"
  161.             _"<Toolbox>/Xtns/Script-Fu/Make Brush/Rectangular, Feathered..."
  162.             "Create size of brush"
  163.             "Seth Burgess <sjburges@ou.edu>"
  164.             "Seth Burgess"
  165.             "1997"
  166.             ""
  167.             SF-STRING     _"Description" "Rectangle"
  168.             SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
  169.             SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
  170.             SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  171.             SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  172.             )
  173.  
  174. (define (script-fu-make-brush-elliptical description width height spacing)
  175.     (begin
  176.         (let* (
  177.             (img (car (gimp-image-new width height GRAY)))
  178.              (drawable (car (gimp-layer-new img width height GRAY_IMAGE "MakeBrush" 100 NORMAL)))
  179.  
  180.      ; Save old foregound and background colors
  181.  
  182.      (old-fg-color (car (gimp-palette-get-foreground)))
  183.      (old-bg-color (car (gimp-palette-get-background)))
  184.  
  185.      ; Construct variables...
  186.  
  187.      (data-dir (car (gimp-gimprc-query "gimp_dir")))
  188.      (filename (string-append data-dir
  189.                   "/brushes/e"
  190.                   (number->string width)
  191.                   "x"
  192.                   (number->string height)
  193.                   ".gbr"))
  194.      (desc (string-append description " "
  195.               (number->string width)
  196.               "x"
  197.               (number->string height)
  198.               )
  199.        )
  200.      )
  201.       ; End of variables.  Couple of necessary things here.
  202.  
  203.     (gimp-image-undo-disable img)
  204.     (gimp-image-add-layer img drawable 0)
  205.  
  206. ; Actual code starts...
  207.     (gimp-palette-set-background '(255 255 255))
  208.     (gimp-drawable-fill drawable BG-IMAGE-FILL)
  209.     (gimp-palette-set-background '(0 0 0))
  210.     (gimp-ellipse-select img 0 0 width height REPLACE TRUE FALSE 0)
  211.     
  212.     (gimp-edit-fill    drawable BG-IMAGE-FILL)
  213.     (file-gbr-save 1 img drawable filename "" spacing desc)
  214.     
  215.     (gimp-brushes-refresh)
  216.     (gimp-brushes-set-brush desc)
  217.  
  218. ; Terminate, restoring old bg.
  219.  
  220.     (gimp-selection-none img)
  221.     (gimp-palette-set-foreground old-fg-color)
  222.     (gimp-palette-set-background old-bg-color)
  223.     (gimp-image-undo-enable img)
  224.     (gimp-image-delete img)
  225.     )
  226.   )
  227. )
  228.  
  229. ; Register with the PDB
  230.  
  231. (script-fu-register "script-fu-make-brush-elliptical"
  232.             _"<Toolbox>/Xtns/Script-Fu/Make Brush/Elliptical..."
  233.             "Create size of brush"
  234.             "Seth Burgess <sjburges@ou.edu>"
  235.             "Seth Burgess"
  236.             "1997"
  237.             ""
  238.             SF-STRING _"Description" "Ellipse"
  239.             SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
  240.             SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
  241.             SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  242.             )
  243.  
  244.  
  245. (define (script-fu-make-brush-elliptical-feathered description width height feathering spacing)
  246.     (begin
  247.         (let* (
  248.         (widthplus (+ feathering width)) ; add 3 for blurring
  249.             (heightplus (+ feathering height))
  250.             (img (car (gimp-image-new widthplus heightplus GRAY)))
  251.              (drawable (car (gimp-layer-new img widthplus heightplus GRAY_IMAGE "MakeBrush" 100 NORMAL)))
  252.  
  253.      ; Save old foregound and background colors
  254.  
  255.      (old-fg-color (car (gimp-palette-get-foreground)))
  256.      (old-bg-color (car (gimp-palette-get-background)))
  257.  
  258.      ; Construct variables...
  259.      (data-dir (car (gimp-gimprc-query "gimp_dir")))
  260.      (filename (string-append data-dir
  261.                   "/brushes/e"
  262.                   (number->string width)
  263.                   "x"
  264.                   (number->string height)
  265.                   "f"
  266.                   (number->string feathering)
  267.                   ".gbr"))
  268.      (desc (string-append description " "
  269.               (number->string width)
  270.               "x"
  271.               (number->string height)
  272.               " f"
  273.               (number->string feathering)
  274.               )
  275.        )
  276.      
  277.      )
  278. ; End of variables.  Couple of necessary things here.
  279.  
  280.     (gimp-image-undo-disable img)
  281.     (gimp-image-add-layer img drawable 0)
  282.  
  283. ; Actual code starts...
  284.     (gimp-palette-set-background '(255 255 255))
  285.     (gimp-drawable-fill drawable BG-IMAGE-FILL)
  286.     (gimp-palette-set-background '(0 0 0))
  287.     (cond ((> feathering 0)   ; keep from taking out gimp with stupid entry. 
  288.         (gimp-ellipse-select img (/ feathering 2) (/ feathering 2) width height REPLACE TRUE TRUE feathering))
  289.           ((<= feathering 0)
  290.         (gimp-ellipse-select img 0 0 width height REPLACE TRUE FALSE 0))
  291.     )
  292.     (gimp-edit-fill    drawable BG-IMAGE-FILL)
  293.     (file-gbr-save 1 img drawable filename "" spacing desc)
  294.     
  295.     (gimp-brushes-refresh)
  296.     (gimp-brushes-set-brush desc)
  297.  
  298. ; Terminate, restoring old bg.
  299.  
  300.     (gimp-selection-none img)
  301.     (gimp-palette-set-foreground old-fg-color)
  302.     (gimp-palette-set-background old-bg-color)
  303.     (gimp-image-undo-enable img)
  304.     (gimp-image-delete img)
  305.     )
  306.   )
  307. )
  308.  
  309. ; Register with the PDB
  310.  
  311. (script-fu-register "script-fu-make-brush-elliptical-feathered"
  312.             _"<Toolbox>/Xtns/Script-Fu/Make Brush/Elliptical, Feathered..."
  313.             "Makes a feathered elliptical brush of specified size"
  314.             "Seth Burgess <sjburges@ou.edu>"
  315.             "Seth Burgess"
  316.             "1997"
  317.             ""
  318.             SF-STRING _"Description" "Ellipse"
  319.             SF-ADJUSTMENT _"Width" '(20 1 200 1 10 0 1)
  320.             SF-ADJUSTMENT _"Height" '(20 1 200 1 10 0 1)
  321.             SF-ADJUSTMENT _"Feathering" '(4 1 100 1 10 0 1)
  322.             SF-ADJUSTMENT _"Spacing" '(25 1 100 1 10 1 0)
  323.             )
  324.