diff options
| -rw-r--r-- | chickadee/graphics/seagull.scm | 68 |
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) |