59 lines
1.9 KiB
Scheme
59 lines
1.9 KiB
Scheme
(import (scheme)
|
|
(chicken base)
|
|
(chicken bitwise)
|
|
(chicken syntax)
|
|
(srfi 152))
|
|
|
|
(define (snake-upcase in)
|
|
(string-map (lambda (c)
|
|
(if (char=? #\- c)
|
|
#\_
|
|
(char-upcase c)))
|
|
in))
|
|
|
|
(define-syntax define-sdl-const-values
|
|
(er-macro-transformer
|
|
(lambda (exp rename compare)
|
|
(let ((prefix (cadr exp))
|
|
(type (caddr exp))
|
|
(enum-labels (cdddr exp)))
|
|
`(begin
|
|
,@(map (lambda (enum-label)
|
|
(let ((full-str (string-append (symbol->string prefix)
|
|
"-" (symbol->string enum-label))))
|
|
`(begin
|
|
(export ,(string->symbol full-str))
|
|
(define ,(string->symbol full-str)
|
|
(foreign-value
|
|
,(string-append "SDL_" (snake-upcase full-str))
|
|
,type)))))
|
|
enum-labels))))))
|
|
|
|
(define (foldl-uint-flags flags)
|
|
(foldl bitwise-ior (car flags) (cdr flags)))
|
|
|
|
(define-syntax call-c*
|
|
(er-macro-transformer
|
|
(lambda (exp rename compare)
|
|
(let ((return-type (list-ref exp 1))
|
|
(proc (list-ref exp 2))
|
|
(args (list-ref exp 3))
|
|
(callbody (list-ref exp 4))
|
|
(callbody-args (list-ref exp 5)))
|
|
`((foreign-lambda* ,return-type
|
|
,args
|
|
,(apply format #f callbody
|
|
(symbol->string proc)
|
|
(map (compose symbol->string cadr) args)
|
|
callbody-args))
|
|
,@(map cadr args))))))
|
|
|
|
(define-syntax call-c
|
|
(syntax-rules (void)
|
|
|
|
((_ void proc (args ...))
|
|
(call-c* void proc (args ...)
|
|
"~A(~{~^, ~};" ()))
|
|
((_ return-type proc (args ...))
|
|
(call-c* return-type proc (args ...)
|
|
"C_return(~A(~{~^, ~}));"))))
|