77 lines
3 KiB
Common Lisp
77 lines
3 KiB
Common Lisp
(in-package #:se.kth.stacken.nya-balken)
|
|
|
|
;;; Parameters
|
|
(defparameter edge-width 26)
|
|
(defparameter edge-height 1)
|
|
|
|
(defparameter background-width 24)
|
|
(defparameter background-height 8)
|
|
|
|
(defparameter slope-height 1)
|
|
(defparameter slope-x-offset (/ (- edge-width background-width) 2))
|
|
|
|
(defparameter font-size 6)
|
|
(defparameter text-width 20.4)
|
|
|
|
(defparameter edge-color "#ad0000")
|
|
(defparameter background-color "#ad0000")
|
|
(defparameter slope-color "#860000")
|
|
|
|
(defun make-stacken-text ()
|
|
(labels ((make-span (text spacing)
|
|
(xmls:make-node :name "tspan" :attrs `(("style" ,(format nil "letter-spacing:~A" spacing)))
|
|
:child text)))
|
|
(let ((subspans (list (make-span "S" "-0.01em")
|
|
(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
|
|
(+ edge-height slope-height
|
|
(/ font-size 1.375) (/ background-height 4))))
|
|
;;("class" "stacken-wordmark")
|
|
)
|
|
: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)))
|