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

made the file work when the cwd is not the files directory

Browse Source
This commit is contained in:
Robby Findler 2010-04-16 14:43:41 -04:00
parent 2d39a9e104
commit 1c114c3e94
1 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/teachpack/2htdp/scribblings/image-gen.ss
View File

@ -5,8 +5,12 @@
(require 2htdp/image (require 2htdp/image
lang/posn lang/posn
scheme/runtime-path
(only-in 2htdp/private/image-more save-image)) (only-in 2htdp/private/image-more save-image))
(define-runtime-path image.scrbl "image.scrbl")
(define-runtime-path img "img")
(define-namespace-anchor anchor) (define-namespace-anchor anchor)
(define ns (namespace-anchor->namespace anchor)) (define ns (namespace-anchor->namespace anchor))
(define expressions (define expressions
@ -16,7 +20,7 @@
(thread (thread
(λ () (λ ()
(parameterize ([current-output-port out]) (parameterize ([current-output-port out])
(dynamic-require "image.scrbl" #f)) (dynamic-require image.scrbl #f))
(close-output-port out))) (close-output-port out)))
(let loop () (let loop ()
(let ([exp (read in)]) (let ([exp (read in)])
@ -42,7 +46,9 @@
[(image? result) [(image? result)
(let ([fn (exp->filename exp)]) (let ([fn (exp->filename exp)])
(set! mapping (cons `(list ',exp 'image ,fn) mapping)) (set! mapping (cons `(list ',exp 'image ,fn) mapping))
(save-image result (build-path "img" fn)))] (let ([pth (build-path img fn)])
(unless (save-image result pth)
(fprintf (current-error-port) "failed to save ~s\n" pth))))]
[else [else
(unless (equal? result (read/write result)) (unless (equal? result (read/write result))
(error 'handle-image "expression ~s produced ~s, which I can't write" (error 'handle-image "expression ~s produced ~s, which I can't write"