Add/fix things to support particle shader.

1 files changed, 54 insertions, 13 deletions

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index 8ddb315..e114140 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -70,6 +70,7 @@
 ;; TODO:
 ;; - Loops
 ;; - Scheme shader type -> GLSL struct translation
+;; - Dead code elimination (error when a uniform is eliminated)
 
 
 ;;;
@@ -109,7 +110,7 @@
   (memq x '(int->float float->int)))
 
 (define (math-function? x)
-  (memq x '(abs sqrt min max sin cos tan clamp mix)))
+  (memq x '(abs sqrt min max mod floor ceil sin cos tan clamp mix)))
 
 (define (vertex-primitive-call? x)
   #f)
@@ -869,7 +870,7 @@
 (define type:outputs '(outputs))
 
 (define (outputs-type? obj)
-  (eq? obj type:outputs))
+  (equal? obj type:outputs))
 
 ;; Struct type:
 (define (struct-type name fields)
@@ -2002,6 +2003,8 @@
   (define type:*
     (a+b->c (type:int type:int type:int)
             (type:float type:float type:float)
+            (type:int type:float type:float)
+            (type:float type:int type:float)
             (type:vec2 type:vec2 type:vec2)
             (type:vec2 type:float type:vec2)
             (type:float type:vec2 type:vec2)
@@ -2020,6 +2023,8 @@
   (define type:/
     (a+b->c (type:int type:int type:int)
             (type:float type:float type:float)
+            (type:float type:int type:float)
+            (type:int type:float type:float)
             (type:vec2 type:vec2 type:vec2)
             (type:vec2 type:float type:vec2)
             (type:vec3 type:vec3 type:vec3)
@@ -2028,6 +2033,26 @@
             (type:vec4 type:float type:vec4)
             (type:mat3 type:float type:mat3)
             (type:mat4 type:float type:mat4)))
+  (define type:mod
+    (a+b->c (type:float type:float type:float)
+            (type:int type:int type:float)
+            (type:vec2 type:vec2 type:vec2)
+            (type:vec3 type:vec3 type:vec3)
+            (type:vec4 type:vec4 type:vec4)
+            (type:vec2 type:float type:vec2)
+            (type:vec3 type:float type:vec3)
+            (type:vec4 type:float type:vec4)))
+  (define type:floor/ceil
+    (let ((a (fresh-variable-type)))
+      (list (type-scheme
+             (list a)
+             (qualified-type
+              (function-type (list a) (list a))
+              (predicate:or
+               (predicate:= a type:float)
+               (predicate:= a type:vec2)
+               (predicate:= a type:vec3)
+               (predicate:= a type:vec4)))))))
   (define type:int->float
     (list (function-type (list type:int) (list type:float))))
   (define type:float->int
@@ -2081,15 +2106,26 @@
                (predicate:= a type:float)))))))
   (define type:trig
     (list (function-type (list type:float) (list type:float))))
-  (define type:clamp/mix
+  (define type:clamp
     (let ((a (fresh-variable-type)))
       (list (type-scheme
              (list a)
              (qualified-type
-              (function-type (list a a) (list a))
+              (function-type (list a a a) (list a))
               (predicate:or
                (predicate:= a type:int)
                (predicate:= a type:float)))))))
+  (define type:mix
+    (let ((a (fresh-variable-type))
+          (b (fresh-variable-type)))
+      (list (type-scheme
+             (list a)
+             (qualified-type
+              (function-type (list a a type:float) (list a))
+              (predicate:or
+               (predicate:= a type:int)
+               (predicate:= a type:float)
+               (predicate:= a type:vec4)))))))
   (define type:texture-2d
     (list (function-type (list type:sampler-2d type:vec2)
                          (list type:vec4))))
@@ -2097,6 +2133,9 @@
     (- . ,type:+/-)
     (* . ,type:*)
     (/ . ,type:/)
+    (mod . ,type:mod)
+    (floor . ,type:floor/ceil)
+    (ceil . ,type:floor/ceil)
     (int->float . ,type:int->float)
     (float->int . ,type:float->int)
     (= . ,type:comparison)
@@ -2115,8 +2154,8 @@
     (sin . ,type:trig)
     (cos . ,type:trig)
     (tan . ,type:trig)
-    (clamp . ,type:clamp/mix)
-    (mix . ,type:clamp/mix)
+    (clamp . ,type:clamp)
+    (mix . ,type:mix)
     ,@(case stage
         ((vertex)
          `((vertex:position ,type:vec4)
@@ -2317,10 +2356,11 @@
   (list temp))
 
 (define (emit:declaration type lhs rhs port level)
-  (indent level port)
-  (if rhs
-      (format port "~a ~a = ~a;\n" (type->glsl type) lhs rhs)
-      (format port "~a ~a;\n" (type->glsl type) lhs)))
+  (unless (outputs-type? type)
+    (indent level port)
+    (if rhs
+        (format port "~a ~a = ~a;\n" (type->glsl type) lhs rhs)
+        (format port "~a ~a;\n" (type->glsl type) lhs))))
 
 (define (emit:declarations types lhs-list rhs-list port level)
   (define rhs-list* (if rhs-list rhs-list (make-list (length lhs-list) #f)))
@@ -2402,8 +2442,8 @@
   let-temps)
 
 (define %primcall-map
-  '((float->int . float)
-    (int->float . int)
+  '((float->int . int)
+    (int->float . float)
     (texture-2d . texture2D)))
 
 (define (emit:primcall type operator args version port level)
@@ -2490,7 +2530,8 @@
                  (format port "~a = ~a;\n"
                          (output-name name)
                          temp))))
-            names exps))
+            names exps)
+  '(#f))
 
 (define* (emit-glsl exp version port #:optional (level 0))
   (match exp