(import scheme)
(import (chicken base))
(import (chicken condition))
(import (chicken process-context))
(import cairo)

(define scale 4)
(define size 100)
(define surface
  (cairo-image-surface-create CAIRO_FORMAT_RGB24 (* size scale) (* size scale)))
(define ctx (cairo-create surface))

(define black '(0 0 0))
(define cyan '(0 1 1))
(define magenta '(1 0 1))
(define white '(1 1 1))

(define (clear-graphics)
  (apply cairo-set-source-rgb ctx white)
  (cairo-rectangle ctx 0 0 (* size scale) (* size scale))
  (cairo-fill ctx))

(define pen-color (make-parameter 0))

(define (pen-color->color pen)
  (case pen
    ((0) black)
    ((1) cyan)
    ((2) magenta)
    ((3) white)))

(define (set-pen-color! color)
  (when (not (<= 0 color 3))
    (error "invalid pen color"))
  (pen-color color))

(define (draw-point x y)
  (when (not (and (>= x 0) (< x size)
                  (>= y 0) (< y size)))
    (error "out of bounds"))
  (let ((color (pen-color->color (pen-color)))
        (x (* x scale))
        (y (* y scale))
        (w scale)
        (h scale))
    (apply cairo-set-source-rgb ctx color)
    (cairo-rectangle ctx x y w h)
    (cairo-fill ctx)))

(define (clear-point x y)
  (parameterize ((pen-color 3))
    (draw-point x y)))

(define (save!)
  (cairo-surface-write-to-png surface "out.png"))

(define (quit!)
  (cairo-surface-destroy surface)
  (cairo-destroy ctx))

(on-exit quit!)

(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (quit!)
     (original-handler exception))))

(define screen-region-left-x 0)
(define screen-region-bottom-y 0)

(define (pixel-x-distance pixel-x)
  (- pixel-x screen-region-left-x))

(define (pixel-y-distance pixel-y)
  (- pixel-y screen-region-bottom-y))

(define (matching-x pixel-x square-left-x square-side-length)
  (+ square-left-x (* square-side-length
                      (/ (pixel-x-distance pixel-x) size))))

(define (matching-y pixel-y square-bottom-y square-side-length)
  (+ square-bottom-y (* square-side-length
                      (/ (pixel-y-distance pixel-y) size))))

(define (set-this-pixel? pix-x pix-y sq-left-x sq-bottom-y sq-side-length)
  (even?
   (inexact->exact
    (truncate
     (+ (expt (matching-x pix-x sq-left-x sq-side-length) 2)
        (expt (matching-y pix-y sq-bottom-y sq-side-length) 2))))))

(define (single-row-loop row-y column-x sq-left-x sq-bottom-y sq-side-length)
  (if (= (- column-x screen-region-left-x) size)
      row-y
      (begin
        (if (set-this-pixel?
             column-x row-y sq-left-x sq-bottom-y sq-side-length)
            (draw-point column-x row-y)
            (clear-point column-x row-y))
        (single-row-loop row-y (add1 column-x)
                         sq-left-x sq-bottom-y sq-side-length))))

(define (single-row-loop row-y column-x sq-left-x sq-bottom-y sq-side-length)
  (if (= (- column-x screen-region-left-x) size)
      row-y
      (begin
        (set-pen-color!
         (choose-pen-color
          column-x row-y sq-left-x sq-bottom-y sq-side-length))
        (draw-point column-x row-y)
        (single-row-loop
         row-y (add1 column-x) sq-left-x sq-bottom-y sq-side-length))))

(define (choose-pen-color pix-x pix-y sq-left-x sq-bottom-y sq-side-length)
  (remainder
   (inexact->exact
    (truncate
     (+ (expt (matching-x pix-x sq-left-x sq-side-length) 2)
        (expt (matching-y pix-y sq-bottom-y sq-side-length) 2))))
   4))

(define (region-loop row-y sq-left-x sq-bottom-y sq-side-length)
  (when (not (= (- row-y screen-region-bottom-y) size))
    (single-row-loop
     row-y screen-region-left-x
     sq-left-x sq-bottom-y sq-side-length)
    (region-loop (add1 row-y) sq-left-x sq-bottom-y sq-side-length)))

(define (circle-squared sq-left-x sq-bottom-y sq-side-length)
  (clear-graphics)
  (region-loop
   screen-region-bottom-y sq-left-x sq-bottom-y sq-side-length))

(define default-params '(-10 -10 20))

(if (pair? (command-line-arguments))
    (apply circle-squared (map string->number (command-line-arguments)))
    (apply circle-squared default-params))

(save!)