(in-package #:se.kth.stacken.nya-balken)

(defun xmlfloat (number)
  (format nil "~A" (float number)))

(defun make-point (x y)
  (format nil " ~D,~D" x y))

(defun make-svg (shapes &rest attrs)
  (xmls:write-xml
   (xmls:make-node :name "svg"
                   :attrs (append '(("xmlns" "http://www.w3.org/2000/svg"))
                                  attrs)
                   :children shapes)
   nil))

(defun make-font-style (name filespec)
  (let (font)
    (with-open-file (stream filespec :element-type '(unsigned-byte 8))
      (let ((font-bytes (make-array (file-length stream) :element-type '(unsigned-byte 8))))
        (read-sequence font-bytes stream)
        (setf font (cl-base64:usb8-array-to-base64-string font-bytes))))
    (xmls:make-node :name "style"
                    :child (format nil "@font-face{font-family:\"~A\";src:url(data:application/font-woff;charset=utf-8;base64,~A) format(\"woff2\")}"
                                   name
                                   font))))

(defparameter *fill-color* "#f00")
(defparameter *line-color* "none")

(defun make-polygon (points &key (color-fill *fill-color*) (color-line *line-color*)
                              children)
  (let ((points-string (subseq (apply 'concatenate 'string points) 1)))
    (xmls:make-node :name "polygon" :attrs `(("fill" ,color-fill)
                                             ("stroke" ,color-line)
                                             ("points" ,points-string))
                    :children children)))

(defun make-rect (x y w h &key (color-fill *fill-color*) (color-line *line-color*)
                            children)
  (make-polygon (list
                 (make-point x y)
                 (make-point (+ x w) y)
                 (make-point (+ x w) (+ y h))
                 (make-point x (+ y h)))
                :color-fill color-fill :color-line color-line
                :children children))

(defun make-trapezoid (x y top-width height bottom-width
                       &optional (color-fill *fill-color*) (color-line *line-color*))
  (let* ((bottom-offset (/ (- top-width bottom-width) 2)))
    (make-polygon (list
                   (make-point x y)
                   (make-point (+ x top-width) y)
                   (make-point (+ x bottom-width bottom-offset)
                               (+ y height))
                   (make-point (+ x bottom-offset)
                               (+ y height)))
                  :color-fill color-fill :color-line color-line)))

(defvar *shapes* '())

(defun add (shape)
  (push shape *shapes*))