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