lewitt.hy

(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))
)))))