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

;;; Parameters
(defparameter edge-width 24)
(defparameter edge-height 1)

(defparameter background-width 22)
(defparameter background-height 6)

(defparameter slope-height 1)
(defparameter slope-x-offset (/ (- edge-width background-width) 2))

(defparameter font-size 5.8)
(defparameter s-font-size 8.5)
(defparameter text-width 19.75)

(defparameter edge-color "#ad0000")
(defparameter background-color "#ad0000")
(defparameter slope-color "#860000")

(defun make-stacken-text ()
  (labels ((make-span (text spacing &optional font-size)
             (xmls:make-node :name "tspan" :attrs `(("style" ,(if font-size
                                                                  (format nil "font-size:~Dpx;letter-spacing:~A"
                                                                          font-size spacing)
                                                                  (format nil "letter-spacing:~A" spacing))))
                             :child text)))
    (let ((subspans (list (make-span "s" "-0.01em" s-font-size)
                          (make-span "t" "-0.05em")
                          (make-span "a" "-0.05em")
                          (make-span "cken" 0))))
      (xmls:make-node :name "tspan"
                      :attrs `(("style" ,(format nil "font:~Dpx rtxbsc;fill:white;text-anchor: middle"
                                                 font-size)))
                      :children subspans))))

(defun make-beam ()
  (let ((*shapes* nil))
    ;; Font
    (add (make-font-style "rtxbsc" "stacken.woff2"))
    (let ((*fill-color* edge-color))
      ;; Edges
      (add (make-rect 0 0 edge-width edge-height))
      (add (make-rect 0 (+ edge-height (* slope-height 2) background-height)
                      edge-width edge-height)))
    ;; Background and text
    (let ((*fill-color* background-color))
      (add (make-rect slope-x-offset (+ edge-height slope-height)
                      background-width background-height)))
    (add (xmls:make-node :name "text"
                         :attrs `(("x" ,(xmlfloat (/ edge-width 2)))
                                  ("y" ,(xmlfloat 7.2
                                         #+(or)
                                         (+ edge-height slope-height
                                            (/ font-size 1.375) (/ background-height 8)))))
                         :child (make-stacken-text)))
    ;; Slopes
    (let ((*fill-color* slope-color))
      (add (make-trapezoid 0 edge-height edge-width slope-height
                           background-width))
      (add (make-trapezoid slope-x-offset (+ edge-height slope-height background-height)
                           background-width slope-height
                           edge-width)))
    ;; Finalize
    (make-svg (nreverse *shapes*)
              `("viewbox"
                ,(format nil "~D ~D ~D ~D"
                         0 0
                         edge-width
                         (+ (* edge-height 2)
                            background-height
                            (* slope-height 2))))
              `("width" ,edge-width)
              `("height" ,(+ (* edge-height 2)
                             background-height
                             (* slope-height 2))))))

(defun main ()
  ;;(with-open-file (out "test.svg" :direction :output :if-exists :supersede))
  (write-string (make-beam)))