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
(require racket/promise
(prefix-in private- "private/logos.rkt")
(require racket/class racket/draw racket/promise
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"
"compile-time.rkt"
(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"))
(provide plt-logo planet-logo
(rename-out [private-plt-flomap plt-flomap]
[private-planet-flomap planet-flomap]))
(provide (activate-contract-out
plt-logo plt-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)
(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)]
[(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-plt-logo)) #f height))]
[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)]
[(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-planet-logo)) #f height))]
[else
(private-planet-logo height)]))
(uncached-planet-logo height)]))

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

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

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

@ -7,5 +7,5 @@
@(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))}

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

@ -1,6 +1,7 @@
#lang scribble/manual
@(require scribble/eval
unstable/latent-contract/defthing
(for-label images/logos
racket)
images/logos)
@ -9,3 +10,28 @@
@title{Logos}
@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))]
}