suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

some code improvements, mainly removing the redundantly threaded home

Browse Source 
argument, and a warning message if there is no GL support.

svn: r11234
This commit is contained in:
Eli Barzilay 2008-08-14 02:23:56 +00:00
parent a4c5239364
commit 27249014f2
2 changed files with 29 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/sgl/make-gl-info.ss
View File

@ -88,7 +88,7 @@ end-string
(substring s 2 (string-length s))) (substring s 2 (string-length s)))
(string-tokenize s))) (string-tokenize s)))
(define (get-args which-arg home) (define (get-args which-arg)
(let ((fp (build-path (find-lib-dir) "buildinfo"))) (let ((fp (build-path (find-lib-dir) "buildinfo")))
(cond (cond
((file-exists? fp) ((file-exists? fp)
@ -104,17 +104,15 @@ end-string
(loop (read-line i)))))))))) (loop (read-line i))))))))))
(else "")))) (else ""))))
(define (compile-c-to-so file file.c file.so home) (define (compile-c-to-so file file.c file.so)
(let ((file.o (append-object-suffix file))) (let ((file.o (append-object-suffix file)))
(dynext:compile-extension #f (dynext:compile-extension #f file.c file.o
file.c `(,@(parse-includes (get-args "X_CFLAGS"))
file.o ,(collection-path "compiler")))
`(,@(parse-includes (get-args "X_CFLAGS" home))
,(collection-path "compiler")))
(dynext:link-extension #f (list file.o) file.so) (dynext:link-extension #f (list file.o) file.so)
(delete/continue file.o))) (delete/continue file.o)))
(define (build-helper compile-directory home variant) (define (build-helper compile-directory variant)
(let* ((file "make-gl-info-helper.ss") (let* ((file "make-gl-info-helper.ss")
(c (build-path compile-directory (append-c-suffix file))) (c (build-path compile-directory (append-c-suffix file)))
(so (build-path compile-directory (so (build-path compile-directory
@ -125,30 +123,29 @@ end-string
(with-output-to-file c (with-output-to-file c
(lambda () (display c-file)) (lambda () (display c-file))
'replace) 'replace)
(compile-c-to-so file c so home))) (compile-c-to-so file c so)))
(define (effective-system-type home) (define (effective-system-type)
(let ([t (system-type)]) (let ([t (system-type)])
(if (eq? t 'unix) (if (not (eq? t 'unix))
;; Check "buildinfo" for USE_GL flag: t
(let ([buildinfo (build-path (find-lib-dir) "buildinfo")]) ;; Check "buildinfo" for USE_GL flag:
(if (file-exists? buildinfo) (let ([buildinfo (build-path (find-lib-dir) "buildinfo")])
(with-input-from-file buildinfo (if (not (file-exists? buildinfo))
(lambda () (begin (printf "WARNING: buildinfo file missing: ~a\n" buildinfo)
(let loop () t)
(let ([l (read-line)]) (with-input-from-file buildinfo
(cond (lambda ()
[(eof-object? l) 'no-gl] (if (regexp-match? #rx"-DUSE_GL" (current-input-port))
[(regexp-match #rx"-DUSE_GL" l) t] t
[else (loop)]))))) (begin (printf "WARNING: no GL support\n")
t)) 'no-gl)))))))))
t)))
(define (make-gl-info compile-directory home) (define (make-gl-info compile-directory)
(let ((zo (build-path compile-directory (append-zo-suffix "gl-info.ss"))) (let ((zo (build-path compile-directory (append-zo-suffix "gl-info.ss")))
(mod (mod
(compile (compile
(case (effective-system-type home) (case (effective-system-type)
((macosx windows no-gl) ((macosx windows no-gl)
`(,#'module gl-info mzscheme `(,#'module gl-info mzscheme
(provide (all-defined)) (provide (all-defined))
@ -169,7 +166,7 @@ end-string
(else (else
(for-each (lambda (variant) (for-each (lambda (variant)
(parameterize ([dynext:link-variant variant]) (parameterize ([dynext:link-variant variant])
(build-helper compile-directory home variant))) (build-helper compile-directory variant)))
(available-mzscheme-variants)) (available-mzscheme-variants))
`(,#'module gl-info mzscheme `(,#'module gl-info mzscheme
(provide (all-defined)) (provide (all-defined))

4
collects/sgl/makefile.ss
View File

@ -13,6 +13,6 @@
(make-print-checking #f)) (make-print-checking #f))
(make/proc (make/proc
`((,(build-path dir "gl-info_ss.zo") `((,(build-path dir "gl-info_ss.zo")
("make-gl-info.ss" ,(build-path (find-include-dir) "schvers.h")) ("make-gl-info.ss" ,(build-path (find-include-dir) "schvers.h"))
,(lambda () (make-gl-info dir home))))))) ,(lambda () (make-gl-info dir)))))))
) )