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

Documented logos

Browse Source 
Please merge into release
This commit is contained in:
Neil Toronto 2012-01-13 23:51:31 -07:00
parent 0c5ea11056
commit 15f48a7b03
4 changed files with 51 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/images/logos.rkt
View File

@ -1,33 +1,40 @@
#lang racket/base #lang racket/base
(require racket/promise (require racket/class racket/draw racket/promise
(prefix-in private- "private/logos.rkt") racket/contract unstable/latent-contract unstable/latent-contract/defthing
(rename-in "private/logos.rkt"
[plt-logo uncached-plt-logo]
[planet-logo uncached-planet-logo])
"private/flomap.rkt" "private/flomap.rkt"
"compile-time.rkt" "compile-time.rkt"
(for-syntax racket/base (for-syntax racket/base
(prefix-in private- "private/logos.rkt") (rename-in "private/logos.rkt"
[plt-logo uncached-plt-logo]
[planet-logo uncached-planet-logo])
"private/flomap.rkt")) "private/flomap.rkt"))
(provide plt-logo planet-logo (provide (activate-contract-out
(rename-out [private-plt-flomap plt-flomap] plt-logo plt-flomap
[private-planet-flomap planet-flomap])) planet-logo planet-flomap)
(only-doc-out (all-from-out "private/logos.rkt"))
(only-doc-out (all-defined-out)))
;; Use a delay to keep from using more memory than necessary (saves 256KB) ;; Use a delay to keep from using more memory than necessary (saves 256KB)
(define standard-plt-logo (delay (compiled-bitmap (private-plt-logo 256)))) (define standard-plt-logo (delay (compiled-bitmap (uncached-plt-logo 256))))
(define (plt-logo height) (defproc (plt-logo [height (and/c rational? (>=/c 0)) 256]) (is-a?/c bitmap%)
(cond [(height . = . 256) (force standard-plt-logo)] (cond [(height . = . 256) (force standard-plt-logo)]
[(height . <= . 256) [(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-plt-logo)) #f height))] (flomap->bitmap (flomap-resize (bitmap->flomap (force standard-plt-logo)) #f height))]
[else [else
(private-plt-logo height)])) (uncached-plt-logo height)]))
(define standard-planet-logo (delay (compiled-bitmap (private-planet-logo 256)))) (define standard-planet-logo (delay (compiled-bitmap (uncached-planet-logo 256))))
(define (planet-logo height) (defproc (planet-logo [height (and/c rational? (>=/c 0)) 256]) (is-a?/c bitmap%)
(cond [(height . = . 256) (force standard-planet-logo)] (cond [(height . = . 256) (force standard-planet-logo)]
[(height . <= . 256) [(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-planet-logo)) #f height))] (flomap->bitmap (flomap-resize (bitmap->flomap (force standard-planet-logo)) #f height))]
[else [else
(private-planet-logo height)])) (uncached-planet-logo height)]))

8
collects/images/private/logos.rkt
View File

@ -1,13 +1,15 @@
#lang racket/base #lang racket/base
(require racket/draw racket/class racket/match racket/math racket/flonum (require racket/draw racket/class racket/match racket/math racket/flonum
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"flomap.rkt" "flomap.rkt"
"deep-flomap.rkt" "deep-flomap.rkt"
"utils.rkt" "utils.rkt"
"../icons/style.rkt") "../icons/style.rkt")
(provide plt-logo planet-logo (provide plt-logo planet-logo
plt-flomap planet-flomap) plt-flomap planet-flomap
(only-doc-out (all-defined-out)))
(define glass-logo-material (define glass-logo-material
(deep-flomap-material-value (deep-flomap-material-value
@ -99,7 +101,7 @@
(match-define (flomap _ c w h) fm) (match-define (flomap _ c w h) fm)
(fm+ fm (fm* z-amt (make-random-flomap c w h)))) (fm+ fm (fm* z-amt (make-random-flomap c w h))))
(define (plt-flomap height) (defproc (plt-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(make-cached-flomap (make-cached-flomap
[height] [height]
(define scale (/ height 256)) (define scale (/ height 256))
@ -243,7 +245,7 @@
(draw-path-commands dc 0 -17 continents-path-commands)) (draw-path-commands dc 0 -17 continents-path-commands))
scale)) scale))
(define (planet-flomap height) (defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(make-cached-flomap (make-cached-flomap
[height] [height]
(define scale (/ height 32)) (define scale (/ height 32))

2
collects/images/scribblings/compile-time.scrbl
View File

@ -7,5 +7,5 @@
@(define (author-email) "neil.toronto@gmail.com") @(define (author-email) "neil.toronto@gmail.com")
@title{Embedding Computed Bitmaps in Source Files} @title{Embedding Bitmaps in Compiled Files}
@author{@(author+email "Neil Toronto" (author-email))} @author{@(author+email "Neil Toronto" (author-email))}

26
collects/images/scribblings/logos.scrbl
View File

@ -1,6 +1,7 @@
#lang scribble/manual #lang scribble/manual
@(require scribble/eval @(require scribble/eval
unstable/latent-contract/defthing
(for-label images/logos (for-label images/logos
racket) racket)
images/logos) images/logos)
@ -9,3 +10,28 @@
@title{Logos} @title{Logos}
@author{@(author+email "Neil Toronto" (author-email))} @author{@(author+email "Neil Toronto" (author-email))}
@defmodule[images/logos]
@(define logos-eval (make-base-eval))
@interaction-eval[#:eval logos-eval (require images/logos images/icons/style)]
@doc-apply[plt-logo]{
Returns the PLT logo, rendered on clear glass and blue metal by the ray tracer that renders icons.
A 256×256 (default-size) rendering is compiled into the @racketmodname[images/logos] module using @racket[compiled-bitmap], meaning that constructing the logo at that size and smaller is cheap.
In fact, constructing the logo at the default size is essentially free:
@interaction[#:eval logos-eval
(time (plt-logo))
(time (plt-logo 128))
(time (plt-logo 257))]
}
@doc-apply[planet-logo]{
Returns an unofficial PLaneT logo. This is used as the PLaneT icon when DrRacket downloads PLaneT packages.
As with the @racket[plt-logo], a default-size rendering is compiled into the @racketmodname[images/logos] module for performance reasons.
@interaction[#:eval logos-eval
(time (planet-logo))
(planet-logo (default-icon-height))]
}