Skip to content

Instantly share code, notes, and snippets.

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

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, 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])
[cljs.core.async.macros :refer [go]]
[dommy.macros :refer [sel1 node]])
[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 "")
(defn shapes> [dest-chan]
(let [src-chan (chan 1)]
(loop []
(when-let [msg (<! src-chan)]
(:polyhedra msg)
(str url-prefix)
(hash-map :shape)
(>! dest-chan))
(defn to-keyword> [dest-chan]
(let [src-chan (chan 1)]
(loop []
(when-let [msg (<! src-chan)]
(>! dest-chan (update-in msg [:style] keyword))
(defn color-fn [style color]
(condp = style
:transparent (wireframe color style)
:translucent (wireframe color style)
:opaque (wireframe color style)
:shaded (solid color)))
(def transform
(fn [x y z depth offset?]
(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}]
(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)))
"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)]
(let [catalog-url (proxy-request (str url-prefix "names.txt"))
names (vec (split-lines (<! (fetch-text catalog-url))))]
(sel1 :#canvas-area)
(insert-after! (node
:id :polyhedra
:label-text " Polyhedra:"
:initial-value (rand-int (count names))
:options (zipmap (iterate inc 0) names)
:send-channel (shapes> updates-chan))
:id :style
:label-text " Style:"
:initial-value (:style initial-state)
:options (zipmap styles styles)
:send-channel (to-keyword> updates-chan))
:id :color
:label-text " Color:"
:initial-value (:color initial-state)
:send-channel updates-chan)]
:id :focal-length
:label-text " Focal Length:"
:initial-value (:focal-length initial-state)
:min-value 1
:max-value 25
:send-channel updates-chan)
:id :depth
:label-text " Z-Depth:"
:initial-value (:depth initial-state)
:min-value 0
:max-value 50
:send-channel updates-chan)]])))))
: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)
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.