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

(define s (cairo-image-surface-create-from-png "gazette-chicken.png"))

(define c (cairo-create s))

(define text (string-append "\"" (string-upcase (second (argv))) "\""))

(define (text-width ctxt text font-size)
  (let ((ex (make-cairo-text-extents-type)))
    (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* ((w (text-width ctxt text font-size))
         (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 s #\space (if (< f (string-length s)) f 0))
             => (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))
        (width height (text-width c text font-size)))
    (cond ((< font-size 6)
           (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))
          ((> (* (+ (* 0.2 height) (length rs)) height) boundary-height )
           (find-rows-and-size c text boundary-width boundary-height (- font-size 2)))
          (else rs))))

(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:")

(for-each (lambda (t o)
            (cairo-move-to c 20 (+ 90 (* o 30)))
            (cairo-show-text c t))
          (find-rows-and-size c text 220.0 100 20)
          '(0 1 2 3))

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