Skip to content

Instantly share code, notes, and snippets.

@paultag
Last active April 29, 2018 20:44
Show Gist options
  • Save paultag/3184e7d6d58972f37411c2055c3995b0 to your computer and use it in GitHub Desktop.
Save paultag/3184e7d6d58972f37411c2055c3995b0 to your computer and use it in GitHub Desktop.
(import lxml.etree sys itertools)
(setv unit "mm")
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn -in-unit [val] (.format "{}{}" val unit))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn node [name attrs &rest children]
(setv el (apply lxml.etree.Element [name] attrs))
(el.extend children)
el)
(defn svg [width height &rest children]
(apply node (+ ["svg" {"width" (-in-unit width)
"height" (-in-unit height)}] (list children))))
(defn line [(, x1 y1) (, x2 y2) style &rest children]
(style.update {"x1" (-in-unit x1)
"y1" (-in-unit y1)
"x2" (-in-unit x2)
"y2" (-in-unit y2)})
(apply node (+ ["line" style] (list children))))
(defn rect [(, x y) width height style &rest children]
(style.update {"x" (-in-unit x)
"y" (-in-unit y)
"width" (-in-unit width)
"height" (-in-unit height)})
(apply node (+ ["rect" style] (list children))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn vertical-lines [width height count style]
(setv line-width (/ width count))
(for [i (range 0 count 2)]
(setv x (* i line-width))
(yield (, (, x 0) (, x height)))))
(defn horz-lines [width height count style]
(setv line-height (/ height count))
(for [i (range 0 count 2)]
(setv y (* i line-height))
(yield (, (, 0 y) (, width y)))))
(defn horz-lines [width height count style]
(setv line-height (/ height count))
(for [i (range 0 count 2)]
(setv y (* i line-height))
(yield (, (, 0 y) (, width y)))))
(defn l-diag-lines [width height count style]
(setv line-height (/ height count))
(setv line-width (/ width count))
(for [i (range 0 count 2)]
(setv x (* i line-height))
(setv y (* i line-height))
(yield (, (, x 0) (, 0 y)))
(yield (, (, x height) (, width y)))))
(defn r-diag-lines [width height count style]
(setv line-height (/ height count))
(setv line-width (/ width count))
(for [i (range 1 count 2)]
(setv x (* i line-width))
(setv y (* i line-height))
(yield (, (, x 0) (, width (- height y))))
(yield (, (, 0 y) (, (- width x) height)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn transformer [iter x y]
(for [(, (, x1 y1) (, x2 y2)) iter]
(yield (, (, (+ x x1) (+ y y1))
(, (+ x x2) (+ y y2))))))
(defn liner [iter style]
(for [(, origin dest) iter]
(yield (line origin dest style))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro create-lines [line-style &rest pipeline]
`(-> ~@pipeline (liner line-style) list))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn layer [width height count x y line-style methods]
(for [method methods]
(yield-from (create-lines line-style
(method width height count line-style)
(transformer x y)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(setv line-style {"stroke-width" "0.1mm" "stroke" "#000000" "fill-opacity" "0"})
(setv width 200)
(setv height 200)
(setv count 100)
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn generate-layer-seq [i]
(for [(, k v) (.items {1 horz-lines
2 vertical-lines
4 r-diag-lines
8 l-diag-lines})]
(if (!= (& k i) 0)
(yield v))))
(defn generate-layers []
(for [i (range 1 16)]
(yield (list (generate-layer-seq i)))))
(defn place-layers [width height box-width box-height pad]
(setv t-box-width (+ box-width pad))
(setv t-box-height (+ box-height pad))
(setv per-row (/ width t-box-width))
(defn offsetter []
(for [i (itertools.count)]
(yield (, (* t-box-width (int (% i per-row)))
(* t-box-height (int (/ i per-row)))))))
(zip (generate-layers) (offsetter)))
(defn place-boxen [width height box-width box-height padding count line-style]
(for [(, methods (, x y)) (place-layers width height box-width box-height padding)]
(yield (rect (, x y) box-width box-height line-style))
(yield-from (layer box-width box-height count x y line-style methods))))
;;;;;;;;;;;;;;;;;;;;;;;;;;
(sys.stdout.write (.decode (lxml.etree.tostring (apply svg (+ [width height]
(list (place-boxen width height 40 40 10 count line-style))
)))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment