;;; File:
;;;   gimpfun.ss
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   1.0 of April 2001
;;; Summary:
;;;   A few fun procedures for use within the GIMP.  Useful for
;;;   all sorts of algorithmic drawing exercises.
;;; Contents:
;;;   (blob image layer x y)
;;;     Draw a blob at (x,y) on the image, using x and y to
;;;       determine the color used.
;;;   (blot image layer x y)
;;;     Draw a blob at (x,y) on the image, using x and y to
;;;       deterine the brush used.
;;;   (brush-point image layer x y)
;;;     Draw a blob at (x,y) using the current paintbrush and
;;;       whatever color is already at (x,y).
;;;   (map-image-grid image proc hspace vspace)
;;;     Apply proc to grid points on the given image.
;;;   (munge-image path-to-file brush)
;;;     Show a modified version of the image given in the
;;;     file, using the brush for the modification.
;;; History:
;;;   Thursday, 5 April 2001
;;;     Created.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Libraries

; My favorite set of Script-Fu utilities.
(load "/home/rebelsky/Web/GIMP/Scripts/utils.ss")

        
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Values

;;; Value:
;;;   brushes
;;; Contents:
;;;   A list of brush names for some simple brushes.
;;; Note:
;;;   Used by blot
(define brushes
  (list "Circle (01)"
        "Circle (03)"
        "Circle (05)"
        "Circle (07)"
        "Circle (09)"
        "Circle (11)"
        "Circle (13)"
        "Circle (15)"
        "Circle (17)"
        "Circle (19)"
        "Circle Fuzzy (03)"
        "Circle Fuzzy (05)"
        "Circle Fuzzy (07)"
        "Circle Fuzzy (09)"
        "Circle Fuzzy (11)"
        "Circle Fuzzy (13)"
        "Circle Fuzzy (15)"
        "Circle Fuzzy (17)"
        "Circle Fuzzy (19)"
  ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Procedures

;;; Procedure:
;;;   blob
;;; Parameters:
;;;   image, an image id
;;;   layer, a layer id
;;;   x, an integer
;;;   y, an integer
;;; Purpose:
;;;   Draws a blob on the image where the color of the blob depends 
;;;   on x and y.
;;; Produces:
;;;   Nothing.
;;; Preconditions:
;;;   The image and layer have been initialized.
;;;   The point (x,y) is on the image.
;;; Postconditions:
;;;   May have affected the image.
(define blob
  (lambda (image layer x y)
    ; Choose a color that depends on the position
    (gimp-palette-set-foreground (list (mod (* x 7) 256)
                                       (mod (* y 9) 256)
                                       (mod (* (+ x y) 5) 256)))
    ; And draw there using the current brush.
    (gimp-paintbrush image layer 0 2 (float-array x y))))
        
;;; Procedure:
;;;   blot
;;; Parameters:
;;;   image, an image id
;;;   layer, a layer id
;;;   x, an integer
;;;   y, an integer
;;; Purpose:
;;;   Draws something on the image at position (x,y) where
;;;   the things drawn depends on x and y.
;;; Produces:
;;;   Nothing.
;;; Preconditions:
;;;   The image and layer have been initialized.
;;;   The point (x,y) is on the image.
;;; Postconditions:
;;;   May have affected the image.
(define blot
  (lambda (image layer x y)
    ; Pick a number for the brush.
    (let* ((val (+ (* x 3) (* y 5)))
           (brushnum (mod val (length brushes))))
      ; A quick dbug test
      ; (print (list val brushnum))
      ; Select that brush
      (gimp-brushes-set-brush (list-ref brushes brushnum))
      ; And paint
      (gimp-paintbrush image layer 0 2 (float-array x y)))))

;;; Procedure:
;;;   brush-point
;;; Parameters:
;;;   image, an image id
;;;   layer, a layer id
;;;   x, an integer
;;;   y, an integer
;;; Purpose:
;;;   Paints with the current brush at (x,y) using whatever color is
;;;   currently at x,y.
;;; Produces:
;;;   Nothing.
;;; Preconditions:
;;;   The image and layer have been initialized.
;;;   The point (x,y) is on the image.
;;; Postconditions:
;;;   May have affected the image.
(define brush-point
  (lambda (image layer x y)
    (let ((color (samr-get-pixel image layer x y)))
      (gimp-palette-set-foreground color)
      (gimp-paintbrush image layer 0 2 (float-array x y)))))

;;; Procedure:
;;;   map-image-grid
;;; Parameters:
;;;   image, an image
;;;   proc, a procedure
;;;   hspace, an integer
;;;   vspace, an integer
;;; Purpose:
;;;   Applys proc to a grid of points on the image, where the points
;;;   are separated horizontally by hspace and vertically by vspace.
;;; Produces:
;;;   Nothing.
;;; Preconditions:
;;;   image is a valid image id.
;;;   proc takes four arguments: image, layer, x, and y.
;;;   hspace and vspace are non-negative integers.
;;; Postconditions:
;;;   The image may have changed.
;;;   The brush and foreground and background colors may have changed.
(define map-image-grid
  (lambda (image proc hspace vspace)
    (let* ((layer (car (gimp-image-get-active-layer image)))
           (width (car (gimp-image-width image)))
           (height (car (gimp-image-height image))))
      ; We build a helper procedure that keeps track of the
      ; current x and y location on the grid.
      (letrec ((kernel
                (lambda (x y)
                  (cond
                    ; If we've exceeded y, we're off the image,
                    ; so stop
                    ((>= y height))
                    ; If we've exceeded x, go on to the next line.
                    ((>= x width)
                     (kernel 0 (+ y vspace)))
                    ; Otherwise,
                    (#t
                      ; Apply the procedure
                      (proc image layer x y)
                      ; And continue with the next point
                      (kernel (+ x hspace) y))))))
        ; Start the grid at 0,0
        (kernel 0 0)))))
        
;;; Procedure:
;;;   munge-image
;;; Parameters:
;;;   path, the path to an image file
;;;   brush, the name of a paintbrush
;;; Purpose:
;;;   Draw a "munged" version of the image.
;;; Produces:
;;;   The id of the image.
;;; Preconditions:
;;;   path names a valid file that contains a GIF or JPEG.
;;;   brush is a valid paintbrush name.
;;; Postconditions:
;;;   Shows some interesting variation of the image on
;;;   the screen.
(define munge-image
  (lambda (path brush)
    (let ((image (samr-load-image path)))
      (gimp-display-new image)
      (gimp-brushes-set-brush brush)
      (map-image-grid image brush-point 5 9))))