home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 August / ENTER.ISO / files / gimp-2.0.5-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / truchet.scm < prev    next >
Encoding:
Text File  |  2004-09-26  |  5.5 KB  |  164 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. ;    Truchet  - a script to create Truchet patterns 
  19. ;                 by Adrian Likins <aklikins@eos.ncsu.edu>
  20. ;                 http://www4.ncsu.edu/~aklikins/
  21. ;    version about .8 give or take
  22. ;
  23. ;  Lots of thanks to Quartic for his help.
  24. ;
  25. ;
  26. ;         The utility of this script is left as an exercise for the reader.
  27.  
  28. (define (center-ellipse img cx cy rx ry op aa feather frad)
  29.   (gimp-ellipse-select img (- cx rx) (- cy ry) (+ rx rx ) (+ ry ry ) op aa feather frad))
  30.  
  31. (define (use-tiles img drawable height width img2 drawable2 xoffset yoffset)
  32.   (gimp-edit-copy drawable2)
  33.   (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  34.     (gimp-layer-set-offsets floating-sel xoffset yoffset)
  35.     (gimp-floating-sel-anchor floating-sel)
  36.     )
  37. )
  38.  
  39.  
  40. (define (create-tiles img drawable1 drawable2 size thickness backcolor forecolor)
  41.   (let* (
  42.      (half-thickness (/ thickness 2))
  43.      (outer-radius (+ (/ size 2) half-thickness))
  44.      (inner-radius (- (/ size 2) half-thickness))
  45.      )
  46.  
  47.     (gimp-selection-all img)
  48.     (gimp-palette-set-background backcolor)
  49.     (gimp-edit-fill drawable1 BACKGROUND-FILL)
  50.  
  51.     (let* (
  52.        (tempSize (* size 3))
  53.        (temp-img (car (gimp-image-new tempSize tempSize RGB)))
  54.        (temp-draw (car (gimp-layer-new temp-img tempSize tempSize RGB-IMAGE "Jabar" 100 NORMAL-MODE)))
  55.       )
  56.       (gimp-image-undo-disable temp-img)
  57.       (gimp-image-add-layer temp-img temp-draw 0)
  58.       (gimp-palette-set-background backcolor)
  59.       (gimp-edit-fill temp-draw BACKGROUND-FILL)
  60.       
  61.       
  62.       (center-ellipse temp-img size size outer-radius outer-radius CHANNEL-OP-REPLACE TRUE FALSE 0)
  63.       (center-ellipse temp-img size size inner-radius inner-radius CHANNEL-OP-SUBTRACT TRUE FALSE 0)
  64.       
  65.       (center-ellipse temp-img (* size 2) (*  size 2)  outer-radius outer-radius CHANNEL-OP-ADD TRUE FALSE 0)
  66.       (center-ellipse temp-img (* size 2) (*  size 2)  inner-radius inner-radius CHANNEL-OP-SUBTRACT TRUE FALSE 0)
  67.       (gimp-palette-set-background forecolor)
  68.       (gimp-edit-fill temp-draw BACKGROUND-FILL)
  69.       
  70.       (gimp-selection-none temp-img)
  71.  
  72.       (gimp-image-resize temp-img size size (- size) (- size))
  73.       ; woo hoo it works....finally...
  74.  
  75.  
  76.       (gimp-selection-all temp-img)
  77.       (gimp-edit-copy temp-draw)
  78.       (let ((floating-sel (car (gimp-edit-paste drawable2 FALSE))))
  79.     (gimp-floating-sel-anchor floating-sel))
  80.  
  81.       
  82.       (let ((floating-sel (car (gimp-edit-paste drawable1 FALSE))))
  83.     (gimp-floating-sel-anchor floating-sel))
  84.  
  85.       (let ((drawble (car (gimp-flip drawable1 1)))))
  86.     
  87.  
  88.       ;(gimp-display-new temp-img)
  89.       (gimp-image-delete temp-img)
  90.       )
  91.     )
  92. )
  93.  
  94.  
  95. (define (script-fu-truchet size thickness backcolor forecolor xtiles ytiles)
  96.   (let* (
  97.      (width (* size xtiles))
  98.      (height (* size ytiles))
  99.      (img (car (gimp-image-new width height RGB)))
  100.      (tile (car (gimp-image-new size size RGB)))
  101.      (layer-one (car (gimp-layer-new img width height
  102.                      RGB-IMAGE "Rambis" 100 NORMAL-MODE)))
  103.      (tiledraw1 (car (gimp-layer-new tile size size
  104.                      RGB-IMAGE "Johnson" 100 NORMAL-MODE)))
  105.      (tiledraw2 (car (gimp-layer-new tile size size
  106.                      RGB-IMAGE "Cooper" 100 NORMAL-MODE)))
  107.      (Xindex 0)
  108.      (Yindex 0)
  109.      (old-bg (car (gimp-palette-get-background)))
  110.      )
  111.  
  112.     (gimp-image-undo-disable img)
  113.     (gimp-image-undo-disable tile)
  114.     
  115.     (gimp-image-add-layer img layer-one 0)
  116.     (gimp-image-add-layer tile tiledraw1 0)
  117.     (gimp-image-add-layer tile tiledraw2 0)
  118.  
  119.  
  120.     ;just to look a little better
  121.     (gimp-selection-all img)
  122.     (gimp-palette-set-background backcolor)
  123.     (gimp-edit-fill layer-one BACKGROUND-FILL)
  124.     (gimp-selection-none img)
  125.  
  126.     (create-tiles tile tiledraw1 tiledraw2 size thickness backcolor forecolor)
  127.     
  128.  
  129.     (while (<= Xindex xtiles)
  130.        (while (<= Yindex ytiles)
  131.           (if (= (rand 2) 0)
  132.               (use-tiles img layer-one height width tile tiledraw1 (* Xindex size) (* Yindex size))
  133.               (use-tiles img layer-one height width tile tiledraw2 (* Xindex size) (* Yindex size))
  134.               )
  135.           (set! Yindex (+ Yindex 1))
  136.           )
  137.        (set! Yindex 0)
  138.        (set! Xindex (+ Xindex 1))
  139.        )
  140.     
  141.     
  142.     (gimp-image-delete tile)
  143.     (gimp-palette-set-background old-bg)
  144.     (gimp-image-undo-enable img)
  145.     (gimp-display-new img)
  146.     )
  147.   )
  148.  
  149. (script-fu-register "script-fu-truchet"
  150.             _"<Toolbox>/Xtns/Script-Fu/Patterns/T_ruchet..."
  151.             "Create a Truchet pattern \n\nWorks best with even sized thicknesses"
  152.             "Adrian Likins <aklikins@eos.ncsu.edu>"
  153.             "Adrian Likins"
  154.             "1997"
  155.             ""
  156.  
  157.             SF-ADJUSTMENT _"Block Size" '(32 2 512 1 10 1 1)
  158.             SF-ADJUSTMENT _"Thickness" '(2 1 512 1 10 1 1)
  159.             SF-COLOR      _"Background Color" '(255 255 255)
  160.             SF-COLOR      _"Foreground Color" '(0 0 0)
  161.             SF-ADJUSTMENT _"Number of X Tiles" '(5 1 512 1 10 1 1)
  162.             SF-ADJUSTMENT _"Number of Y Tiles" '(5 1 512 1 10 1 1)
  163.             )
  164.