;;; File:
;;;   hog.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Contents:
;;;   A variety of methods for exploration of "higher-order graphics"
;;;   with Script-Fu in the GIMP.
;;; Note:
;;;   These methods are generally and intentionally under-documented.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constants

; This should probably have been defined by the GIMP, but doesn't
; seem to be.  It is documented and used in gimp_layer_new.
(define GIMP_RGB_IMAGE 0)


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

(define left-section
  (lambda (proc left)
    (lambda (right) (proc left right))))

(define right-section
  (lambda (proc right)
    (lambda (left) (proc left right))))

(define compose
  (lambda (f g)
    (lambda (x)
      (f (g x)))))

(define constant
  (lambda (c)
    (lambda (x) c)))

(define set-pixel!
  (lambda (layer x y color)
    (gimp-drawable-set-pixel layer x y 3 color)))

(define get-pixel
  (lambda (layer x y)
    (cadr (gimp-drawable-get-pixel layer x y))))

(define fixbyte
  (lambda (byte) (if (< byte 0) (+ byte 256) byte)))

(define red (compose fixbyte (right-section aref 0)))
(define green (compose fixbyte (right-section aref 1)))
(define blue (compose fixbyte (right-section aref 2)))

(define colortrans
  (lambda (rfunc gfunc bfunc)
    (lambda (color)
      (rgb (rfunc color)
                  (gfunc color)
                  (bfunc color)))))

(define rgb
  (lambda (r g b)
    (let ((cap (lambda (x) 
                 (cond 
                   ((> x 255) 255)
                   ((< x 0) 0)
                   (#t x)))))
          
      (let ((bytes (cons-array 3 'byte)))
        (begin
          (aset bytes 0 (cap r))
          (aset bytes 1 (cap g))
          (aset bytes 2 (cap b))
          bytes)))))


; Some silly transforms
(define rot (colortrans green blue red))

(define flop (colortrans (compose (left-section - 255) red)
                         (compose (left-section - 255) green)
                         (compose (left-section - 255) blue)))

(define less-red (colortrans (compose (right-section - 32) red) green blue))

(define just-blue (constant (rgb 0 0 255)))

(define no-green (colortrans red (constant 0) blue))

(define more-yellow (colortrans (compose (left-section + 16) red)
                                (compose (left-section + 16) green)
                                blue))

; Given a layer, build a new image by 'rotating' the colors
; in each pixel.
(define invert-image
  (lambda (layer)
    (let* ((x 0)
           (y 0)
           (width (car (gimp-drawable-width layer)))
           (height (car (gimp-drawable-height layer)))
           (newimg (new-image width height))
           (newlayer (cadr newimg)))
      (while (< y height)
        (set! x 0)
        (while (< x width)
          (let* ((pixel (get-pixel layer x y))
                 (newpixel (flop pixel)))
            ; (print (list x y pixel newpixel)) ; DEBUG
            (set-pixel! newlayer x y newpixel)
            (set! x (+ x 1))))
        (set! y (+ y 1)))
      newimg)))

(define map-image
  (lambda (func layer)
    (let* ((x 0)
           (y 0)
           (width (car (gimp-drawable-width layer)))
           (height (car (gimp-drawable-height layer)))
           (newimg (new-image width height))
           (newlayer (cadr newimg)))
      (while (< y height)
        (set! x 0)
        (while (< x width)
          (let* ((pixel (get-pixel layer x y))
                 (newpixel (func pixel)))
            ; (print (list x y pixel newpixel)) ; DEBUG
            (set-pixel! newlayer x y newpixel)
            (set! x (+ x 1))))
        (set! y (+ y 1)))
      newimg)))

(define munge-image
  (lambda (layer)
    (let* ((x 0)
           (y 0)
           (width (car (gimp-drawable-width layer)))
           (height (car (gimp-drawable-height layer)))
           (newimg (new-image width height))
           (newlayer (cadr newimg)))
      (while (< y height)
        (set! x 0)
        (while (< x width)
          (let* ((pixel (get-pixel layer x y))
                 (newpixel (rgb (red pixel) (green pixel) 0)))
            ; (print (list x y pixel newpixel)) ; DEBUG
            (set-pixel! newlayer x y newpixel)
            (set! x (+ x 1))))
        (set! y (+ y 1)))
      newimg)))

(define load-image
  (lambda (path)
    (let* ((image (car (gimp-file-load 1 path path)))
           (layer (car (gimp-image-get-active-layer image))))
      (list image layer))))

(define new-image
  (lambda (width height)
    (let* ((image (car (gimp-image-new width height RGB)))
           (layer (car (gimp-layer-new image width height 
                                       GIMP_RGB_IMAGE "Layer" 100 0))))
      ; Add the layer to the image
      (gimp-image-add-layer image layer 0)
      ; Clear everything
      (gimp-selection-all image)
      (gimp-edit-clear layer)
      (gimp-selection-none image)
      ; And return the information
      (list image layer))))