glass-box.cljs

(ns big-bang.examples.glass-box
  (:require-macros
    [cljs.core.async.macros :refer [go]]
    [dommy.macros :refer [sel1 node]])
  (:require
    [cljs.core.async :refer [chan <! >!]]
    [big-bang.core :refer [big-bang]]
    [big-bang.events.browser :refer [prevent-default]]
    [dataview.loader :refer [fetch-image]]
    [enchilada :refer [webgl proxy-request]]
    [jayq.core :refer [show]]))

(def texture-uri
  "https://raw.githubusercontent.com/asakeron/cljs-webgl/master/examples/learningwebgl/glass.gif")

(def initial-state {
  :x-rotation 0
  :y-rotation 0
  :x-speed 3
  :y-speed -3
  :z-depth -5.0
  :keypresses {}})

(defn key-down-handler [event world-state]
  (let [key-code (.-keyCode event)]
    (when (contains? #{33 34 38 40} key-code)
      (prevent-default event))

    (assoc-in world-state [:keypresses key-code] true)))

(defn key-up-handler [event world-state]
  (let [key-code (.-keyCode event)]
    (assoc-in world-state [:keypresses key-code] false)))


(defn input-handler [world-state]
  (let [key-codes (:keypresses world-state)
        process-keycode (fn [state pressed-keycode keyword f & args]
                          (if (key-codes pressed-keycode)
                            (update-in state [keyword] f args)
                            state))]
    (->
      world-state
      (process-keycode 33 :z-depth #(- % 0.05)) ; Page-Up
      (process-keycode 34 :z-depth #(+ % 0.05)) ; Page-Down
      (process-keycode 37 :y-speed inc)         ; Left
      (process-keycode 39 :y-speed dec)         ; Right
      (process-keycode 38 :x-speed inc)         ; Up
      (process-keycode 40 :x-speed dec))))      ; Down
      
(defn update-rotation [world-state]
 (->
   world-state
   (update-in [:x-rotation] + (* 0.1 (:x-speed world-state)))
   (update-in [:y-rotation] + (* 0.1 (:y-speed world-state)))))

(defn update-state [event world-state]
  (->
    world-state
    input-handler
    update-rotation))

(defn render [world-state]
  ; TODO
)



(go
  (let [gl-context nil ; TODO
        image (<! (fetch-image (proxy-request texture-uri)))
        texture nil ; TODO
        ]
    (show webgl)
    (big-bang
      :event-target webgl
      :initial-state initial-state
      :on-tick update-state
      :on-keydown key-down-handler
      :on-keyup key-up-handler
      :to-draw render)))

helpers.cljs

(ns big-bang.examples.glass-box.helpers
  (:require
    [vec3]
    [mat4]
    [cljs-webgl.typed-arrays :as ta]))

(defn get-perspective-matrix [gl]
  (let [{viewport-width :width,
         viewport-height :height} (get-viewport gl)]
    (mat4/perspective
      (mat4/create)
      45
      (/  viewport-width viewport-height)
      0.1
      100.0)))

(defn get-position-matrix [v]
  (let [m (mat4/create)]
    (mat4/identity m)
    (mat4/translate m m (clj->js v))))

(defn deg->rad [degrees]
  (/ (* degrees Math/PI) 180))

(defn checked? [element-id]
  (.-checked
    (.getElementById
      js/document
      element-id)))

(defn get-float [element-id]
  (js/parseFloat
    (.-value
      (.getElementById
        js/document
        element-id))))

(defn ambient-color []
  {:name "uAmbientColor"
   :type :vec3
   :values (ta/float32 [
              (get-float "ambientR")
              (get-float "ambientG")
              (get-float "ambientB")])})

(defn directional-color []
  {:name "uDirectionalColor"
   :type :vec3
   :values (ta/float32 [
              (get-float "directionalR")
              (get-float "directionalG")
              (get-float "directionalB")])})

(defn lighting-direction []
  (let [lighting-dir (ta/float32 [
                        (get-float "lightDirectionX")
                        (get-float "lightDirectionY")
                        (get-float "lightDirectionZ")])
        adjusted-dir (vec3/create)]

    (vec3/normalize adjusted-dir lighting-dir)
    (vec3/scale adjusted-dir adjusted-dir -1.0)

    {:name "uLightingDirection"
     :type :vec3
     :values adjusted-dir}))

(defn blending [use-blending?]
  (when use-blending?
    [{:name "uAlpha"
      :type :float
      :values (ta/float32 [(get-float "alpha")])}]))

(defn lighting [use-lighting?]
  (cons
    {:name "uUseLighting" :type :int :values (ta/int32 [(if use-lighting? 1 0)])}
    (when use-lighting?
      [(ambient-color) (lighting-direction) (directional-color) ])))

html.cljs

(ns big-bang.examples.glass-box.html)

(def aside-panel
  [:div.aside.extended
    [:input#blending {:type "checkbox" :checked true}]
    [:label {:for "blending"} "Use blending"]
    [:table
      [:tbody
        [:tr
          [:td "Alpha level"]
          [:td [:input#alpha {:type "text" :value "0.5"}]]]]]
    [:p]
    [:input#lighting {:type "checkbox" :checked true}]
    [:label {:for "lighting"} "Use lighting"]
    [:p "(Use cursor keys to spin the box and Page-Up/Down to zoom in/out)"]
    [:p]
    [:strong "Directional light"]
    [:table
      [:tbody
        [:tr
          [:td "Directional"]
          [:td "X:" [:input#lightDirectionX {:type "text" :value "-0.25"}]]
          [:td "Y:" [:input#lightDirectionY {:type "text" :value "-0.25"}]]
          [:td "Z:" [:input#lightDirectionZ {:type "text" :value "-1.0"}]]]
        [:tr
          [:td "Colour"]
          [:td "R:" [:input#directionalR {:type "text" :value "0.8"}]]
          [:td "G:" [:input#directionalG {:type "text" :value "0.8"}]]
          [:td "B:" [:input#directionalB {:type "text" :value "0.8"}]]]]]
    [:p]
    [:strong "Ambient light"]
    [:table
      [:tbody
        [:tr
          [:td "Colour"]
          [:td "R:" [:input#ambientR {:type "text" :value "0.2"}]]
          [:td "G:" [:input#ambientG {:type "text" :value "0.2"}]]
          [:td "B:" [:input#ambientB {:type "text" :value "0.2"}]]]]]])

(def fragment-shader [:script#shader-fs {:type "x-shader/x-fragment"}
  "
  precision mediump float;
  varying vec2 vTextureCoord;
  varying vec3 vLightWeighting;
  uniform float uAlpha;
  uniform sampler2D uSampler;

  void main(void) {
      vec4 textureColor = texture2D(uSampler, vec2(vTextureCoord.s, vTextureCoord.t));
      gl_FragColor = vec4(textureColor.rgb * vLightWeighting, textureColor.a * uAlpha);
  }
  "])

(def vertex-shader [:script#shader-vs {:type "x-shader/x-vertex"}
  "
  attribute vec3 aVertexPosition;
  attribute vec3 aVertexNormal;
  attribute vec2 aTextureCoord;

  uniform mat4 uMVMatrix;
  uniform mat4 uPMatrix;
  uniform mat3 uNMatrix;

  uniform vec3 uAmbientColor;

  uniform vec3 uLightingDirection;
  uniform vec3 uDirectionalColor;

  uniform bool uUseLighting;

  varying vec2 vTextureCoord;
  varying vec3 vLightWeighting;

  void main(void) {
      gl_Position = uPMatrix * uMVMatrix * vec4(aVertexPosition, 1.0);
      vTextureCoord = aTextureCoord;

      if (!uUseLighting) {
          vLightWeighting = vec3(1.0, 1.0, 1.0);
      } else {
          vec3 transformedNormal = uNMatrix * aVertexNormal;
          float directionalLightWeighting = max(dot(transformedNormal, uLightingDirection), 0.0);
          vLightWeighting = uAmbientColor + uDirectionalColor * directionalLightWeighting;
      }
  }
  "])


(def style [:style 
  "
  .aside {
    position: absolute;
    left: 550px;
    top: 200px;
    width: 200px;
    background: #222222;
    border-radius: 3px;
    padding: 15px;
  }
  
  .aside ul {
      margin: 0;
  }
  .aside ul li {
      margin-left: -15px;
  }
  
  .extended {
      width: 400px;
  }
  
  .extended input[type=text] {
      width: 50px;
  }
  
  .extended td {
      width: 90px;
      text-align: right;
  }
  "])

webgl.cljs

(ns big-bang.examples.glass-box.webgl
  (:require
    [WebGLUtils]
    [vec3]
    [mat3]
    [mat4]
    [big-bang.examples.glass-box.helpers :refer [get-perspective-matrix
                                  get-position-matrix deg->rad 
                                  ambient-color directional-color lighting-direction
                                  lighting blending checked?]]
    [cljs-webgl.buffers :refer [create-buffer clear-color-buffer clear-depth-buffer draw!]]
    [cljs-webgl.shaders :refer [get-attrib-location]]
    [cljs-webgl.constants.buffer-object :as buffer-object]
    [cljs-webgl.constants.capability :as capability]
    [cljs-webgl.constants.blending-factor-dest :as blending-factor-dest]
    [cljs-webgl.constants.draw-mode :as draw-mode]
    [cljs-webgl.constants.data-type :as data-type]
    [cljs-webgl.constants.texture-parameter-name :as texture-parameter-name]
    [cljs-webgl.constants.texture-filter :as texture-filter]
    [cljs-webgl.constants.webgl :as webgl]
    [cljs-webgl.texture :refer [create-texture]]
    [cljs-webgl.typed-arrays :as ta]))

(defn init-gl [canvas]
  (let [gl (get-context canvas)]
    (when-not gl
      (throw (js/Error. "Could not initialize WebGL")))
    gl))

(defn init-shaders [gl]
  (let [fragment-shader (get-shader gl "shader-fs")
        vertex-shader (get-shader gl "shader-vs")]
    (create-program gl fragment-shader vertex-shader)))

(def vertex-position-buffer
  (create-buffer gl
    (ta/float32 [
      ; Front face
      -1.0, -1.0,  1.0,
       1.0, -1.0,  1.0,
       1.0,  1.0,  1.0,
      -1.0,  1.0,  1.0,

      ; Back face
      -1.0, -1.0, -1.0,
      -1.0,  1.0, -1.0,
       1.0,  1.0, -1.0,
       1.0, -1.0, -1.0,

      ; Top face
      -1.0,  1.0, -1.0,
      -1.0,  1.0,  1.0,
       1.0,  1.0,  1.0,
       1.0,  1.0, -1.0,

      ; Bottom face
      -1.0, -1.0, -1.0,
       1.0, -1.0, -1.0,
       1.0, -1.0,  1.0,
      -1.0, -1.0,  1.0,

      ; Right face
       1.0, -1.0, -1.0,
       1.0,  1.0, -1.0,
       1.0,  1.0,  1.0,
       1.0, -1.0,  1.0,

      ; Left face
      -1.0, -1.0, -1.0,
      -1.0, -1.0,  1.0,
      -1.0,  1.0,  1.0,
      -1.0,  1.0, -1.0])
    buffer-object/array-buffer
    buffer-object/static-draw
    3))

(def vertex-normal-buffer
  (create-buffer gl
    (ta/float32 [
      ; Front face
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,

      ; Back face
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,

      ; Top face
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,

      ; Bottom face
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,

      ; Right face
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,

      ; Left face
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0])
    buffer-object/array-buffer
    buffer-object/static-draw
    3))

(def vertex-texture-coords-buffer
  (create-buffer gl
    (ta/float32 [
      ; Front face
      0.0, 0.0,
      1.0, 0.0,
      1.0, 1.0,
      0.0, 1.0,

      ; Back face
      1.0, 0.0,
      1.0, 1.0,
      0.0, 1.0,
      0.0, 0.0,

      ; Top face
      0.0, 1.0,
      0.0, 0.0,
      1.0, 0.0,
      1.0, 1.0,

      ; Bottom face
      1.0, 1.0,
      0.0, 1.0,
      0.0, 0.0,
      1.0, 0.0,

      ; Right face
      1.0, 0.0,
      1.0, 1.0,
      0.0, 1.0,
      0.0, 0.0,

      ; Left face
      0.0, 0.0,
      1.0, 0.0,
      1.0, 1.0,
      0.0, 1.0, ])
    buffer-object/array-buffer
    buffer-object/static-draw
    2))

(def vertex-indices
  (create-buffer gl
    (ta/unsigned-int16 [
      0, 1, 2,      0, 2, 3,      ; Front face
      4, 5, 6,      4, 6, 7,      ; Back face
      8, 9, 10,     8, 10, 11,    ; Top face
      12, 13, 14,   12, 14, 15,   ; Bottom face
      16, 17, 18,   16, 18, 19,   ; Right face
      20, 21, 22,   20, 22, 23])  ; Left face
    buffer-object/element-array-buffer
    buffer-object/static-draw
    1))