Skip to content

Instantly share code, notes, and snippets.

@rm-hull rm-hull/polyhedra.cljs
Last active Aug 29, 2015

Embed
What would you like to do?
Explore a variety of polyhedric solids: ClojureScript demo using big-bang for orchestration between GUI components, and the wireframes library for 3D rendering. The polygon data files are derived from http://www.netlib.org/polyhedra/, and read using abstractions over XmlHttpRequests and core.async. NOTE: Some of the shape files do not have prope…
(ns polyhedra.examples.demo
(:refer-clojure :exclude [identity])
(:require-macros
[cljs.core.async.macros :refer [go]]
[dommy.macros :refer [sel1 node]])
(:require
[clojure.string :refer [split-lines]]
[cljs.core.async :refer [chan <! >!]]
[dommy.core :refer [insert-after!]]
[enchilada :refer [ctx canvas canvas-size proxy-request]]
[wireframes.renderer.canvas :refer [draw-solid ->canvas]]
[wireframes.renderer.color :refer [wireframe solid]]
[wireframes.transform :refer [combine rotate scale translate identity degrees->radians]]
[wireframes.shapes.primitives :refer [transform-shape center-at-origin]]
[big-bang.core :refer [big-bang]]
[big-bang.components :refer [dropdown slider color-picker]]
[dataview.loader :refer [fetch-blob fetch-text]]
[dataview.ops :refer [create-reader]]
[polyhedra.core :refer [shape-spec]]
[jayq.core :refer [show]]))
(def width (first (canvas-size)))
(def height (second (canvas-size)))
(def url-prefix "https://raw.github.com/rm-hull/polyhedra/master/resources/netlib/")
(defn shapes> [dest-chan]
(let [src-chan (chan 1)]
(go
(loop []
(when-let [msg (<! src-chan)]
(->>
(:polyhedra msg)
(str url-prefix)
proxy-request
fetch-blob
<!
create-reader
shape-spec
center-at-origin
(hash-map :shape)
(>! dest-chan))
(recur))))
src-chan))
(defn to-keyword> [dest-chan]
(let [src-chan (chan 1)]
(go
(loop []
(when-let [msg (<! src-chan)]
(>! dest-chan (update-in msg [:style] keyword))
(recur))))
src-chan))
(defn color-fn [style color]
(condp = style
:transparent (wireframe color style)
:translucent (wireframe color style)
:opaque (wireframe color style)
:shaded (solid color)))
(def transform
(memoize
(fn [x y z depth offset?]
(combine
(if offset? (translate 1.17 2.28 0) identity)
(rotate :x (degrees->radians x))
(rotate :y (degrees->radians y))
(rotate :z (degrees->radians z))
(translate 0 0 depth)))))
(def styles (map name [:transparent :translucent :opaque :shaded]))
(def initial-state
{:depth 12
:focal-length 3
:style (second styles)
:color "#EAF5FC"
:offset? false
:x 0
:y 0
:z 0 })
(defn render-shape
"Draws the shape at the given state of the world (the x,y,z rotation angles)"
[{:keys [shape style color focal-length depth offset? x y z]}]
(when shape
(set! (.-fillStyle ctx) "rgba(255,255,255,0.75")
(.fillRect ctx 0 0 width height)
((->canvas ctx)
(partial draw-solid
{:style style
:focal-length focal-length
:color-fn (color-fn style color)
:shape shape
:transform (transform x y z depth offset?)})
[width height])))
(defn update-state
"Increment/decrement the rotation angles around the x,y and z axes"
[event {:keys [x y z] :as world-state}]
(->
world-state
(assoc :x (+ x 0.3))
(assoc :y (- y 0.7))
(assoc :z (+ z 0.5))))
(defn not-well-formed? [shape]
(nil? (:polygons shape)))
(defn handle-incoming-msg [event world-state]
(when (and (:shape event) (not-well-formed? (:shape event)))
(js/alert
(str
"Shape '" (get-in event [:shape :name])
"' is not a well-formed 3D solid: please try another.")))
(merge world-state event))
(defn start []
(let [updates-chan (chan 1)]
(go
(let [catalog-url (proxy-request (str url-prefix "names.txt"))
names (vec (split-lines (<! (fetch-text catalog-url))))]
(->>
(sel1 :#canvas-area)
(insert-after! (node
[:div
[:div
(dropdown
:id :polyhedra
:label-text " Polyhedra:"
:initial-value (rand-int (count names))
:options (zipmap (iterate inc 0) names)
:send-channel (shapes> updates-chan))
(dropdown
:id :style
:label-text " Style:"
:initial-value (:style initial-state)
:options (zipmap styles styles)
:send-channel (to-keyword> updates-chan))
(color-picker
:id :color
:label-text " Color:"
:initial-value (:color initial-state)
:send-channel updates-chan)]
[:div
(slider
:id :focal-length
:label-text " Focal Length:"
:initial-value (:focal-length initial-state)
:min-value 1
:max-value 25
:send-channel updates-chan)
(slider
:id :depth
:label-text " Z-Depth:"
:initial-value (:depth initial-state)
:min-value 0
:max-value 50
:send-channel updates-chan)]])))))
(big-bang
:initial-state initial-state
:on-tick update-state
:to-draw render-shape
:receive-channel updates-chan
:on-receive handle-incoming-msg)))
(set! (.-fillStyle ctx) "white")
(.fillRect ctx 0 0 width height)
(show canvas)
(start)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.