(import scheme)
(import (chicken base))
(import (chicken port))
(import (chicken process-context))
(import imlib2)
(import scsh-process)

(define blur-radius 100)
(define block-size 48)

(define (average-color img x1 y1 x2 y2)
  (define (->u8 x) (min (inexact->exact (round x)) 255))
  (let* ((width (- x2 x1))
         (height (- y2 y1))
         (size (* width height)))
    (let loop ((reds 0)
               (greens 0)
               (blues 0)
               (alphas 0)
               (i 0))
      (if (< i size)
          (let* ((row (quotient i width))
                 (column (remainder i width))
                 (x (+ x1 column))
                 (y (+ y1 row)))
            (receive
             (red green blue alpha)
             (image-pixel/rgba img x y)
             (loop (+ reds red)
                   (+ greens green)
                   (+ blues blue)
                   (+ alphas alpha)
                   (add1 i))))
          (color/rgba (->u8 (/ reds size))
                      (->u8 (/ greens size))
                      (->u8 (/ blues size))
                      (->u8 (/ alphas size)))))))

(define (pixellate in-path out-path)
  (let* ((src (image-load in-path))
         (width (image-width src))
         (height (image-height src))
         (rows (ceiling (/ height block-size)))
         (columns (ceiling (/ width block-size)))
         (dest (image-create width height)))
    (image-blur! src blur-radius)
    (do ((row 0 (+ row 1)))
        ((= row rows))
      (do ((column 0 (+ column 1)))
          ((= column columns))
        (let* ((x1 (* column block-size))
               (y1 (* row block-size))
               (x2 (min (+ x1 block-size) width))
               (y2 (min (+ y1 block-size) height))
               (color (average-color src x1 y1 x2 y2)))
          (image-fill-rectangle dest color x1 y1 block-size block-size))))
    (image-save dest out-path)))

(define (stringify x)
  (call-with-output-string (lambda (out) (write x out))))

(define (gimp-commands in-path out-path)
  (stringify
   `(let* ((image (car (gimp-file-load RUN-NONINTERACTIVE ,in-path ,in-path)))
           (drawable (car (gimp-image-get-active-layer image))))
      (plug-in-gauss RUN-NONINTERACTIVE image drawable ,blur-radius ,blur-radius 0)
      (plug-in-pixelize RUN-NONINTERACTIVE image drawable ,block-size)
      (gimp-file-save RUN-NONINTERACTIVE image drawable ,out-path ,out-path)
      (gimp-image-delete image)
      (gimp-quit 0))))

(define (pixellate-gimp in-path out-path)
  (run (gimp "-c" "-i" "-b" "-") (<< ,(gimp-commands in-path out-path))))

(define (main)
  (when (not (= (length (command-line-arguments)) 2))
    (display "Usage: pixellate <infile> <outfile>\n" (current-error-port))
    (exit 1))
  (apply pixellate (command-line-arguments)))

(main)