summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-02-07 08:41:56 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commit824b2739743194524ab4fe82114f144a43f9a699 (patch)
tree6835b4394b005ed64a6add1032cab8060b3c90aa
parentfbe819f0f34f0347e6def90ddc605efb877de519 (diff)
Fix GLSL type descriptor emission.
-rw-r--r--chickadee/graphics/seagull.scm68
1 files changed, 35 insertions, 33 deletions
diff --git a/chickadee/graphics/seagull.scm b/chickadee/graphics/seagull.scm
index f19dc90..be479ba 100644
--- a/chickadee/graphics/seagull.scm
+++ b/chickadee/graphics/seagull.scm
@@ -2212,10 +2212,30 @@
;; Transform a fully typed Seagull program into a string of GLSL code.
-(define (type-name type)
- (if (struct-type? type)
- (struct-type-name type)
- (primitive-type-name type)))
+(define %type-name-map
+ '((sampler-2d . sampler2D)))
+
+(define (type-descriptor->glsl desc)
+ (match desc
+ ((? symbol?)
+ (or (assq-ref %type-name-map desc) desc))
+ (('array desc* length)
+ (format #f "~a[~a]"
+ (type-descriptor->glsl desc*)
+ length))))
+
+(define (type->type-descriptor type)
+ (cond
+ ((primitive-type? type)
+ (primitive-type-name type))
+ ((struct-type? type)
+ (struct-type-name type))
+ ((array-type? type)
+ `(array ,(type->type-descriptor (array-type-ref type))
+ ,(array-type-length type)))))
+
+(define (type->glsl type)
+ (type-descriptor->glsl (type->type-descriptor type)))
(define (single-temp temps)
(match temps
@@ -2253,7 +2273,7 @@
(define temp (unique-identifier))
(indent level port)
(format port "~a ~a = ~a ~a ~a;\n"
- (type-name type) temp a-temp op* b-temp)
+ (type->glsl type) temp a-temp op* b-temp)
(list temp))
(define (emit:unary-operator type op a version port level)
@@ -2265,14 +2285,14 @@
(define temp (unique-identifier))
(indent level port)
(format port "~a ~a = ~a(~a);\n"
- (type-name type) temp op* a-temp)
+ (type->glsl type) temp op* a-temp)
(list temp))
(define (emit:declaration type lhs rhs port level)
(indent level port)
(if rhs
- (format port "~a ~a = ~a;\n" (type-name type) lhs rhs)
- (format port "~a ~a;\n" (type-name type) lhs)))
+ (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)))
@@ -2303,7 +2323,7 @@
(unless first?
(display ", " port))
(format port "~a ~a ~a"
- qualifier (type-name type) name)
+ qualifier (type->glsl type) name)
(loop rest #f))))
(display ") {\n" port)
(define body-temps (emit-glsl body version port (+ level 1)))
@@ -2368,7 +2388,7 @@
(define output-temp (unique-identifier))
(indent level port)
(format port "~a ~a = ~a(~a);\n"
- (type-name type)
+ (type->glsl type)
output-temp
operator*
(string-join (map symbol->string arg-temps) ", "))
@@ -2390,46 +2410,28 @@
output-temps)
(define (emit:struct-ref type exp field version port level)
- (define input-temp
- (match (emit-glsl exp version port level)
- ((temp) temp)))
+ (define input-temp (single-temp (emit-glsl exp version port level)))
(define output-temp (unique-identifier))
(indent level port)
(format port "~a ~a = ~a.~a;\n"
- (type-name type)
+ (type->glsl type)
output-temp
input-temp
field)
(list output-temp))
(define (emit:array-ref type array-exp index-exp version port level)
- (define array-temp
- (match (emit-glsl array-exp version port level)
- ((temp) temp)))
- (define index-temp
- (match (emit-glsl index-exp version port level)
- ((temp) temp)))
+ (define array-temp (single-temp (emit-glsl array-exp version port level)))
+ (define index-temp (single-temp (emit-glsl index-exp version port level)))
(define output-temp (unique-identifier))
(indent level port)
(format port "~a ~a = ~a[~a];\n"
- (type-name type)
+ (type->glsl type)
output-temp
array-temp
index-temp)
(list output-temp))
-(define %type-name-map
- '((sampler-2d . sampler2D)))
-
-(define (type-descriptor->glsl desc)
- (match desc
- ((? symbol?)
- (or (assq-ref %type-name-map desc) desc))
- (('array desc* length)
- (format #f "~a[~a]"
- (type-descriptor->glsl desc*)
- length))))
-
(define (emit:top-level bindings body version port level)
(for-each (match-lambda
(((? top-level-qualifier? qualifier) type-desc name)