diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 191 |
1 files changed, 87 insertions, 104 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm index 8409503..b2058d0 100644 --- a/chickadee/graphics/seagull.scm +++ b/chickadee/graphics/seagull.scm @@ -491,6 +491,9 @@ (and (seagull-primitive? primitive) (memq stage (seagull-primitive-stages primitive))))) +(define-syntax-rule (-> (params ...) (returns ...)) + (function-type (list params ...) (list returns ...))) + (define-syntax overload (syntax-rules (->) ((_ ((var types ...) ...) (-> (args ...) (returns ...))) @@ -536,11 +539,10 @@ ...)))))) (define-seagull-primitive + - #:type - (overload ((a type:int type:float - type:vec2 type:vec3 type:vec4 - type:mat3 type:mat4)) - (-> (a a) (a))) + #:type (overload ((a type:int type:float + type:vec2 type:vec3 type:vec4 + type:mat3 type:mat4)) + (-> (a a) (a))) #:proc + #:expand (lambda (args stage env) @@ -553,11 +555,10 @@ #:emit (make-infix-emitter '+)) (define-seagull-primitive - - #:type - (overload ((a type:int type:float - type:vec2 type:vec3 type:vec4 - type:mat3 type:mat4)) - (-> (a a) (a))) + #:type (overload ((a type:int type:float + type:vec2 type:vec3 type:vec4 + type:mat3 type:mat4)) + (-> (a a) (a))) #:proc - #:expand (lambda (args stage env) @@ -571,26 +572,25 @@ #:emit (make-infix-emitter '-)) (define-seagull-primitive * - #: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) - (type:vec3 type:vec3 type:vec3) - (type:vec3 type:float type:vec3) - (type:float type:vec3 type:vec3) - (type:vec4 type:vec4 type:vec4) - (type:vec4 type:float type:vec4) - (type:float type:vec4 type:vec4) - (type:mat3 type:mat3 type:mat3) - (type:mat3 type:vec3 type:vec3) - (type:vec3 type:mat3 type:vec3) - (type:mat4 type:mat4 type:mat4) - (type:mat4 type:vec4 type:vec4) - (type:vec4 type:mat4 type:vec4)) + #: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) + (type:vec3 type:vec3 type:vec3) + (type:vec3 type:float type:vec3) + (type:float type:vec3 type:vec3) + (type:vec4 type:vec4 type:vec4) + (type:vec4 type:float type:vec4) + (type:float type:vec4 type:vec4) + (type:mat3 type:mat3 type:mat3) + (type:mat3 type:vec3 type:vec3) + (type:vec3 type:mat3 type:vec3) + (type:mat4 type:mat4 type:mat4) + (type:mat4 type:vec4 type:vec4) + (type:vec4 type:mat4 type:vec4)) #:proc * #:expand (lambda (args stage env) @@ -603,19 +603,18 @@ #:emit (make-infix-emitter '*)) (define-seagull-primitive / - #: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) - (type:vec3 type:float type:vec3) - (type:vec4 type:vec4 type:vec4) - (type:vec4 type:float type:vec4) - (type:mat3 type:float type:mat3) - (type:mat4 type:float type:mat4)) + #: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) + (type:vec3 type:float type:vec3) + (type:vec4 type:vec4 type:vec4) + (type:vec4 type:float type:vec4) + (type:mat3 type:float type:mat3) + (type:mat4 type:float type:mat4)) ;; The division of two integers can result in a rational, ;; non-integer, such as 1/2. This isn't how integer division works ;; in GLSL, so we need to round the result to an integer. @@ -643,38 +642,35 @@ #:emit (make-infix-emitter '/)) (define-seagull-primitive mod - #:type - (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)) + #:type (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)) #:proc mod) (define-seagull-primitive floor - #:type - (overload ((a type:float type:vec2 type:vec3 type:vec4)) - (-> (a) (a))) + #:type (overload ((a type:float type:vec2 type:vec3 type:vec4)) + (-> (a) (a))) #:proc floor) (define-seagull-primitive ceiling #:glsl-name 'ceil - #:type - (overload ((a type:float type:vec2 type:vec3 type:vec4)) - (-> (a) (a))) + #:type (overload ((a type:float type:vec2 type:vec3 type:vec4)) + (-> (a) (a))) #:proc ceiling) (define-seagull-primitive int->float #:glsl-name 'float - #:type (function-type (list type:int) (list type:float)) + #:type (-> (type:int) (type:float)) #:proc exact->inexact) (define-seagull-primitive float->int #:glsl-name 'int - #:type (function-type (list type:float) (list type:int)) + #:type (-> (type:float) (type:int)) #:proc (compose inexact->exact floor)) (define-syntax define-comparison-primitive @@ -698,7 +694,7 @@ (define-seagull-primitive not #:glsl-name '! - #:type (function-type (list type:bool) (list type:bool)) + #:type (-> (type:bool) (type:bool)) #:emit (lambda (args port) (match args @@ -706,40 +702,31 @@ (format port "!(~a)" a))))) (define-seagull-primitive vec2 - #:type - (function-type (list type:float type:float) - (list type:vec2))) + #:type (-> (type:float type:float) (type:vec2))) (define-seagull-primitive vec3 - #:type - (function-type (list type:float type:float type:float) - (list type:vec3))) + #:type (-> (type:float type:float type:float) (type:vec3))) (define-seagull-primitive vec4 - #:type - (function-type (list type:float type:float type:float type:float) - (list type:vec4))) + #:type (-> (type:float type:float type:float type:float) (type:vec4))) (define-seagull-primitive length - #:type - (overload ((a type:float type:vec2 type:vec3 type:vec4)) - (-> (a) (type:float)))) + #:type (overload ((a type:float type:vec2 type:vec3 type:vec4)) + (-> (a) (type:float)))) (define-seagull-primitive abs - #:type - (overload ((a type:int type:float)) - (-> (a) (a))) + #:type (overload ((a type:int type:float)) + (-> (a) (a))) #:proc abs) (define-seagull-primitive sqrt - #:type (function-type (list type:float) (list type:float)) + #:type (-> (type:float) (type:float)) #:proc sqrt) (define-seagull-primitive expt #:glsl-name 'pow - #:type - (overload ((a type:float type:vec2 type:vec3 type:vec4)) - (-> (a a) (a))) + #:type (overload ((a type:float type:vec2 type:vec3 type:vec4)) + (-> (a a) (a))) #:proc expt) (define-seagull-primitive min @@ -751,49 +738,45 @@ #:proc min) (define-seagull-primitive sin - #:type (function-type (list type:float) (list type:float)) + #:type (-> (type:float) (type:float)) #:proc sin) (define-seagull-primitive cos - #:type (function-type (list type:float) (list type:float)) + #:type (-> (type:float) (type:float)) #:proc cos) (define-seagull-primitive tan - #:type (function-type (list type:float) (list type:float)) + #:type (-> (type:float) (type:float)) #:proc tan) (define-seagull-primitive clamp #:type (overload ((a type:int type:float)) (-> (a a a) (a)))) (define-seagull-primitive mix - #:type - (overload ((a type:int type:float type:vec2 type:vec3 type:vec4)) - (-> (a a type:float) (a)))) + #:type (overload ((a type:int type:float type:vec2 type:vec3 type:vec4)) + (-> (a a type:float) (a)))) (define-seagull-primitive step - #:type - (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))) + #:type (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-seagull-primitive smoothstep - #:type - (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))) + #:type (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-seagull-primitive texture #:stages '(fragment) - #:type (function-type (list type:sampler-2d type:vec2) - (list type:vec4))) + #:type (-> (type:sampler-2d type:vec2) (type:vec4))) ;;; |