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 <nadeem at 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 >
![http://docs.racket-lang.org/teachpack/4e85791a5.png"](http://docs.racket-lang.org/teachpack/4e85791a5.png"){kind=link}