80 lines
3.3 KiB
Common Lisp
80 lines
3.3 KiB
Common Lisp
(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)))
|