From 3ab1571add3e28f526b6e8297bb49587ce07ec45 Mon Sep 17 00:00:00 2001 From: heyarne Date: Sat, 19 Feb 2022 18:57:30 +0100 Subject: [PATCH] Show image and generate palette via k-means --- deps.edn | 5 +- docs/uberdoc.html | 3105 ++++++++++++++++++++++++ src/heyarne/vanilla_sky/marginalia.clj | 40 + src/heyarne/vanilla_sky/tiptaps.clj | 89 +- 4 files changed, 3229 insertions(+), 10 deletions(-) create mode 100644 docs/uberdoc.html create mode 100644 src/heyarne/vanilla_sky/marginalia.clj diff --git a/deps.edn b/deps.edn index 044d9bd..777066e 100644 --- a/deps.edn +++ b/deps.edn @@ -1,3 +1,6 @@ {:deps {clojure2d {:mvn/version "1.4.0-SNAPSHOT"} enlive {:mvn/version "1.1.6"} - clj-http {:mvn/version "3.10.1"}}} + clj-http {:mvn/version "3.10.1"} + generateme/fastmath {:mvn/version "2.0.3"}} + :aliases {:docs {:extra-deps {marginalia {:mvn/version "0.9.1"}} + :main-opts ["-m" "heyarne.vanilla-sky.marginalia"]}}} diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..1e12783 --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3105 @@ + + -- Marginalia


+



(this space intentionally left almost blank)

namespaces

 

heyarne.vanilla-sky.tiptaps

toc
+
(ns heyarne.vanilla-sky.tiptaps)

this file contains the first steps. +we want to analyze pictures of cctv cameras. the thing we start with is +finding those pictures and loading them so we can manipulate them.

+

for some reason the generic example (using java.net.URL.) from the enlive +tutorial does not work, the pages return a 403 Forbidden, which is why we use +clj-http and parse the body directly:

+
+
(require '[clj-http.client :as http])
+(require '[net.cgrand.enlive-html :as html])
+(require 'hashp.core)
+
(defn fetch-url [url]
+  (future (html/html-snippet (:body (http/get url)))))

here are some hand-picked webcams: +colorado springs, usa: https://www.insecam.org/en/view/481423/ +salzburg, austria: https://www.insecam.org/en/view/540433/ +not madrid, spain: https://www.insecam.org/en/view/856408/ +florence, italy: https://www.insecam.org/en/view/866450/ +portoferaio, italy: https://www.insecam.org/en/view/870342/

+
+
(def some-detail-page
+  @(fetch-url "https://www.insecam.org/en/view/870342/"))
+
(def some-camera-image
+  (->
+   (html/select some-detail-page [:#image0])
+   (first)
+   (html/attr-values :src)
+   (first)))

cool! so we have the url of a camera image we chose randomly by fair dice +roll. we'll eventually have to think of a way to get a good camera image +dynamically but we can save that for later. for now let's load the +image and see what we can do with it.

+

with the image we encountered above, server-side push is implemented +using the multipart/mixed-replace header. this means that essentially the +connection is kept open and as soon as a complete chunk of data is received, +a browser would be replacing the currently displayed image with the new one. +we're only interested in the first chunk of data, so we need to figure out +how we can close the connection afterwards and discard the other ones.

+

Our approach is this: +- Convert the stream into a lazy sequence of bytes +- Partition the lazy sequence whenever you find (str "--" boundary) +- Select the part of the sequence you want

+
+
(defn input->byte-seq [input]
+  (lazy-seq (let [b (.read input)]
+              ;; -1 marks the end of the stream
+              (when (not= b -1)
+                (cons b (input->byte-seq input))))))
+
(comment
+  ;; Let's test this
+  (input->byte-seq (java.io.StringReader. "Hello World")))

This is a helper function we need later.

+

Returns the index of the first occurence of el in coll or nil if it's + not found.

+
(defn find-index
+  [el coll]
+  (first (keep-indexed #(when (= el %2) %1) coll)))

Partitions coll every time sep appears. The last item returned is + everything that follows after the last time sep was found

+
(defn partition-with-seq
+  [sep coll]
+  (lazy-seq
+   (when (seq coll)
+     (let [idx (find-index sep (partition (count sep) 1 coll))]
+       (if idx
+         (cons (take idx coll) (partition-with-seq sep (drop (+ idx (count sep)) coll)))
+         (list coll))))))

if you need a refresher what multipart messages look like: +https://www.w3.org/Protocols/rfc1341/72Multipart.html +We need this for mjpeg streams: https://en.wikipedia.org/wiki/MotionJPEG#M-JPEGover_HTTP

+
+
(defn parse-multipart-alternative [body]
+  (let [parsed (partition-with-seq (map int [\return \newline \return \newline]) body)]
+    {:header (apply str (map char (first parsed)))
+     :body (byte-array (apply concat (rest parsed)))}))
+
(defn parse-mixed-replace [request]
+  (let [content-type (get-in request [:headers "Content-Type"])
+        boundary (str "--" (second  (re-find #"boundary=(?:\")?(.*?)(?:\")?(;|$)" content-type)) "\r\n")]
+    (with-open [input (:body request)]
+      ;; find indices of the bytes between the first and second boundary; the byte
+      ;; sequence always starts with the boundary, which is why can skip the first
+      ;; byte and have this find the end index
+      (let [byte-seq (input->byte-seq input)
+            boundary-seq (map int boundary)]
+        ;; the multipart message is prepended by the boundary, so we discard the
+        ;; first (empty) split
+        (parse-multipart-alternative (second (partition-with-seq boundary-seq byte-seq)))))))
+
(defn parse-image [request]
+  (with-open [input (:body request)]
+    (byte-array (input->byte-seq input))))
+
(defmulti parse-response-body (fn [req]
+                                (second (re-find #"^(.*?)(;|$)" (get-in req [:headers "Content-Type"])))))
+
(defmethod parse-response-body "multipart/x-mixed-replace" [req]
+  (:body (parse-mixed-replace req)))
+
(defmethod parse-response-body "image/jpeg" [req]
+  (parse-image req))
+
#_(ns-unmap *ns* 'parse-response-body)
+
+(defmethod parse-response-body :default [req]
+  (throw (IllegalArgumentException.
+          (str "No parser defined for content-type " (pr-str (get-in req [:headers "Content-Type"]))))))
+
(def webcam-picture (parse-response-body (http/get some-camera-image {:as :stream})))

we need javax to convert the byte array that is contained in the body of the +first multipart alternative to a BufferedImage that we can use +with Clojure2d.

+
+
(require '[clojure2d.core :as c2d])
+
(defn byte-array->image [bs]
+  (with-open [in (java.io.ByteArrayInputStream. bs)]
+    (javax.imageio.ImageIO/read in)))
+
(def img (byte-array->image webcam-picture))
+(def aspect-ratio (/ (c2d/width img) (c2d/height img)))
+
(def width (min 640 (c2d/width img)))
+(def height (int (/ width aspect-ratio)))
+
(def canvas (c2d/canvas width height))
+
(defn place-image [canvas img]
+  (c2d/with-canvas [c canvas]
+    (->> (c2d/resize img width height)
+         (c2d/image c))))
+
(place-image canvas img)
+
(c2d/show-window canvas "Webcam Image")

now that we have the image, let's generate the palette. +how about we start with some pixel sorting?

+
+
(require '[clojure2d.pixels :as pix])
+(require '[clojure2d.color :as col])
+(require '[clojure2d.extra.utils :as util])
+
(def playground (c2d/canvas (c2d/width canvas) (c2d/height canvas)))
+(place-image playground img)
+
  #_(let [pixels (pix/to-pixels canvas)]
+      (pix/set-canvas-pixels! canvas (pix/filter-channels pix/dilate pixels)))
+
+(pix/set-canvas-pixels!
+ playground
+ (let [filter (fn [p x y] (pix/get-color p x (+ y 75)))]
+   (binding [pix/*pixels-edge* :wrap]
+     (pix/filter-colors-xy filter (pix/to-pixels playground)))))
+
(defn hsv-colors [pixels]
+  (->>
+   (map #(-> (pix/get-color pixels %)
+             (col/to-HSV*)) (range (count pixels)))
+   (sort-by (juxt #(nth % 0) #(nth % 2) #(nth % 1)))))
+
(let [src (pix/to-pixels playground)
+      dst (pix/clone-pixels src)
+      sorted (->>
+              (hsv-colors src)
+              (sort-by (juxt #(nth % 1) #(nth % 0) #(nth % 2) ))
+              (map col/from-HSV*))]
+  (doseq [[idx col] (map-indexed vector sorted)]
+    (pix/set-color! dst idx col))
+  (pix/set-canvas-pixels! playground dst))
+
(c2d/show-window playground "Pixel Manipulation")

ok so that's how pixel access works in generl, quote straight forward. +how about we try some k-means clustering on the colors?

+
+
(require '[fastmath.core :as m])
+(require '[fastmath.clustering :as cluster])

white and black are oftentimes used for informational overlays. they aren't +really part of the scenery, except for some very dark or maybe very +hazy conditions.

+
+
(def colors (->> (hsv-colors (pix/to-pixels playground))
+                 (remove #{(col/color :white) (col/color :black)})))
+
(def palette
+  (->> (cluster/k-means colors 16)
+       (:representatives)
+       (map (comp col/from-HSV* col/color))
+       (sort-by (comp (juxt first last) col/to-HSB*))))
+
(util/show-palette palette)
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
  • heyarne.vanilla-sky.tiptaps
\ No newline at end of file diff --git a/src/heyarne/vanilla_sky/marginalia.clj b/src/heyarne/vanilla_sky/marginalia.clj new file mode 100644 index 0000000..221176f --- /dev/null +++ b/src/heyarne/vanilla_sky/marginalia.clj @@ -0,0 +1,40 @@ +(ns heyarne.vanilla-sky.marginalia + (:gen-class) + (:require [marginalia.parser :as p] + [marginalia.core :refer [run-marginalia find-processable-file-paths]] + [marginalia.html :refer [*resources*]] + [clojure.string :as str])) + +;; taken from https://gist.github.com/genmeblog/14a03bf7ee67f3435376e482e3981759 +(defn- code-block + "Create code block from given string `s`" + [s] + (str "\n```clojure\n" s "\n```\n\n")) + +(defn save-md + "Save markdown built from clojure source" + [filename] + (let [target (str (second (re-find #"(.*)\.(\w+)$" filename)) ".md")] + (spit target "") + (doseq [{:keys [docstring raw form type] :as all} (p/parse-file filename)] + (spit target + (condp = type + :code (str docstring (code-block raw)) + :comment (if (str/starts-with? raw "=>") + (str "Result:" (code-block raw)) + (str raw "\n\n"))) + :append true)))) + +;; taken from https://github.com/gdeer81/marginalia/blob/master/src/marginalia/main.clj +(defn generate-html [sources] + (binding [*resources* ""] + (run-marginalia sources) + (shutdown-agents))) + +(defn -main [& sources] + (generate-html + (if (seq sources) + sources + (find-processable-file-paths "./src" #(re-find #"\.clj[sc]?$" %)))) + + #_(save-md (first args))) diff --git a/src/heyarne/vanilla_sky/tiptaps.clj b/src/heyarne/vanilla_sky/tiptaps.clj index 40c8226..0821d1c 100644 --- a/src/heyarne/vanilla_sky/tiptaps.clj +++ b/src/heyarne/vanilla_sky/tiptaps.clj @@ -10,17 +10,20 @@ (require '[clj-http.client :as http]) (require '[net.cgrand.enlive-html :as html]) +(require 'hashp.core) (defn fetch-url [url] (future (html/html-snippet (:body (http/get url))))) ;; here are some hand-picked webcams: -;; colorado springs: https://www.insecam.org/en/view/481423/ -;; salzburg: https://www.insecam.org/en/view/540433/ -;; not madrid: https://www.insecam.org/en/view/856408/ +;; colorado springs, usa: https://www.insecam.org/en/view/481423/ +;; salzburg, austria: https://www.insecam.org/en/view/540433/ +;; not madrid, spain: https://www.insecam.org/en/view/856408/ +;; florence, italy: https://www.insecam.org/en/view/866450/ +;; portoferaio, italy: https://www.insecam.org/en/view/870342/ (def some-detail-page - @(fetch-url "https://www.insecam.org/en/view/856408/")) + @(fetch-url "https://www.insecam.org/en/view/870342/")) (def some-camera-image (-> @@ -77,6 +80,7 @@ ;; if you need a refresher what multipart messages look like: ;; https://www.w3.org/Protocols/rfc1341/7_2_Multipart.html +;; We need this for mjpeg streams: https://en.wikipedia.org/wiki/Motion_JPEG#M-JPEG_over_HTTP (defn parse-multipart-alternative [body] (let [parsed (partition-with-seq (map int [\return \newline \return \newline]) body)] @@ -127,10 +131,77 @@ (with-open [in (java.io.ByteArrayInputStream. bs)] (javax.imageio.ImageIO/read in))) -(def img (byte-array->image (:body first-multipart-chunk))) -(def canvas (c2d/canvas (c2d/width img) (c2d/height img))) +(def img (byte-array->image webcam-picture)) +(def aspect-ratio (/ (c2d/width img) (c2d/height img))) -(c2d/with-canvas [c canvas] - (c2d/image c img)) +(def width (min 640 (c2d/width img))) +(def height (int (/ width aspect-ratio))) -(c2d/show-window canvas "Hello World") +(def canvas (c2d/canvas width height)) + +(defn place-image [canvas img] + (c2d/with-canvas [c canvas] + (->> (c2d/resize img width height) + (c2d/image c)))) + +(place-image canvas img) + +(c2d/show-window canvas "Webcam Image") + +;; now that we have the image, let's generate the palette. +;; how about we start with some pixel sorting? + +(require '[clojure2d.pixels :as pix]) +(require '[clojure2d.color :as col]) +(require '[clojure2d.extra.utils :as util]) + +(def playground (c2d/canvas (c2d/width canvas) (c2d/height canvas))) +(place-image playground img) + + #_(let [pixels (pix/to-pixels canvas)] + (pix/set-canvas-pixels! canvas (pix/filter-channels pix/dilate pixels))) + +(pix/set-canvas-pixels! + playground + (let [filter (fn [p x y] (pix/get-color p x (+ y 75)))] + (binding [pix/*pixels-edge* :wrap] + (pix/filter-colors-xy filter (pix/to-pixels playground))))) + +(defn hsv-colors [pixels] + (->> + (map #(-> (pix/get-color pixels %) + (col/to-HSV*)) (range (count pixels))) + (sort-by (juxt #(nth % 0) #(nth % 2) #(nth % 1))))) + +(let [src (pix/to-pixels playground) + dst (pix/clone-pixels src) + sorted (->> + (hsv-colors src) + (sort-by (juxt #(nth % 1) #(nth % 0) #(nth % 2) )) + (map col/from-HSV*))] + (doseq [[idx col] (map-indexed vector sorted)] + (pix/set-color! dst idx col)) + (pix/set-canvas-pixels! playground dst)) + +(c2d/show-window playground "Pixel Manipulation") + +;; ok so that's how pixel access works in generl, quote straight forward. +;; how about we try some k-means clustering on the colors? + +(require '[fastmath.core :as m]) +(require '[fastmath.clustering :as cluster]) + +;; white and black are oftentimes used for informational overlays. they aren't +;; really part of the scenery, except for some very dark or maybe very +;; hazy conditions. + +(def colors (->> (hsv-colors (pix/to-pixels playground)) + (remove #{(col/color :white) (col/color :black)}))) + +(def palette + (->> (cluster/k-means colors 16) + (:representatives) + (map (comp col/from-HSV* col/color)) + (sort-by (comp (juxt first last) col/to-HSB*)))) + +(util/show-palette palette)