From 5a4c2928e5845510e3740bb8d94754ab419bea2a Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 19 Feb 2023 20:19:32 -0500
Subject: Add step and smoothstep.

---
 chickadee/graphics/seagull.scm | 38 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index af15f97..e72a796 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -45,6 +45,7 @@
 ;; - Overloaded functions with multiple arities
 ;; - Helper function modules
 ;; - Shader composition
+;; - Interpreter
 ;;
 ;;; Code:
 (define-module (chickadee graphics seagull)
@@ -125,7 +126,8 @@
   (memq x '(int->float float->int)))
 
 (define (math-function? x)
-  (memq x '(abs sqrt pow min max mod floor ceil sin cos tan clamp mix length)))
+  (memq x '(abs sqrt pow min max mod floor ceil sin cos tan
+                clamp mix step smoothstep length)))
 
 (define (vertex-primitive-call? x)
   #f)
@@ -2209,6 +2211,22 @@
                             (predicate:substitute c tc))
              ...))))))
 
+(define-syntax-rule (a+b+c->d (ta tb tc td) ...)
+  (let ((a (fresh-variable-type))
+        (b (fresh-variable-type))
+        (c (fresh-variable-type))
+        (d (fresh-variable-type)))
+    (list (type-scheme
+           (list a b c d)
+           (qualified-type
+            (function-type (list a b c) (list d))
+            (predicate:or
+             (predicate:and (predicate:= a ta)
+                            (predicate:= b tb)
+                            (predicate:= c tc)
+                            (predicate:substitute d td))
+             ...))))))
+
 (define (top-level-type-env stage)
   (define type:+/-
     (let ((a (fresh-variable-type)))
@@ -2372,6 +2390,22 @@
                (predicate:= a type:int)
                (predicate:= a type:float)
                (predicate:= a type:vec4)))))))
+  (define type:step
+    (a+b->c (type:float type:float type:float)
+            (type:vec2 type:vec2 type:vec2)
+            (type:vec3 type:vec3 type:vec3)
+            (type:vec4 type:vec4 type:vec4)
+            (type:float type:vec2 type:vec2)
+            (type:float type:vec3 type:vec3)
+            (type:float type:vec4 type:vec4)))
+  (define type:smoothstep
+    (a+b+c->d (type:float type:float type:float type:float)
+              (type:vec2 type:vec2 type:vec2 type:vec2)
+              (type:vec3 type:vec3 type:vec3 type:vec3)
+              (type:vec4 type:vec4 type:vec4 type:vec4)
+              (type:float type:float type:vec2 type:vec2)
+              (type:float type:float type:vec3 type:vec3)
+              (type:float type:float type:vec4 type:vec4)))
   (define type:texture
     (list (function-type (list type:sampler-2d type:vec2)
                          (list type:vec4))))
@@ -2399,6 +2433,8 @@
     (pow . ,type:pow)
     (min . ,type:min/max)
     (max . ,type:min/max)
+    (step . ,type:step)
+    (smoothstep . ,type:smoothstep)
     (sin . ,type:trig)
     (cos . ,type:trig)
     (tan . ,type:trig)
-- 
cgit v1.2.3