shady.clj

(ns shady
  (:require [clojure.string :as s]))

;; analyze 
;; break shader up into logical bits
;; right now just uniforms and main fn 
(def analysis {'uniform (fn [out form]
                          (update-in out [:uniforms] conj form))
               :default (fn [out form]
                          (update-in out [:fns :main] conj form))})

(defn analyze [sh]
  (reduce
    (fn [out form]
      (let [[head rest] form
            an (or (analysis head)
                   (analysis :default))]
        (an out form)))
    {:uniforms []
     :fns {:main []}}
    sh))

;; transform
;; transform ast to a fix point
;; turns higher level constructs into simpler glsl constructs
;; right now does nothing
(defn transform [sh]
  sh)

;; emit
;; emit glsl from s-expressions
;; at this point s-expressions should have near 1:1 mapping with glsl
(defn sh-str
  "Emit string suitable for GLSL"
  [s]
  (if (number? s)
    (pr-str s)
    (str s)))

(defn variadic-infix
  "Common pattern of (+ a b c) -> (a+b+c)"
  [[sym & args]]
  (str "(" (s/join sym (map sh-str args)) ")"))

(defn swizzle
  "Common pattern of (xy foo) -> foo.xy"
  [[swiz ident]]
  (str ident "." swiz))

(def emission {'uniform (fn [[_ t n]]
                          (str "uniform " t " " n ";"))
               
               'decl (fn [[_ t n v]]
                       (str t " " n "=" v ";"))
               
               'set! (fn [[_ n v]]
                       (str n "=" v ";"))
               
               'x swizzle
               'y swizzle
               'z swizzle
               'xy swizzle
               'yx swizzle
               'yz swizzle
               'xz swizzle
               
               '+ variadic-infix
               '- variadic-infix
               '/ variadic-infix
               '* variadic-infix
               
               :default (fn [[h & args]]
                          (str h "(" (s/join "," args)  ")"))})

(defn emit-form [form]
  "Emit single form"
  (cond    
    (list? form)
    (let [[head & r] form
          t (or (emission head)
                (emission :default))
          f (conj (map emit-form r) head)]
      (t f))
    :else form))

(defn emit [sh]
  "Emit whole shader"
  (str "/* shady - functional shaders\n"
       "   ramsey nasser, nov 2014, atlantic sky */\n"
       
       "\n/* uniforms */\n"
       (->> sh :uniforms (map emit-form) (s/join "\n"))
       
       "\n\n/* main */\n"
       "void main(void) {\n"
       (->> sh :fns :main (map emit-form) (s/join "\n"))
       "\n}"))

(defn compile
  "Compile a shady shader to GLSL"
  [sh]
  (->> sh
       analyze
       transform
       emit))

(def src '((uniform vec3 resolution)
           (uniform float time)
           (decl vec2 uv (/ (xy gl_FragCoord)
                            (yx resolution)
                            (sin (+ time (* 0.1
                                            (x gl_FragCoord))))))
           (set! gl_FragColor (vec4 uv (cos (+ time (* (y gl_FragCoord)
                                                       0.1))) 1.0))))

(print (str "\n" (shcompile src) "\n"))