(use cairo data-structures srfi-1 srfi-13)

(define s (cairo-image-surface-create-from-png "gazette-chicken.png"))
(define c (cairo-create s))
(define ex (make-cairo-text-extents-type))
(define text (string-append "\"" (string-upcase (second (argv))) "\""))

(define *spacing* 0.4)

(define (text-width ctxt text font-size)
  (cairo-set-font-size ctxt font-size)
  (cairo-text-extents ctxt text ex)
  (values (cairo-text-extents-width ex)
          (cairo-text-extents-height ex)))

(define (text->rows ctxt text max-width font-size)
  (let-values (((w) (text-width ctxt text font-size)))
              (let ((f (inexact->exact (floor (* (string-length text) (/ max-width w))))))
                (let loop ((s text)
                           (r '()))
                  (cond ((string-null? s) (reverse r))
                        ((< (text-width ctxt s font-size) max-width)
                         (loop "" (cons s r)))
                        ((string-index-right (string-take s (min f (string-length s))) #\space)
                         => (lambda (i)
                              (loop (string-drop s (add1 i))
                                    (cons (string-take s (add1 i))
                                          r))))
                        (else (loop "" (cons s r))))))))

(define (find-rows-and-size c text boundary-width boundary-height font-size)
  (let ((rs (text->rows c text boundary-width font-size)))
    (let-values (((width height) (text-width c text font-size)))
                (cond ((< font-size 10)
                       (printf "Error: String is still too long by ~a chars. And would be illegible.~%"
                               (fold (lambda (x s) (+ (string-length x) s))
                                     0
                                     (drop rs 4)))
                       (exit 1))
                      ((> (+
                           (* *spacing* height (length rs))
                           (* (length rs) height))
                          boundary-height)
                       (printf "Retrying with fs ~a (current height ~a, spacing ~a)~%" (- font-size 2)
                               height
                               (* *spacing* height))
                       (find-rows-and-size c text boundary-width boundary-height (- font-size 2)))
                      (else (values rs width height))))))

(cairo-select-font-face c "Impact" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)


(cairo-move-to c 20 50)
(cairo-set-source-rgba c 1 0 0 1)
(cairo-set-font-size c 30)
(cairo-show-text c "The chicken says:")

(let-values (((rs width height) (find-rows-and-size c text 220.0 100 20)))
            (for-each (lambda (t o)
                        (cairo-move-to c 20 (+ 90 (* o (+ height (* height *spacing*)))))
                        (cairo-show-text c t))
                      rs
                      (iota (length rs))))

(cairo-move-to c 20 200)
(cairo-set-font-size c 12)
(cairo-show-text c "brought to you by #chicken on freenode")

(cairo-surface-write-to-png s "foo.png")