; Generate keys
(import (scheme char)
        (chibi)
        (chibi string)
        (chibi sxml)
        (srfi 1)
        (srfi 9)
        (srfi 41))

(define-record-type :glyph
  (glyph char font size color style)
  glyph?
  (char  glyph-char  glyph-set-char!)
  (font  glyph-font  glyph-set-font!)
  (size  glyph-size  glyph-set-size!)
  (color glyph-color glyph-set-color!)
  (style glyph-style glyph-set-style!))

; Load here the glyphs you need, the only ones that are more or less defined
; are the English ones
(load "glyphs/ru.scm")

(define a4-size '(297 . 210))
(define a5-size '(210 . 148))
(define a6-size '(148 . 105))
(define a7-size '(105 . 74))

(define page-size a6-size)

(define x car)
(define y cdr)
(define num number->string)
(define (mm i)
  (string-append (num i) "mm"))


; Move this to a configuration file or something
(define sticker-radius 4); mm
(define style (string-append
"
text {
  stroke: black;
  stroke-width: 0.01;
}
.cuts {
  fill: none;
  stroke-width: 0.1;
  stroke: grey;
}
"))


(define (honeycomb sticker-radius top-left bottom-right spacing)
  "Return a function that generates positions for the stickers of size
  `sticker-radius` distributed in a box with `top-left` and `bottom-right`
  corners with `spacing` between them."
  (let* ((current-x (+ spacing sticker-radius (x top-left)))
         (current-y (+ spacing sticker-radius (y top-left)))
         (first #t))
    (lambda ()
      (if first
          (begin
            (set! first #f)
            (cons current-x current-y))
          (begin
            (set! current-x (+ spacing current-x (* 2 sticker-radius)))
            (if (> (+ current-x sticker-radius spacing)
                   (x bottom-right))
                (begin
                  (set! current-x (+ spacing sticker-radius (x top-left)))
                  (set! current-y (+ spacing current-y (* 2 sticker-radius)))
                  (if (> (+ current-y sticker-radius spacing)
                         (y bottom-right))
                      (error "Too many stickers for the provided space"))))
            (cons current-x current-y))))))

(define (circle cx cy r class)
  `(circle (@ (cx    ,cx)
              (cy    ,cy)
              (r     ,r)
              (class ,class))))

(define (rounded-rect cx cy w h r class)
  `(rect (@ (x  ,(- cx (/ w 2)))
            (y  ,(- cy (/ h 2)))
            (width  ,w)
            (height  ,h)
            (rx ,r)
            (ry ,r)
            (class ,class))))

(define (text-unpositioned glyph)
  "Returns a `text` object that is defined to be centered vertically and
  horizontally wrapped in a procedure that must be called to provide it the
  center position of the text. It gets a `glyph` record as an input."
  (lambda (cx cy)
    `(text (@ (x ,cx)
              (y ,cy)
              (style ,(string-append "font-style: "  (glyph-style glyph)
                                   "; font-size: "   (glyph-size  glyph)
                                   "; font-family: " (glyph-font  glyph)
                                   "; fill: "        (glyph-color glyph)))
              (text-anchor middle)
              (dominant-baseline central))
           ,(glyph-char glyph))))


(define stickers
  (let ((pos (honeycomb sticker-radius '(0 . 0) page-size 1)))
   (map
    (lambda (contents)
      (let ((position (pos)))
        (cons
          #;(circle
            (x position)
            (y position)
            sticker-radius
            "cuts")
          (rounded-rect
            (x position)
            (y position)
            (* 2 sticker-radius)
            (* 2 sticker-radius)
            1
            "cuts")
          (contents (x position) (y position)))))

    (map text-unpositioned glyphs))))


(define cuts     (map car stickers))
(define graphics (map cdr stickers))

(define (dump outport)
  (display
    "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>" outport)
  (display
    (sxml->xml
      `(svg (@ (version "1.1")
               (xmlns:inkscape "http://www.inkscape.org/namespaces/inkscape")
               (width   ,(mm (x page-size)))
               (height  ,(mm (y page-size)))
               (viewBox ,(string-append "0 0 " (num (x page-size))
                                        " "    (num (y page-size)))))
            (defs
              (style ,style))

         (g (@ (id cut)
               (inkscape:groupmode layer)
               (inkscape:label "Cortes"))
            ,@cuts)


         (g (@ (id graph)
               (inkscape:groupmode layer)
               (inkscape:label "Gráficos"))
            ,@graphics)))

    outport))



(define args (cdr (command-line)))

(if (< 0 (length args))
  (call-with-output-file (car args) dump)
  (dump (current-output-port)))