; Implements
; http://learnfobia.com/category-Computers-47/tutorial-Painting-A-Spaceship-Hull-Texture-2126.html
(define (script-fu-render-greebles
    img drw
    layers size num
    aspect-limit change-factor smudge-density
    fuzz exposure)
  (list
    (loop 0 layers (lambda (x)
      (with-selection img (lambda ()
        (with-color (lambda ()
          (let*
            (
              (w (car (gimp-image-width img)))
              (h (car (gimp-image-height img))))
            (list
              (random-blend)
              (greeblestep
                img (list w h) drw
                (= x 0)
                (list size num aspect-limit (* (+ x 1) change-factor))
                smudge-density fuzz exposure)
              (gimp-drawable-update drw 0 0 w h)
              (gimp-displays-flush)))))))))))
(script-fu-register
  "script-fu-render-greebles"
  "G_reebles"
  "Renders greebles"
  "FeepingCreature"
  ""
  ""
  "*"
  SF-IMAGE  "The Image" 0
  SF-DRAWABLE   "The Layer" 0
  SF-VALUE  "Layers"    "2"
  SF-VALUE  "Base size" "200"
  SF-VALUE  "numGreebles per layer" "35"
  SF-VALUE  "Base aspect limiter"   "2"
  SF-VALUE  "Aspect change factor"  "3"
  SF-VALUE  "Smudge Density"    "7"
  SF-VALUE  "Edge Fuzz Spread"  "4"
  SF-VALUE  "Smudge Exposure"   "20")
(script-fu-menu-register "script-fu-render-greebles" "<Image>/Filters/Render")

; call f with numbers from 'from' to 'to', end-exclusive
(define loop (lambda (from to f)
  (while (< from to)
    (f from)
    (set! from (+ from 1)))))
; call f, then restore foreground/background color
(define with-color (lambda (f)
  (let*
    (
      (bg (car (gimp-context-get-background)))
      (fg (car (gimp-context-get-foreground))))
    (list
      (f)
      (gimp-context-set-background bg)
      (gimp-context-set-foreground fg)))))
; set context color to a random mix of foreground and background
(define random-blend (lambda ()
  (let*
    (
      (blend (blend (/ (random 1000) 1000)))
      (fg (car (gimp-context-get-foreground)))
      (bg (car (gimp-context-get-background))))
    (gimp-context-set-foreground (list
      (blend (car fg) (car bg))
      (blend (cadr fg) (cadr bg))
      (blend (caddr fg) (caddr bg)))))))
; generate a blender function that blends between two numbers with factor 'f'.
(define blend (lambda (f)
  (lambda (a b)
    (+
      (* a (- 1 f))
      (* b f)))))
; adds one layer of greebles
(define greeblestep (lambda (img img-size drawable overwrite-background select-args steps fuzz exposure)
  ((with-undo-group img (lambda ()
    (with-selection img (lambda ()
      (list
        ; build our random-rectangles selection
        (apply (curry reselect img img-size) select-args)
        ; paint the foreground/background
        (swap-and-do drawable img
          (combine
            (curry2 gimp-edit-fill FOREGROUND-FILL)
            (curry (thing-it drawable (curry2 gimp-dodgeburn exposure BURN MIDTONES)) steps))
          (combine
            (if overwrite-background (curry2 gimp-edit-fill BACKGROUND-FILL) (lambda (d) #t))
            (curry (thing-it drawable (curry2 gimp-dodgeburn exposure DODGE MIDTONES)) steps)))
        ; grab the border of our selection
        (border-select img fuzz)
        (with-color (lambda ()
          (list
            (gimp-context-set-foreground (list 0 0 0)) ; draw border in black
            (gimp-edit-fill drawable FOREGROUND-FILL))))))))))))
; treats f as a single undo group
(define with-undo-group (lambda (img f)
  (guard
    (curry gimp-image-undo-group-start img)
    (curry gimp-image-undo-group-end img)
    f)))
; executes 'first', then 'f', then 'last'. TODO: make error safe.
(define guard (lambda (first last f)
  (lambda x
    (list (first) (apply f x) (last)))))
; partial application
(define (curry fun . args) (lambda x
  (apply fun (append args x))))
; 2.6 compatibility stub
(define rectselect (if
  (string=? (substring (car (gimp-version)) 0 3) "2.6")
    (lambda (image operation x y width height) (gimp-rect-select image x y width height operation 0 0))
    gimp-image-select-rectangle))
; select a bunch of rectangles at random
(define reselect (lambda (img img-size size num range ratio)
  (let*
    (
      (ch (car (gimp-selection-save img))))
    (list
      (gimp-selection-none img)
      (loop 0 num (lambda (x)
        (let*
          (
            (x (random (car img-size)))
            (y (random (cadr img-size)))
            (pair (random-one ratio)))
          (my-select-rectangle-helper
            x
            y
            (/ (random2n (/ size range) size) (car pair))
            (/ (random2n (/ size range) size) (cadr pair))
            (curry rectselect img CHANNEL-OP-ADD)))))
      (script-fu-channel-grab img ch CHANNEL-OP-INTERSECT)))))
; randomly append or prepend a 1.
; used for vertical or horizontally scaled rectangles.
(define random-one (lambda (n)
  (if (= (random 2) 0)
    (list n 1)
    (list 1 n))))
; a select-rectangle wrapper that handles negative width/height
(define my-select-rectangle-helper (lambda (x y w h f)
  (let*
    (
      (xx (if (< w 0) (+ x w) x))
      (yy (if (< h 0) (+ y h) y)))
    (f xx yy (abs w) (abs h)))))
; random number from [-to..-from], [from..to]
(define random2n (lambda (from to)
  (let*
    (
      (tmp (+ (random (- to from)) from)))
    (if (= (random 2) 0)
      tmp
      (- 0 tmp)))))
; execute f1, invert selection, execute f2, invert selection
(define swap-and-do (lambda (d img f1 f2)
  (let*
    (
      (w (car (gimp-drawable-width d)))
      (h (car (gimp-drawable-height d))))
    (list
      (f1 d)
      (gimp-selection-invert img)
      (f2 d)
      (gimp-selection-invert img)))))
; takes a bunch of functions and combines them into one that has the
; same arguments as each of them and calls them in turn
(define combine (lambda x
  (lambda y
    (if (= (length x) 0)
      ()
      (append
        (list (apply (car x) y))
        (apply (apply combine (cdr x)) y))))))
; like curry, except it keeps the first argument
(define (curry2 fun . args) (lambda x
  (apply fun (append (list (car x)) args (cdr x)))))
; execute some action 'fn' over the entire image in subdivisions of 'divs'.
(define thing-it (lambda (d fn)
  (lambda (divs)
    ((with-undo-group
      (car (gimp-item-get-image d))
      (lambda ()
        (let*
          (
            (w (car (gimp-drawable-width d)))
            (h (car (gimp-drawable-height d))))
          (loop 0 (+ divs 1) (lambda (y)
            (loop 0 (+ divs 1) (lambda (x)
              (fn
                d
                2
                (floatarray (* (/ w divs) y) (* (/ h divs) x))))))))))))))
; source for floatarray:
; http://www.math.grinnell.edu/~rebelsky/Glimmer/Summer2006/GIMP/sam.scm
; coerce a list into a float-array
(define floatarray (lambda floats
  (let*
    (
      (len (length floats))
      (vec (cons-array len 'double)))
    (letrec
      ((kernel (lambda (pos rest)
        (if
          (= pos len)
          vec
          (begin
            (vector-set! vec pos (car rest))
            (kernel (+ pos 1) (cdr rest)))))))
      (kernel 0 floats)))))
; saves/restores active selection after 'f' is executed
(define with-selection (lambda (img f)
  (let*
    (
      (ch (car (gimp-selection-save img))))
    (list
      (f)
      (script-fu-channel-grab img ch CHANNEL-OP-REPLACE)))))
; select the border of our selection using feather
(define border-select (lambda (img fuzz)
  (let*
    (
      (ch1 (car (gimp-selection-save img))))
    (list
      (gimp-selection-feather img fuzz)
      (let*
        (
          (ch2 (car (gimp-selection-save img))))
        (list
          (script-fu-channel-grab img ch1 CHANNEL-OP-REPLACE)
          (gimp-selection-invert img)
          (gimp-selection-feather img fuzz)
          (script-fu-channel-grab img ch2 CHANNEL-OP-INTERSECT)))))))
; remove a (temporary) channel after applying it as a selection
(define script-fu-channel-grab (lambda (img ch op)
  (list
    (gimp-image-select-item img op ch)
    (gimp-image-remove-channel img ch))))