Basic GD vertices test

test_01.cljs

(ns gampg.perf.test-01
    (:require [gamma.api :as g]
              [gamma.program :as p]
              [gamma-driver.api :as gd]
              [gamma-driver.drivers.basic :as driver]
              [thi.ng.geom.core :as geom]
              [thi.ng.geom.core.matrix :as mat :refer [M44]]))

(def title
  "1. Testing basic performance")

(def u-p-matrix
  (g/uniform "uPMatrix" :mat4))

(def u-mv-matrix
  (g/uniform "uMVMatrix" :mat4))

(def a-position
  (g/attribute "aVertexPosition" :vec3))

(def a-color
  (g/attribute "aVertexColor" :vec4))

(def v-color
  (g/varying "vColor" :vec4 :mediump))

(def program-source
  (p/program
   {:vertex-shader   {(g/gl-position) (-> u-p-matrix
                                          (g/* u-mv-matrix)
                                          (g/* (g/vec4 a-position 1)))
                      v-color         a-color}
    :fragment-shader {(g/gl-frag-color) v-color}}))

(def program-white
  (p/program
   {:vertex-shader   {(g/gl-position) (-> u-p-matrix
                                          (g/* u-mv-matrix)
                                          (g/* (g/vec4 a-position 1)))}
    :fragment-shader {(g/gl-frag-color) (g/vec4 1 1 1 1)}}))

(defn get-data [p mv vertices vertex-colors]
  {u-p-matrix  p
   u-mv-matrix mv
   a-position  vertices
   a-color     vertex-colors})

(defn random-triangles [cnt]
  (let [vertices     (mapcat (fn [_] [(- (rand 50)) (- (rand 50)) (- (rand 50))]) (range cnt))
        colors       (mapcat (fn [_] [(rand) (rand) (rand) 1]) (range cnt))
        vertex-array (object-array vertices)
        color-array  (object-array colors)]
    {:vertices {:id         :triangle-vertices
                :data       (js/Float32Array. vertex-array)
                :count      (/ (count vertices) 3)
                :immutable? true}
     :colors   {:id         :triangle-colors
                :data       (js/Float32Array. color-array)
                :count      (/ (count colors) 4)
                :immutable? true}}))

(defn get-perspective-matrix
  "Be sure to 
   1. pass the .-clientWidth and .-clientHeight of the canvas *node*, not
      the GL context
   2. (set! (.-width/height canvas-node)
      width/height), respectively, or you may see no results, or strange
      results"
  ([fov width height]
   (mat/perspective fov (/ width height) 0.01 100))
  ([fov width height near far]
   (mat/perspective fov (/ width height) near far)))

;; js/window.requestAnimationFrame doesn't take arguments, so we have
;; to store the state elsewhere - in this atom, for example.
(defn app-state [width height]
  {:last-rendered 0
   :scene         {:triangles (time (random-triangles 100000))
                   :mv        (mat/matrix44)
                   :rotation  0
                   :p         {:data       (get-perspective-matrix 45 width height)
                               :immutable? true
                               :id         :p}}})

(defn draw-fn [gl driver programs]
  (fn [state]
    (.clear gl (bit-or (.-COLOR_BUFFER_BIT gl) (.-DEPTH_BUFFER_BIT gl)))
    (let [{:keys [p mv triangles rotation]} (:scene state)
          mv                                (-> mv
                                                (geom/rotate-y rotation)
                                                (geom/translate [0 18 -40]))
          bind-data                         (get-data p mv (:vertices triangles) (:colors triangles))
          program                           (:color programs)]
      (gd/bind driver program bind-data)
      (gd/draw-arrays driver program {:draw-mode :triangle-strip}))))

(defn animate [continue-animation? draw-fn step-fn current-value]
  (when @continue-animation?
    (js/requestAnimationFrame
     (fn [time]
       (let [next-value (step-fn time current-value)]
         (draw-fn next-value)
         (animate continue-animation? draw-fn step-fn next-value))))))

(defn tick
  "Takes the old world value and produces a new world value, suitable
  for rendering"
  [time state]
  ;; We get the elapsed time since the last render to compensate for
  ;; lag, etc.
  (let [time-now      (.getTime (js/Date.))
        elapsed       (- time-now (:last-rendered state))
        rotation-diff (/ (* 50 elapsed) 100000)]
    (-> state
        (update-in [:scene :rotation] + rotation-diff)
        (assoc-in [:last-rendered] time-now))))

(defn reset-gl-canvas! [canvas-node]
  (let [gl     (.getContext canvas-node "webgl")
        width  (.-clientWidth canvas-node)
        height (.-clientHeight canvas-node)]
    ;; Set the width/height (in terms of GL-resolution) to actual
    ;; canvas-element width/height (or else you'll see blurry results)
    (set! (.-width canvas-node) width)
    (set! (.-height canvas-node) height)
    ;; Setup GL Canvas
    (.viewport gl 0 0 width height)))

(defn main [_ node]
  (let [gl                  (.getContext node "webgl")
        width               (.-clientWidth node)
        height              (.-clientHeight node)
        driver              (driver/basic-driver gl)
        color-program       (gd/program driver program-source)
        white-program       (gd/program driver program-white)
        state               (app-state width height)
        continue-animation? (atom true)
        exit!               #(do
                               (js/console.log "Stopping animation!")
                               (reset! continue-animation? false))
        handlers            {:exit exit!}]
    (reset-gl-canvas! node)
    (.enable gl (.-DEPTH_TEST gl))
    (.clearColor gl 0 0 0 1)
    (.clear gl (bit-or (.-COLOR_BUFFER_BIT gl) (.-DEPTH_BUFFER_BIT gl)))
    (animate continue-animation? (draw-fn gl driver {:color color-program
                                                     :white white-program}) tick state)
    handlers))

(def explanation
  nil)

(def summary
  {:title       title
   :enter       main
   :explanation explanation})