Eventually we hope to add a 'url'-form to require, at which point it will make a lot of sense to support that it bitmap. In the meantime, I think the best thing is probably to make a new form, say bitmap-url, and put it into a separate teachpack.
Robby On Sunday, June 13, 2010, Nadeem Abdul Hamid <nad...@acm.org> wrote: > Below is a quick hack I did to allow loading a 2htdp/image bitmap from a url > like this: > > (bitmap (url "http://docs.racket-lang.org/teachpack/4e85791a5.png";)) > > There's no error checking, and I was too lazy to do a diff, but I've marked > the three pieces that I added with "; .nah." comments. Would it be possible > to add this feature to the library? This would have been a little easier > maybe if bitmap% provided load from ports, but I see that's an open PR (9335). > > Thanks, > --- nadeem > > > (define-syntax (bitmap stx) > (syntax-case stx () > [(_ arg) > (let* ([arg (syntax->datum #'arg)] > [url? (and (pair? arg) (eq? (car arg) 'url))] ; .nah. > [path > (cond > [(and (pair? arg) > (eq? (car arg) 'planet)) > (raise-syntax-error 'bitmap "planet paths not yet supported" > stx)] > ; .nah. ... > [url? > (let ([temp-path (make-temporary-file)]) > (call-with-output-file temp-path > (lambda (outp) > (call/input-url > (string->url (cadr arg)) get-pure-port > (lambda (inp) > (copy-port inp outp) > ))) > #:exists 'replace > ) > (display temp-path) > temp-path > )] > ; ... .nah. > [(symbol? arg) > (let ([pieces (regexp-split #rx"/" (symbol->string arg))]) > (cond > [(null? pieces) > (raise-syntax-error 'bitmap "expected a path with a / in > it" stx)] > [else > (let loop ([cps (current-library-collection-paths)]) > (cond > [(null? cps) > (raise-syntax-error 'bitmap > (format "could not find the ~a > collection" (car pieces)) > stx)] > [else > (if (and (directory-exists? (car cps)) > (member (build-path (car pieces)) > (directory-list (car cps)))) > (let ([candidate (apply build-path (car cps) > pieces)]) > (if (file-exists? candidate) > candidate > (raise-syntax-error 'bitmap > (format "could not > find ~a in the ~a collection" > (apply > string-append (add-between (cdr pieces) "/")) > (car pieces)) > stx))) > (loop (cdr cps)))]))]))] > [(string? arg) > (path->complete-path > arg > (or (current-load-relative-directory) > (current-directory)))])] > ) > ; .nah. ... > #`(let ([result (make-object image-snip% (make-object bitmap% #,path > 'unknown/mask))]) > (when #,url? (delete-file #,path)) > result) > ; ... .nah. > )])) > _________________________________________________ > For list-related administrative tasks: > http://lists.racket-lang.org/listinfo/dev > _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev
![http://docs.racket-lang.org/teachpack/4e85791a5.png"](http://docs.racket-lang.org/teachpack/4e85791a5.png"){kind=link}