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

Contracts for almost all icon-producing functions

Browse Source 
More documentation (Now contains an animated GIF! We have achieved Web 1.0!)

Fixed stop sign double-rendering bug

Compiled logos size 256 (no rendering time for sizes < 256; intended size almost instantaneous)

Please merge into release
(cherry picked from commit 0c5ea11056)
This commit is contained in:
Neil Toronto 2012-01-13 22:48:28 -07:00 committed by Ryan Culpepper
parent 2f0fbdba21
commit 58467ac5b9
13 changed files with 861 additions and 717 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/images/icons/arrow.rkt
View File

@ -7,16 +7,17 @@
"../private/utils.rkt" "../private/utils.rkt"
"style.rkt") "style.rkt")
(provide (provide (activate-contract-out
(activate-contract-out
flat-right-arrow-flomap flat-right-arrow-flomap
flat-right-over-arrow-flomap flat-right-over-arrow-flomap
right-arrow-flomap left-arrow-flomap up-arrow-flomap down-arrow-flomap right-arrow-icon right-arrow-flomap
right-over-arrow-flomap left-over-arrow-flomap left-arrow-icon left-arrow-flomap
right-under-arrow-flomap left-under-arrow-flomap up-arrow-icon up-arrow-flomap
right-arrow-icon left-arrow-icon up-arrow-icon down-arrow-icon down-arrow-icon down-arrow-flomap
right-over-arrow-icon left-over-arrow-icon right-over-arrow-icon right-over-arrow-flomap
right-under-arrow-icon left-under-arrow-icon) left-over-arrow-icon left-over-arrow-flomap
right-under-arrow-icon right-under-arrow-flomap
left-under-arrow-icon left-under-arrow-flomap)
(only-doc-out (all-defined-out))) (only-doc-out (all-defined-out)))
(defproc (flat-right-arrow-flomap [color (or/c string? (is-a?/c color%))] (defproc (flat-right-arrow-flomap [color (or/c string? (is-a?/c color%))]
@ -105,12 +106,15 @@
) flomap? ) flomap?
(flomap-flip-horizontal (right-under-arrow-flomap color height material))) (flomap-flip-horizontal (right-under-arrow-flomap color height material)))
(define-simple-icon-wrapper left-arrow-icon left-arrow-flomap) (define-icon-wrappers
(define-simple-icon-wrapper right-arrow-icon right-arrow-flomap) ([color (or/c string? (is-a?/c color%))]
(define-simple-icon-wrapper up-arrow-icon up-arrow-flomap) [height (and/c rational? (>=/c 0)) (default-icon-height)]
(define-simple-icon-wrapper down-arrow-icon down-arrow-flomap) [material deep-flomap-material-value? (default-icon-material)])
[left-arrow-icon left-arrow-flomap]
(define-simple-icon-wrapper right-over-arrow-icon right-over-arrow-flomap) [right-arrow-icon right-arrow-flomap]
(define-simple-icon-wrapper left-over-arrow-icon left-over-arrow-flomap) [up-arrow-icon up-arrow-flomap]
(define-simple-icon-wrapper right-under-arrow-icon right-under-arrow-flomap) [down-arrow-icon down-arrow-flomap]
(define-simple-icon-wrapper left-under-arrow-icon left-under-arrow-flomap) [right-over-arrow-icon right-over-arrow-flomap]
[left-over-arrow-icon left-over-arrow-flomap]
[right-under-arrow-icon right-under-arrow-flomap]
[left-under-arrow-icon left-under-arrow-flomap])

157
collects/images/icons/control.rkt
View File

@ -1,50 +1,57 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class racket/draw
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt"
"../private/utils.rkt" "../private/utils.rkt"
"style.rkt") "style.rkt")
(provide (all-defined-out)) (provide (activate-contract-out
play-icon play-flomap
back-icon back-flomap
fast-forward-icon fast-forward-flomap
rewind-icon rewind-flomap
bar-icon bar-flomap
stop-icon stop-flomap
record-icon record-flomap
pause-icon pause-flomap
step-icon step-flomap
step-back-icon step-back-flomap
continue-icon continue-flomap
continue-back-icon continue-back-flomap)
(only-doc-out (all-defined-out)))
(define play-points (define (flat-play-flomap color height)
(list '(0 . 0) '(4 . 0) (draw-icon-flomap
'(23 . 13) '(23 . 18) 24 32
'(4 . 31) '(0 . 31))) (λ (dc)
(send dc set-brush color 'solid)
(send dc draw-polygon (list (cons 0 0) (cons 4 0)
(cons 23 13) (cons 23 18)
(cons 4 31) (cons 0 31))))
(/ height 32)))
(define (play-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (play-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (define fm (flat-play-flomap color height))
24 32 (λ (dc) (flomap-render-icon fm material)))
(send dc set-brush color 'solid)
(send dc draw-polygon play-points))
(/ height 32)
material)))
(define (fast-forward-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (fast-forward-flomap [color (or/c string? (is-a?/c color%))]
(make-cached-flomap [height (and/c rational? (>=/c 0)) (default-icon-height)]
[height color material] [material deep-flomap-material-value? (default-icon-material)]
(draw-rendered-icon-flomap ) flomap?
32 32 (λ (dc) (define fm (play-flomap color height material))
(send dc set-brush color 'solid) (flomap-pin* 3/2 1/2 1 1/2 fm fm))
(send dc draw-polygon (list '(0 . 0) '(4 . 0)
'(17 . 13) '(17 . 18)
'(4 . 31) '(0 . 31)))
(send dc translate 2 0)
(send dc draw-polygon (list
;; right side
'(14 . 2)
'(27 . 13) '(27 . 18)
'(14 . 29)
;; left side
'(8 . 29)
'(18 . 19) '(18 . 12)
'(8 . 2))))
(/ height 32)
material)))
(define (stop-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (stop-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
@ -54,7 +61,10 @@
(/ height 32) (/ height 32)
material))) material)))
(define (record-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (record-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
@ -64,7 +74,10 @@
(/ height 32) (/ height 32)
material))) material)))
(define (bar-flomap color height material) (defproc (bar-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(draw-rendered-icon-flomap (draw-rendered-icon-flomap
@ -74,52 +87,76 @@
(/ height 32) (/ height 32)
material))) material)))
(define back-flomap (compose flomap-flip-horizontal play-flomap)) (defproc (back-flomap [color (or/c string? (is-a?/c color%))]
(define reverse-flomap (compose flomap-flip-horizontal fast-forward-flomap)) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-flip-horizontal (play-flomap color height material)))
(define (pause-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (rewind-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-flip-horizontal (fast-forward-flomap color height material)))
(defproc (pause-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (flomap-hc-append
(bar-flomap color height material) (bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/8 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/8 height)))) 0)
(bar-flomap color height material))) (bar-flomap color height material)))
(define (step-flomap color [height (default-icon-height)] (defproc (step-flomap [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (flomap-hc-append
(play-flomap color height material) (play-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(bar-flomap color height material))) (bar-flomap color height material)))
(define (step-back-flomap color [height (default-icon-height)] (defproc (step-back-flomap [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (flomap-hc-append
(bar-flomap color height material) (bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(back-flomap color height material))) (back-flomap color height material)))
(define (continue-flomap color [height (default-icon-height)] (defproc (continue-flomap [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (flomap-hc-append
(bar-flomap color height material) (bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(play-flomap color height material))) (play-flomap color height material)))
(define (continue-back-flomap color [height (default-icon-height)] (defproc (continue-back-flomap [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (flomap-hc-append
(back-flomap color height material) (back-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(bar-flomap color height material))) (bar-flomap color height material)))
(define play-icon (compose flomap->bitmap play-flomap)) (define-icon-wrappers
(define back-icon (compose flomap->bitmap back-flomap)) ([color (or/c string? (is-a?/c color%))]
(define fast-forward-icon (compose flomap->bitmap fast-forward-flomap)) [height (and/c rational? (>=/c 0)) (default-icon-height)]
(define reverse-icon (compose flomap->bitmap reverse-flomap)) [material deep-flomap-material-value? (default-icon-material)])
(define bar-icon (compose flomap->bitmap bar-flomap)) [play-icon play-flomap]
(define stop-icon (compose flomap->bitmap stop-flomap)) [back-icon back-flomap]
(define record-icon (compose flomap->bitmap record-flomap)) [fast-forward-icon fast-forward-flomap]
(define pause-icon (compose flomap->bitmap pause-flomap)) [rewind-icon rewind-flomap]
(define step-icon (compose flomap->bitmap step-flomap)) [bar-icon bar-flomap]
(define step-back-icon (compose flomap->bitmap step-back-flomap)) [stop-icon stop-flomap]
(define continue-icon (compose flomap->bitmap continue-flomap)) [record-icon record-flomap]
(define continue-back-icon (compose flomap->bitmap continue-back-flomap)) [pause-icon pause-flomap]
[step-icon step-flomap]
[step-back-icon step-back-flomap]
[continue-icon continue-flomap]
[continue-back-icon continue-back-flomap])

68
collects/images/icons/file.rkt
View File

@ -1,15 +1,25 @@
#lang racket/base #lang racket/base
(require racket/draw racket/class (require racket/class racket/draw
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt" "../private/deep-flomap.rkt"
"../private/utils.rkt" "../private/utils.rkt"
"arrow.rkt" "arrow.rkt"
"style.rkt") "style.rkt")
(provide (all-defined-out)) (provide (activate-contract-out
floppy-disk-icon floppy-disk-flomap
save-icon save-flomap
load-icon load-flomap
small-save-icon small-save-flomap
small-load-icon small-load-flomap)
(only-doc-out (all-defined-out)))
(define (floppy-disk-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (floppy-disk-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(define scale (/ height 32)) (define scale (/ height 32))
@ -96,36 +106,54 @@
[fm (flomap-ct-superimpose fm label-fm)]) [fm (flomap-ct-superimpose fm label-fm)])
fm))) fm)))
(define (save-flomap arrow-color color (defproc (save-flomap [arrow-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (right-arrow-flomap arrow-color (* 3/4 height) material) (flomap-hc-append (right-arrow-flomap arrow-color (* 3/4 height) material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(floppy-disk-flomap color height material))) (floppy-disk-flomap color height material)))
(define (load-flomap arrow-color color (defproc (load-flomap [arrow-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-hc-append (floppy-disk-flomap color height material) (flomap-hc-append (floppy-disk-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(right-arrow-flomap arrow-color (* 3/4 height) material))) (right-arrow-flomap arrow-color (* 3/4 height) material)))
(define (small-save-flomap arrow-color color (defproc (small-save-flomap [arrow-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-pin* 0 0 11/16 0 (flomap-pin* 0 0 11/16 0
(floppy-disk-flomap color height material) (floppy-disk-flomap color height material)
(right-arrow-flomap arrow-color (* 3/4 height) material))) (right-arrow-flomap arrow-color (* 3/4 height) material)))
(define (small-load-flomap arrow-color color (defproc (small-load-flomap [arrow-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-pin* 1 1 5/16 1 (flomap-pin* 1 1 5/16 1
(floppy-disk-flomap color height material) (floppy-disk-flomap color height material)
(right-arrow-flomap arrow-color (* 3/4 height) material))) (right-arrow-flomap arrow-color (* 3/4 height) material)))
(define floppy-disk-icon (compose flomap->bitmap floppy-disk-flomap)) (define-icon-wrappers
(define save-icon (compose flomap->bitmap save-flomap)) ([color (or/c string? (is-a?/c color%))]
(define load-icon (compose flomap->bitmap load-flomap)) [height (and/c rational? (>=/c 0)) (default-icon-height)]
(define small-save-icon (compose flomap->bitmap small-save-flomap)) [material deep-flomap-material-value? (default-icon-material)])
(define small-load-icon (compose flomap->bitmap small-load-flomap)) [floppy-disk-icon floppy-disk-flomap])
(define-icon-wrappers
([arrow-color (or/c string? (is-a?/c color%))]
[color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)])
[save-icon save-flomap]
[load-icon load-flomap]
[small-save-icon small-save-flomap]
[small-load-icon small-load-flomap])

179
collects/images/icons/misc.rkt
View File

@ -1,12 +1,26 @@
#lang racket/base #lang racket/base
(require racket/draw racket/class racket/math racket/sequence (require racket/draw racket/class racket/math racket/sequence
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt" "../private/deep-flomap.rkt"
"../private/utils.rkt" "../private/utils.rkt"
"style.rkt") "style.rkt")
(provide (all-defined-out)) (provide (activate-contract-out
text-icon text-flomap
recycle-icon recycle-flomap
x-icon x-flomap
check-icon check-flomap
regular-polygon-icon regular-polygon-flomap
octagon-icon octagon-flomap
stop-sign-icon stop-sign-flomap
stop-signs-icon stop-signs-flomap
magnifying-glass-icon magnifying-glass-flomap
left-magnifying-glass-icon left-magnifying-glass-flomap
bomb-icon bomb-flomap
left-bomb-icon left-bomb-flomap)
(only-doc-out (all-defined-out)))
;; =================================================================================================== ;; ===================================================================================================
;; Unrendered flomaps ;; Unrendered flomaps
@ -37,6 +51,7 @@
(/ height 32))) (/ height 32)))
(define (flat-regular-polygon-flomap sides start color size) (define (flat-regular-polygon-flomap sides start color size)
(let ([start (- start)])
(draw-icon-flomap (draw-icon-flomap
32 32 (λ (dc) 32 32 (λ (dc)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
@ -47,29 +62,30 @@
(send dc draw-polygon (for/list ([θ (in-list θs)]) (send dc draw-polygon (for/list ([θ (in-list θs)])
(cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac)) (cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac))
(+ 15.5 (/ (* 15.5 (sin θ)) max-frac)))))) (+ 15.5 (/ (* 15.5 (sin θ)) max-frac))))))
(/ size 32))) (/ size 32))))
;; =================================================================================================== ;; ===================================================================================================
;; Rendered flomaps ;; Rendered flomaps
(define (text-flomap str font color trim? outline? (defproc (text-flomap [str string?] [font (is-a?/c font%)]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [trim? boolean? #t]
[outline (or/c 'auto (and/c rational? (>=/c 0))) 'auto]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(define size (max 32 (send font get-point-size)))
(define family (send font get-family)) (define family (send font get-family))
(define style (send font get-style)) (define style (send font get-style))
(define weight (send font get-weight)) (define weight (send font get-weight))
(define underline? (send font get-underlined)) (define underline? (send font get-underlined))
(define smoothing (send font get-smoothing)) (define smoothing (send font get-smoothing))
(define size
(let* ([size (inexact->exact (ceiling height))])
(min 255 (if trim? (* 2 size) size))))
(make-cached-flomap (make-cached-flomap
[height str family style weight underline? smoothing color trim? outline? material] [height str family style weight underline? smoothing color trim? outline material]
(let ([font (make-object font% size family style weight underline? smoothing #t)]) (let ([font (make-object font% size family style weight underline? smoothing #t)]
[outline (if (equal? outline 'auto) (/ height 32) outline)])
(define-values (w h) (get-text-size str font)) (define-values (w h) (get-text-size str font))
(define outline-amt (if outline? (/ height 32) 0)) (define ceiling-amt (inexact->exact (ceiling outline)))
(define ceiling-amt (inexact->exact (ceiling outline-amt)))
(define fm (define fm
(let* ([fm (draw-flomap (let* ([fm (draw-flomap
w h (λ (dc) w h (λ (dc)
@ -79,14 +95,19 @@
[fm (if trim? (flomap-trim fm) fm)] [fm (if trim? (flomap-trim fm) fm)]
[fm (flomap-resize fm #f (- height (* 2 ceiling-amt)))] [fm (flomap-resize fm #f (- height (* 2 ceiling-amt)))]
[fm (flomap-inset fm ceiling-amt)] [fm (flomap-inset fm ceiling-amt)]
[fm (if outline? (flomap-outlined fm outline-amt) fm)]) [fm (if (outline . > . 0) (flomap-outlined fm outline) fm)])
fm)) fm))
(flomap-render-icon fm material)))) (flomap-render-icon fm material))))
(define (recycle-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (recycle-flomap [color (or/c string? (is-a?/c color%))]
(text-flomap "♻" (make-object font% 64 'default) color #t #t height material)) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(define size (max 1 (min 1024 (inexact->exact (ceiling (* 2 height))))))
(text-flomap "♻" (make-object font% size 'default) color #t (/ height 64) height material))
(define (x-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (x-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(define scale (/ height 32)) (define scale (/ height 32))
@ -96,7 +117,9 @@
[dfm (deep-flomap-raise dfm (* -8 scale))]) [dfm (deep-flomap-raise dfm (* -8 scale))])
(deep-flomap-render-icon dfm material)))) (deep-flomap-render-icon dfm material))))
(define (check-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (check-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(define scale (/ height 32)) (define scale (/ height 32))
@ -106,29 +129,44 @@
[dfm (deep-flomap-raise dfm (* -12 scale))]) [dfm (deep-flomap-raise dfm (* -12 scale))])
(deep-flomap-render-icon dfm material)))) (deep-flomap-render-icon dfm material))))
(define (regular-polygon-flomap sides start color (defproc (regular-polygon-flomap [sides exact-positive-integer?]
[height (default-icon-height)] [start real?]
[material (default-icon-material)]) [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height sides start color material] [height sides start color material]
(flomap-render-icon (flat-regular-polygon-flomap sides start color height) material))) (flomap-render-icon (flat-regular-polygon-flomap sides start color height) material)))
(define (octagon-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (octagon-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
#:document-body
(regular-polygon-flomap 8 (/ (* 2 pi) 16) color height material)) (regular-polygon-flomap 8 (/ (* 2 pi) 16) color height material))
(define (stop-sign-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (stop-sign-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(make-cached-flomap (make-cached-flomap
[height color material] [height color material]
(define scale (/ height 32)) (define scale (/ height 32))
(let* ([indent-fm (fm* 0.5 (x-flomap "black" (* 22 scale)))] (let* ([indent-fm (fm* 0.5 (flat-x-flomap "black" (* 22 scale)))]
[indent-dfm (deep-flomap-raise (flomap->deep-flomap indent-fm) (* -1 scale))] [indent-dfm (deep-flomap-raise (flomap->deep-flomap indent-fm) (* -1 scale))]
[fm (regular-polygon-flomap 8 (/ (* 2 pi) 16) color height)] [fm (flat-regular-polygon-flomap 8 (/ (* 2 pi) 16) color height)]
[dfm (flomap->deep-flomap fm)] [dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-cc-superimpose 'add dfm indent-dfm)]
[dfm (deep-flomap-icon-style dfm)] [dfm (deep-flomap-icon-style dfm)]
[dfm (deep-flomap-cc-superimpose 'add dfm indent-dfm)]
[fm (deep-flomap-render-icon dfm material)]) [fm (deep-flomap-render-icon dfm material)])
(flomap-cc-superimpose fm (x-flomap "azure" (* 22 scale) metal-material))))) (flomap-cc-superimpose fm (x-flomap "azure" (* 22 scale) metal-material)))))
(defproc (stop-signs-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]) flomap?
(define fm (stop-sign-flomap color (* height 2/3) material))
(flomap-pin* 3/16 1/4 0 0
fm (flomap-pin* 3/16 1/4 0 0 fm fm)))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
;; Magnifying glass ;; Magnifying glass
@ -146,9 +184,11 @@
0.2 0.8 0.0 0.2 0.8 0.0
0.0)) 0.0))
(define (magnifying-glass-flomap metal-color handle-color (defproc (magnifying-glass-flomap [metal-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [handle-color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height metal-color handle-color material] [height metal-color handle-color material]
(define scale (/ height 32)) (define scale (/ height 32))
@ -213,12 +253,21 @@
handle-fm handle-fm
(flomap-pin* 1/2 1/2 1/2 1/2 circle-fm glass-fm)))) (flomap-pin* 1/2 1/2 1/2 1/2 circle-fm glass-fm))))
(defproc (left-magnifying-glass-flomap [metal-color (or/c string? (is-a?/c color%))]
[handle-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(flomap-flip-horizontal (magnifying-glass-flomap metal-color handle-color height material)))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
;; Bomb ;; Bomb
(define (left-bomb-flomap cap-color bomb-color (defproc (left-bomb-flomap [cap-color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [bomb-color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height cap-color bomb-color material] [height cap-color bomb-color material]
(define scale (/ height 32)) (define scale (/ height 32))
@ -281,26 +330,56 @@
(deep-flomap-render-icon sphere-dfm material))) (deep-flomap-render-icon sphere-dfm material)))
(flomap-lt-superimpose sphere-fm cap-fm fuse-fm))) (flomap-lt-superimpose sphere-fm cap-fm fuse-fm)))
(define (stop-signs-flomap color [height (default-icon-height)] [material (default-icon-material)]) (defproc (bomb-flomap [cap-color (or/c string? (is-a?/c color%))]
(define fm (stop-sign-flomap color (* height 2/3) material)) [bomb-color (or/c string? (is-a?/c color%))]
(flomap-pin* 3/16 1/4 0 0 [height (and/c rational? (>=/c 0)) (default-icon-height)]
fm (flomap-pin* 3/16 1/4 0 0 fm fm))) [material deep-flomap-material-value? (default-icon-material)]
) flomap?
(define left-magnifying-glass-flomap (compose flomap-flip-horizontal magnifying-glass-flomap)) (flomap-flip-horizontal (left-bomb-flomap cap-color bomb-color height material)))
(define bomb-flomap (compose flomap-flip-horizontal left-bomb-flomap))
;; =================================================================================================== ;; ===================================================================================================
;; Bitmaps (icons) ;; Bitmaps (icons)
(define text-icon (compose flomap->bitmap text-flomap)) (defproc (text-icon [str string?] [font (is-a?/c font%)]
(define recycle-icon (compose flomap->bitmap recycle-flomap)) [color (or/c string? (is-a?/c color%))]
(define regular-polygon-icon (compose flomap->bitmap regular-polygon-flomap)) [trim? boolean? #t]
(define octagon-icon (compose flomap->bitmap octagon-flomap)) [outline (or/c 'auto (and/c rational? (>=/c 0))) 'auto]
(define x-icon (compose flomap->bitmap x-flomap)) [height (and/c rational? (>=/c 0)) (default-icon-height)]
(define stop-sign-icon (compose flomap->bitmap stop-sign-flomap)) [material deep-flomap-material-value? (default-icon-material)]
(define stop-signs-icon (compose flomap->bitmap stop-signs-flomap)) ) (is-a?/c bitmap%)
(define check-icon (compose flomap->bitmap check-flomap)) (flomap->bitmap (text-flomap str font color trim? outline height material)))
(define magnifying-glass-icon (compose flomap->bitmap magnifying-glass-flomap))
(define left-magnifying-glass-icon (compose flomap->bitmap left-magnifying-glass-flomap)) (defproc (regular-polygon-icon [sides exact-positive-integer?]
(define bomb-icon (compose flomap->bitmap bomb-flomap)) [start real?]
(define left-bomb-icon (compose flomap->bitmap left-bomb-flomap)) [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) (is-a?/c bitmap%)
(flomap->bitmap (regular-polygon-flomap sides start color height material)))
(define-icon-wrappers
([color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)])
[recycle-icon recycle-flomap]
[x-icon x-flomap]
[check-icon check-flomap]
[octagon-icon octagon-flomap]
[stop-sign-icon stop-sign-flomap]
[stop-signs-icon stop-signs-flomap])
(define-icon-wrappers
([metal-color (or/c string? (is-a?/c color%))]
[handle-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)])
[magnifying-glass-icon magnifying-glass-flomap]
[left-magnifying-glass-icon left-magnifying-glass-flomap])
(define-icon-wrappers
([cap-color (or/c string? (is-a?/c color%))]
[bomb-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)])
[bomb-icon bomb-flomap]
[left-bomb-icon left-bomb-flomap])

63
collects/images/icons/stickman.rkt
View File

@ -1,13 +1,19 @@
#lang racket/base #lang racket/base
(require racket/class racket/vector racket/match racket/math (require racket/class racket/draw racket/vector racket/match racket/math
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt" "../private/deep-flomap.rkt"
"../private/utils.rkt" "../private/utils.rkt"
"style.rkt") "style.rkt")
(provide standing-stickman-flomap standing-stickman-icon (provide (activate-contract-out
running-stickman-flomap running-stickman-icon) standing-stickman-icon standing-stickman-flomap
running-stickman-icon running-stickman-flomap)
(only-doc-out (all-defined-out)))
;; ===================================================================================================
;; Common
(define (cons+ p1 p2) (define (cons+ p1 p2)
(match-define (cons x1 y1) p1) (match-define (cons x1 y1) p1)
@ -31,6 +37,9 @@
(define shin-length 6.5) (define shin-length 6.5)
(define shoulder-breadth 7) (define shoulder-breadth 7)
;; ===================================================================================================
;; Standing
(define standing-torso-angle -90) (define standing-torso-angle -90)
(define standing-neck-angle 5) (define standing-neck-angle 5)
(define standing-left-knee-angle 200) (define standing-left-knee-angle 200)
@ -100,9 +109,12 @@
(polar->cartesian (+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle) (polar->cartesian (+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle)
lower-arm-length))) lower-arm-length)))
(define (standing-stickman-flomap color arm-color head-color (defproc (standing-stickman-flomap [color (or/c string? (is-a?/c color%))]
[height (default-icon-height)] [arm-color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [head-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height color arm-color head-color material] [height color arm-color head-color material]
(flomap-lt-superimpose (flomap-lt-superimpose
@ -161,6 +173,9 @@
(/ height 32) (/ height 32)
material)))) material))))
;; ===================================================================================================
;; Running
(define running-neck-angle 20) (define running-neck-angle 20)
(define running-torso-angle -70) (define running-torso-angle -70)
@ -245,7 +260,7 @@
(define (running-head-flomap t color height material) (define (running-head-flomap t color height material)
(make-cached-flomap (make-cached-flomap
[height t color material] [height t color material]
(draw-short-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) 26 32 (λ (dc)
(send dc set-pen "black" line-width 'solid) (send dc set-pen "black" line-width 'solid)
(send dc set-brush color 'solid) (send dc set-brush color 'solid)
@ -257,7 +272,7 @@
(define (running-leg-flomap t body? color height material) (define (running-leg-flomap t body? color height material)
(make-cached-flomap (make-cached-flomap
[height t body? color material] [height t body? color material]
(draw-short-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) 26 32 (λ (dc)
(draw-running-leg dc t "black" (+ leg-width (* 2 line-width))) (draw-running-leg dc t "black" (+ leg-width (* 2 line-width)))
(when body? (when body?
@ -270,16 +285,20 @@
(define (running-arm-flomap t color height material) (define (running-arm-flomap t color height material)
(make-cached-flomap (make-cached-flomap
[height t color material] [height t color material]
(draw-short-rendered-icon-flomap (draw-rendered-icon-flomap
26 32 (λ (dc) 26 32 (λ (dc)
(draw-running-arm dc t "black" (+ arm-width (* 2 line-width))) (draw-running-arm dc t "black" (+ arm-width (* 2 line-width)))
(draw-running-arm dc t color arm-width)) (draw-running-arm dc t color arm-width))
(/ height 32) (/ height 32)
material))) material)))
(define (running-stickman-flomap t color arm-color head-color (defproc (running-stickman-flomap [t rational?]
[height (default-icon-height)] [color (or/c string? (is-a?/c color%))]
[material (default-icon-material)]) [arm-color (or/c string? (is-a?/c color%))]
[head-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) flomap?
(make-cached-flomap (make-cached-flomap
[height t color arm-color head-color material] [height t color arm-color head-color material]
(flomap-lt-superimpose (running-arm-flomap (+ t 0.5) arm-color height material) (flomap-lt-superimpose (running-arm-flomap (+ t 0.5) arm-color height material)
@ -288,14 +307,28 @@
(running-head-flomap t head-color height material) (running-head-flomap t head-color height material)
(running-arm-flomap t arm-color height material)))) (running-arm-flomap t arm-color height material))))
(define standing-stickman-icon (compose flomap->bitmap standing-stickman-flomap)) (defproc (standing-stickman-icon [color (or/c string? (is-a?/c color%))]
(define running-stickman-icon (compose flomap->bitmap running-stickman-flomap)) [arm-color (or/c string? (is-a?/c color%))]
[head-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) (is-a?/c bitmap%)
(flomap->bitmap (standing-stickman-flomap color arm-color head-color height material)))
(defproc (running-stickman-icon [t rational?]
[color (or/c string? (is-a?/c color%))]
[arm-color (or/c string? (is-a?/c color%))]
[head-color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
[material deep-flomap-material-value? (default-icon-material)]
) (is-a?/c bitmap%)
(flomap->bitmap (running-stickman-flomap t color arm-color head-color height material)))
#;; FOR TESTING ONLY: Do not let this find its way into the repo uncommented! #;; FOR TESTING ONLY: Do not let this find its way into the repo uncommented!
(begin (begin
(require racket/gui (planet "animated-canvas.rkt" ("williams" "animated-canvas.plt" 2 4))) (require racket/gui (planet "animated-canvas.rkt" ("williams" "animated-canvas.plt" 2 4)))
(define size 20) (define size 64)
(standing-stickman-icon halt-icon-color "white" halt-icon-color size) (standing-stickman-icon halt-icon-color "white" halt-icon-color size)

22
collects/images/icons/style.rkt
View File

@ -2,6 +2,7 @@
(require racket/draw unstable/parameter-group (require racket/draw unstable/parameter-group
racket/contract unstable/latent-contract/defthing racket/contract unstable/latent-contract/defthing
(for-syntax unstable/latent-contract/serialize-syntax)
"../private/flomap.rkt" "../private/flomap.rkt"
"../private/deep-flomap.rkt") "../private/deep-flomap.rkt")
@ -24,8 +25,8 @@
(define glass-icon-material (define glass-icon-material
(deep-flomap-material-value (deep-flomap-material-value
'cubic-zirconia 1.0 0.75 0.15 'cubic-zirconia 1.0 0.75 0.15
0.5 0.2 1.0 1.0 0.2 1.0
0.0 0.4 0.25 0.2 0.4 0.25
0.08)) 0.08))
(define metal-icon-color "lightsteelblue") (define metal-icon-color "lightsteelblue")
@ -51,7 +52,7 @@
(define s (/ (deep-flomap-height dfm) 32)) (define s (/ (deep-flomap-height dfm) 32))
(let* ([dfm (deep-flomap-emboss dfm (* s 2) (* s 2))] (let* ([dfm (deep-flomap-emboss dfm (* s 2) (* s 2))]
[dfm (deep-flomap-bulge-round dfm (* s 6))] [dfm (deep-flomap-bulge-round dfm (* s 6))]
[dfm (deep-flomap-raise dfm (* s 18))]) [dfm (deep-flomap-raise dfm (* s 20))])
dfm)) dfm))
(define (draw-icon-flomap w h draw-proc scale) (define (draw-icon-flomap w h draw-proc scale)
@ -93,9 +94,12 @@
;; =================================================================================================== ;; ===================================================================================================
;; Syntax for writing icon functions ;; Syntax for writing icon functions
(define-syntax-rule (define-simple-icon-wrapper icon-fun flomap-fun) (define-syntax (define-icon-wrappers stx)
(defproc (icon-fun [color (or/c string? (is-a?/c color%))] (syntax-case stx ()
[height (and/c rational? (>=/c 0)) (default-icon-height)] [(_ ([arg-name arg-props ...] ...)
[material deep-flomap-material-value? (default-icon-material)] [icon-fun flomap-fun] ...)
) (is-a?/c bitmap%) (syntax/loc stx
(flomap->bitmap (flomap-fun color height material)))) (begin
(defproc (icon-fun [arg-name arg-props ...] ...) (is-a?/c bitmap%)
(flomap->bitmap (flomap-fun arg-name ...)))
...))]))

8
collects/images/icons/tool.rkt
View File

@ -27,8 +27,8 @@
(define (macro-stepper-flomap [height (toolbar-icon-height)] [material (default-icon-material)]) (define (macro-stepper-flomap [height (toolbar-icon-height)] [material (default-icon-material)])
(flomap-ht-append (flomap-ht-append
(text-flomap "#'" (make-object font% 12 'system 'normal 'normal) (text-flomap "#'" (make-object font% (max 1 (min 1024 height)) 'system)
macro-stepper-hash-color #t #t height material) macro-stepper-hash-color #t 'auto height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/32 height)))) 0) (make-flomap 4 (max 1 (inexact->exact (round (* 1/32 height)))) 0)
(step-flomap syntax-icon-color height material))) (step-flomap syntax-icon-color height material)))
@ -36,8 +36,8 @@
(flomap-pin* (flomap-pin*
0 0 7/16 0 0 0 7/16 0
(step-flomap syntax-icon-color height material) (step-flomap syntax-icon-color height material)
(text-flomap "#'" (make-object font% 12 'system 'normal 'bold) (text-flomap "#'" (make-object font% (max 1 (min 1024 height)) 'system)
macro-stepper-hash-color #t #t (* 3/4 height) material))) macro-stepper-hash-color #t 'auto (* 3/4 height) material)))
(define (debugger-flomap [height (toolbar-icon-height)] [material (default-icon-material)]) (define (debugger-flomap [height (toolbar-icon-height)] [material (default-icon-material)])
(flomap-ht-append (flomap-ht-append

302
collects/images/logos.rkt
View File

@ -1,287 +1,33 @@
#lang racket/base #lang racket/base
(require racket/draw racket/class racket/match racket/math racket/flonum (require racket/promise
(prefix-in private- "private/logos.rkt")
"private/flomap.rkt" "private/flomap.rkt"
"private/deep-flomap.rkt" "compile-time.rkt"
"icons/style.rkt" (for-syntax racket/base
"private/utils.rkt") (prefix-in private- "private/logos.rkt")
"private/flomap.rkt"))
(provide plt-logo planet-logo) (provide plt-logo planet-logo
(rename-out [private-plt-flomap plt-flomap]
[private-planet-flomap planet-flomap]))
(define glass-logo-material ;; Use a delay to keep from using more memory than necessary (saves 256KB)
(deep-flomap-material-value (define standard-plt-logo (delay (compiled-bitmap (private-plt-logo 256))))
'cubic-zirconia 0.7 0.6 0.4
0.2 0.1 1.0
0.2 0.1 0.1
0.0))
(define lambda-path-commands (define (plt-logo height)
'((m 97.5 10) (cond [(height . = . 256) (force standard-plt-logo)]
(c -12.267574371681416 0.22160039646017698 [(height . <= . 256)
-23.938206584070794 4.486409061946903 (flomap->bitmap (flomap-resize (bitmap->flomap (force standard-plt-logo)) #f height))]
-35.40358116814159 8.431642279646018 [else
5.002013451327434 5.357118980530973 (private-plt-logo height)]))
4.2474160707964606 7.049306166371681
6.430565946902655 6.642370378761062
8.354521486725664 -2.0234602477876105
20.745877522123894 -6.732496424778761
26.26655603539823 2.1904900530973452
12.036272707964603 15.204891185840708
17.140790371681415 34.66372757522124
18.964158300884954 53.635833203539825
2.3373978053097346 11.526810053097345
-21.433330407079644 52.79757139823009
-28.736806513274335 69.27072283185841
-11.871354336283186 20.946142017699113
-22.417494088495573 42.68413054867256
-35.79320863716814 62.74737614159292
3.198686017699115 4.233302088495575
7.820428460176991 2.5766558584070793
12.171064637168142 1.925754336283186
3.714682336283186 -0.5565213451327433
7.429373734513274 -1.1130336283185842
11.14405607079646 -1.6695504424778762
11.979952707964602 -28.4038887079646
24.914903221238937 -54.476528141592915
36.156529274336286 -83.1860083539823
5.122632495575221 -11.831699256637167
7.625016637168141 -18.33969500884956
13.711282973451327 -26.087614300884955
7.215226336283186 4.414282761061947
9.363369911504424 15.302112283185838
13.299630442477875 22.814352991150443
11.600370407079646 29.849948884955747
23.150614654867255 59.71926315044247
34.09924077876106 89.81329104424779
2.8656957168141592 0.9979197168141594
5.806954477876106 3.9796174159292033
8.525185132743362 1.105811256637168
7.150265769911504 -4.4088093451327435
15.474823929203538 -7.170211115044248
21.428106194690265 -13.26414385840708
-1.6986936637168142 -8.23685210619469
-7.156455079646018 -15.941115469026549
-10.48132417699115 -23.86248042477876
-21.07570067256637 -42.11971171681416
-41.39651398230088 -86.79632424778761
-54.5885927079646 -132.15014060176992
-4.858603610619468 -14.274800141592921
-10.841368920353982 -31.4765361840708
-26.303927504424777 -37.111590060176994
-3.5224240707964602 -1.0457545628318583
-7.2342065840707965 -1.2467313274336282
-10.888935079646018 -1.2461164743362831)))
(define (draw-lambda dc x y w h)
(define-values (sx sy) (send dc get-scale))
(draw-path-commands dc x y (scale-path-commands lambda-path-commands (/ w 240) (/ h 240)))
(send dc set-scale sx sy))
(define blue-θ-start (* -45 (/ pi 180))) (define standard-planet-logo (delay (compiled-bitmap (private-planet-logo 256))))
(define blue-θ-end (* 110 (/ pi 180)))
(define logo-red-color (make-object color% 255 36 32)) (define (planet-logo height)
(define logo-blue-color (make-object color% 32 36 255)) (cond [(height . = . 256) (force standard-planet-logo)]
(define lambda-outline-color (make-object color% 16 16 64)) [(height . <= . 256)
(define (lambda-pen color width) (make-object pen% color width 'solid 'projecting 'miter)) (flomap->bitmap (flomap-resize (bitmap->flomap (force standard-planet-logo)) #f height))]
[else
(define (make-arc-path x y w h start end [ccw? #t]) (private-planet-logo height)]))
(define p (new dc-path%))
(send p arc x y w h start end ccw?)
(send p close)
p)
(define (make-random-flomap c w h)
(build-flomap c w h (λ (k x y i) (random))))
(define (flomap-rough fm z-amt)
(match-define (flomap _ c w h) fm)
(fm+ fm (fm* z-amt (make-random-flomap c w h))))
(define (plt-flomap height)
(make-cached-flomap
[height]
(define scale (/ height 256))
(define bulge-fm
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-pen logo-red-color 2 'transparent)
(send dc set-brush logo-red-color 'solid)
(send dc draw-path (make-arc-path 8 8 239 239 blue-θ-end blue-θ-start))
(send dc set-pen logo-blue-color 2 'transparent)
(send dc set-brush logo-blue-color 'solid)
(send dc draw-path (make-arc-path 8 8 239 239 blue-θ-start blue-θ-end))
(send dc set-pen (lambda-pen lambda-outline-color 10))
(send dc set-brush lambda-outline-color 'solid)
(draw-lambda dc 8 8 240 240))
scale))
(define (lambda-flomap color pen-width)
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-scale scale scale)
(send dc set-pen (lambda-pen color pen-width))
(send dc set-brush color 'solid)
(draw-lambda dc 8 8 240 240))
scale))
(let* ([bulge-dfm (flomap->deep-flomap bulge-fm)]
[bulge-dfm (deep-flomap-bulge-spheroid bulge-dfm (* 112 scale))]
[lambda-dfm (flomap->deep-flomap (lambda-flomap "azure" 4))]
[lambda-dfm (deep-flomap-bulge-spheroid lambda-dfm (* 112 scale))]
[lambda-dfm (deep-flomap-smooth-z lambda-dfm (* 3 scale))]
[lambda-fm (deep-flomap-render-icon lambda-dfm metal-material)]
[fm (deep-flomap-render-icon bulge-dfm glass-logo-material)]
[fm (flomap-cc-superimpose
fm
(lambda-flomap lambda-outline-color 10)
lambda-fm)]
[fm (flomap-cc-superimpose
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-pen "lightblue" 2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 7 7 242 242)
(send dc set-pen lambda-outline-color 4 'solid)
(send dc draw-ellipse 2 2 252 252))
scale)
fm)])
fm)))
(define continents-path-commands
'((m 11.526653 18.937779)
(c 0.05278 0.724075 1.940414 1.202607 0.678885 2.296248
0.249172 0.918181 1.040063 1.620575 1.448285 0.308034
1.219485 -0.885607 3.250882 -0.938443 3.317014 -2.906655
-1.599965 -1.033954 -4.029479 -0.431148 -5.444184 0.302373)
(M 11.53125 18.125)
(C 10.786965 18.380649 9.3917452 18.611001 9.1304904 19.245707
10.289001 19.269837 11.178405 18.606302 11.53125 18.125)
(M 8.1875 19.65625)
(C 7.2652998 23.370888 8.6787734 19.63772 9.9124431 20.95891
10.727811 21.80382 11.739516 20.92275 10.465247 20.422456
9.7714766 19.980166 8.3964342 19.699414 8.1875 19.65625)
(M 7.5625 21.125)
(c -0.9196331 -1.962382 -3.205955 1.390782 -4.0978229 2.41995
-1.707808 2.289408 -2.72190385 5.078558 -2.9334271 7.9238
1.0237952 1.983695 5.5272247 2.76676 4.7145431 4.084262
-0.7368064 1.151552 -0.8906555 2.601652 0.1135446 3.680893
2.7495495 2.364498 1.2541019 5.824595 2.5609489 6.229519
2.5755284 0.853846 2.7512924 -3.696022 4.1297234 -3.843434
0.745066 -1.051147 0.04765 -2.428466 1.056101 -3.411232)
(C 12.318556 36.222109 8.8169859 35.479018 8.6188979 33.8253
7.7181807 34.141675 7.0679715 33.334232 6.30372 33.30415
5.7220663 34.646967 3.9378253 34.122031 4.3012403 32.699798
3.024533 33.043038 4.3605584 31.222879 3.40625 31.28125
0.5 33 2.5 26.5 5.0295875 29.903027
5.5 30.5 6.9002733 26.371666 8.8261905 25.876953
9.8027554 25.533149 9.5159021 24.727855 8.5279357 25.0625
7.6214946 24.941384 9.6975411 24.462771 10.075856 24.483273
11.540792 24.233047 9.904685 23.334106 9.8601011 22.602389
9.0900535 22.676405 9.4028275 22.737933 9.1185443 22.100147
6.8948741 22.58513 7.6831847 24.739145 5.9002404 23.244912
4.6247757 22.264239 7.321322 21.942832 7.5625 21.125)
(m 15.15625 -0.9375)
(c -1.37421 0.06218 -2.005432 1.159129 -2.784107 1.978327
-0.114565 1.368674 0.952693 -0.07002 1.385771 0.968032
0.953881 -0.129572 -0.01507 -1.993413 1.425543 -2.008859
-0.269351 0.525838 -0.494795 1.470731 0.411144 1.15174
-0.646943 0.90275 -1.874871 2.045333 -2.613442 0.960703
0.08813 0.809648 -1.042388 0.509104 -1.186702 1.40851
-0.738698 0.338761 -1.028513 0.375271 -0.383294 1.119927
-1.340908 -0.226887 -1.979854 2.002883 -0.346874 1.903539
3.128783 -3.578714 2.7333 -0.07275 3.379252 -0.61531
-0.408321 -3.069544 0.823059 1.69915 1.30948 -0.328623
0.476726 0.916648 1.583858 0.757279 2.129612 1.386838
-2.140558 2.214946 -4.171988 -1.055384 -6.363065 -0.232922
-2.486751 0.823935 -2.418258 3.347586 -3.103635 4.864439
0.687061 3.597921 3.669743 1.43585 5.132502 2.724104
-0.344691 1.08929 0.484513 1.884668 0.473244 3.022942
-0.01352 2.068761 0.378264 6.65826 1.845318 5.542497
1.472489 0.175399 1.430793 -1.740909 2.30904 -2.30502
-1.36358 -1.181833 2.025569 -1.358588 0.887958 -2.838158
-0.499809 -1.988948 1.367195 -3.177085 1.789594 -4.928946
0.579613 -0.960476 -1.588234 -0.05789 -0.373062 -1.023304
0.927113 -0.301781 2.379761 -2.07879 0.994298 -2.428506
-0.676988 0.933612 -1.737597 -2.080985 -0.549773 -0.651497
0.699549 -0.419557 1.900516 1.563553 1.759683 -0.08984
-0.608903 -3.386912 -2.4601 -6.520148 -5.090986 -8.736865
-0.200722 0.802307 -1.230158 0.889683 -1.228926 0.0694
2.155263 -0.50116 -0.789058 -0.572123 -1.208573 -0.913148)
(M 17.09375 21)
(c -1.221276 0.05745 -0.44882 1.331427 0.232503 0.449916)
(C 17.458514 21.23484 17.234278 21.104353 17.09375 21)
(m -7.5 0.125)
(c -1.2040413 0.60218 1.459244 1.052142 0.289004 0.112253)
(m 8.96875 1.5)
(c 0.38412 0.655402 -0.236077 2.74213 1.030518 1.55154
0.0634 -0.524592 -0.59842 -1.401743 -1.030518 -1.55154)
(m -0.21875 0.75)
(c -1.155615 0.198578 0.509999 1.388302 0.06733 0.201634)
(M 10.5 24.53125)
(c -0.117519 1.313533 1.058399 0.642504 0 0)))
(define water-logo-material
(deep-flomap-material-value
'cubic-zirconia 1.0 0.7 1.0
0.25 0.15 1.0
0.15 0.1 0.2
0.0))
(define logo-under-continents-color "black")
(define logo-continents-color "azure")
(define logo-water-color "lightskyblue")
(define logo-earth-outline-color logo-red-color)
(define (continents-flomap color height)
(define scale (/ height 32))
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen lambda-outline-color 3/8 'solid)
(send dc set-brush color 'solid)
(draw-path-commands dc 0 -17 continents-path-commands))
scale))
(define (planet-flomap height)
(make-cached-flomap
[height]
(define scale (/ height 32))
(define-values (earth-fm earth-z)
(let* ([indent-fm (continents-flomap logo-red-color height)]
[indent-dfm (flomap->deep-flomap indent-fm)]
[indent-dfm (deep-flomap-raise indent-dfm (* -1/8 scale))]
[indent-dfm (deep-flomap-smooth-z indent-dfm (* 1 scale))]
[earth-fm (draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen logo-water-color 1/2 'solid)
(send dc set-brush logo-water-color 'solid)
(draw-ellipse/smoothed dc 0.75 0.75 30.5 30.5))
scale)]
[earth-dfm (flomap->deep-flomap earth-fm)]
[earth-dfm (deep-flomap-bulge-spheroid earth-dfm (* 16 scale))]
[earth-dfm (deep-flomap-cc-superimpose 'add earth-dfm indent-dfm)])
(values (deep-flomap-render-icon earth-dfm water-logo-material)
(deep-flomap-z earth-dfm))))
(define land-fm
(let* ([land-fm (continents-flomap logo-continents-color height)]
[land-dfm (flomap->deep-flomap land-fm)]
;[land-dfm (deep-flomap-emboss land-dfm (* 2 scale) (* 8 scale))]
[land-dfm (deep-flomap-bulge-spheroid land-dfm (* 16 scale))]
[land-dfm (deep-flomap-smooth-z land-dfm (* 1/2 scale))])
(deep-flomap-render-icon land-dfm metal-material)))
(flomap-cc-superimpose
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 31 31)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc draw-ellipse -0.25 -0.25 32.5 32.5))
scale)
earth-fm
land-fm)))
(define plt-logo (compose flomap->bitmap plt-flomap))
(define planet-logo (compose flomap->bitmap planet-flomap))

288
collects/images/private/logos.rkt Normal file
View File

@ -0,0 +1,288 @@
#lang racket/base
(require racket/draw racket/class racket/match racket/math racket/flonum
"flomap.rkt"
"deep-flomap.rkt"
"utils.rkt"
"../icons/style.rkt")
(provide plt-logo planet-logo
plt-flomap planet-flomap)
(define glass-logo-material
(deep-flomap-material-value
'cubic-zirconia 0.7 0.6 0.4
0.2 0.1 1.0
0.2 0.1 0.1
0.0))
(define lambda-path-commands
'((m 97.5 10)
(c -12.267574371681416 0.22160039646017698
-23.938206584070794 4.486409061946903
-35.40358116814159 8.431642279646018
5.002013451327434 5.357118980530973
4.2474160707964606 7.049306166371681
6.430565946902655 6.642370378761062
8.354521486725664 -2.0234602477876105
20.745877522123894 -6.732496424778761
26.26655603539823 2.1904900530973452
12.036272707964603 15.204891185840708
17.140790371681415 34.66372757522124
18.964158300884954 53.635833203539825
2.3373978053097346 11.526810053097345
-21.433330407079644 52.79757139823009
-28.736806513274335 69.27072283185841
-11.871354336283186 20.946142017699113
-22.417494088495573 42.68413054867256
-35.79320863716814 62.74737614159292
3.198686017699115 4.233302088495575
7.820428460176991 2.5766558584070793
12.171064637168142 1.925754336283186
3.714682336283186 -0.5565213451327433
7.429373734513274 -1.1130336283185842
11.14405607079646 -1.6695504424778762
11.979952707964602 -28.4038887079646
24.914903221238937 -54.476528141592915
36.156529274336286 -83.1860083539823
5.122632495575221 -11.831699256637167
7.625016637168141 -18.33969500884956
13.711282973451327 -26.087614300884955
7.215226336283186 4.414282761061947
9.363369911504424 15.302112283185838
13.299630442477875 22.814352991150443
11.600370407079646 29.849948884955747
23.150614654867255 59.71926315044247
34.09924077876106 89.81329104424779
2.8656957168141592 0.9979197168141594
5.806954477876106 3.9796174159292033
8.525185132743362 1.105811256637168
7.150265769911504 -4.4088093451327435
15.474823929203538 -7.170211115044248
21.428106194690265 -13.26414385840708
-1.6986936637168142 -8.23685210619469
-7.156455079646018 -15.941115469026549
-10.48132417699115 -23.86248042477876
-21.07570067256637 -42.11971171681416
-41.39651398230088 -86.79632424778761
-54.5885927079646 -132.15014060176992
-4.858603610619468 -14.274800141592921
-10.841368920353982 -31.4765361840708
-26.303927504424777 -37.111590060176994
-3.5224240707964602 -1.0457545628318583
-7.2342065840707965 -1.2467313274336282
-10.888935079646018 -1.2461164743362831)))
(define (draw-lambda dc x y w h)
(define-values (sx sy) (send dc get-scale))
(draw-path-commands dc x y (scale-path-commands lambda-path-commands (/ w 240) (/ h 240)))
(send dc set-scale sx sy))
(define blue-θ-start (* -45 (/ pi 180)))
(define blue-θ-end (* 110 (/ pi 180)))
(define logo-red-color (make-object color% 255 36 32))
(define logo-blue-color (make-object color% 32 36 255))
(define lambda-outline-color (make-object color% 16 16 64))
(define (lambda-pen color width) (make-object pen% color width 'solid 'projecting 'miter))
(define (make-arc-path x y w h start end [ccw? #t])
(define p (new dc-path%))
(send p arc x y w h start end ccw?)
(send p close)
p)
(define (make-random-flomap c w h)
(build-flomap c w h (λ (k x y i) (random))))
(define (flomap-rough fm z-amt)
(match-define (flomap _ c w h) fm)
(fm+ fm (fm* z-amt (make-random-flomap c w h))))
(define (plt-flomap height)
(make-cached-flomap
[height]
(define scale (/ height 256))
(define bulge-fm
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-pen logo-red-color 2 'transparent)
(send dc set-brush logo-red-color 'solid)
(send dc draw-path (make-arc-path 8 8 239 239 blue-θ-end blue-θ-start))
(send dc set-pen logo-blue-color 2 'transparent)
(send dc set-brush logo-blue-color 'solid)
(send dc draw-path (make-arc-path 8 8 239 239 blue-θ-start blue-θ-end))
(send dc set-pen (lambda-pen lambda-outline-color 10))
(send dc set-brush lambda-outline-color 'solid)
(draw-lambda dc 8 8 240 240))
scale))
(define (lambda-flomap color pen-width)
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-scale scale scale)
(send dc set-pen (lambda-pen color pen-width))
(send dc set-brush color 'solid)
(draw-lambda dc 8 8 240 240))
scale))
(let* ([bulge-dfm (flomap->deep-flomap bulge-fm)]
[bulge-dfm (deep-flomap-bulge-spheroid bulge-dfm (* 112 scale))]
[lambda-dfm (flomap->deep-flomap (lambda-flomap "azure" 4))]
[lambda-dfm (deep-flomap-bulge-spheroid lambda-dfm (* 112 scale))]
[lambda-dfm (deep-flomap-smooth-z lambda-dfm (* 3 scale))]
[lambda-fm (deep-flomap-render-icon lambda-dfm metal-material)]
[fm (deep-flomap-render-icon bulge-dfm glass-logo-material)]
[fm (flomap-cc-superimpose
fm
(lambda-flomap lambda-outline-color 10)
lambda-fm)]
[fm (flomap-cc-superimpose
(draw-icon-flomap
256 256 (λ (dc)
(send dc set-pen "lightblue" 2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 7 7 242 242)
(send dc set-pen lambda-outline-color 4 'solid)
(send dc draw-ellipse 2 2 252 252))
scale)
fm)])
fm)))
(define continents-path-commands
'((m 11.526653 18.937779)
(c 0.05278 0.724075 1.940414 1.202607 0.678885 2.296248
0.249172 0.918181 1.040063 1.620575 1.448285 0.308034
1.219485 -0.885607 3.250882 -0.938443 3.317014 -2.906655
-1.599965 -1.033954 -4.029479 -0.431148 -5.444184 0.302373)
(M 11.53125 18.125)
(C 10.786965 18.380649 9.3917452 18.611001 9.1304904 19.245707
10.289001 19.269837 11.178405 18.606302 11.53125 18.125)
(M 8.1875 19.65625)
(C 7.2652998 23.370888 8.6787734 19.63772 9.9124431 20.95891
10.727811 21.80382 11.739516 20.92275 10.465247 20.422456
9.7714766 19.980166 8.3964342 19.699414 8.1875 19.65625)
(M 7.5625 21.125)
(c -0.9196331 -1.962382 -3.205955 1.390782 -4.0978229 2.41995
-1.707808 2.289408 -2.72190385 5.078558 -2.9334271 7.9238
1.0237952 1.983695 5.5272247 2.76676 4.7145431 4.084262
-0.7368064 1.151552 -0.8906555 2.601652 0.1135446 3.680893
2.7495495 2.364498 1.2541019 5.824595 2.5609489 6.229519
2.5755284 0.853846 2.7512924 -3.696022 4.1297234 -3.843434
0.745066 -1.051147 0.04765 -2.428466 1.056101 -3.411232)
(C 12.318556 36.222109 8.8169859 35.479018 8.6188979 33.8253
7.7181807 34.141675 7.0679715 33.334232 6.30372 33.30415
5.7220663 34.646967 3.9378253 34.122031 4.3012403 32.699798
3.024533 33.043038 4.3605584 31.222879 3.40625 31.28125
0.5 33 2.5 26.5 5.0295875 29.903027
5.5 30.5 6.9002733 26.371666 8.8261905 25.876953
9.8027554 25.533149 9.5159021 24.727855 8.5279357 25.0625
7.6214946 24.941384 9.6975411 24.462771 10.075856 24.483273
11.540792 24.233047 9.904685 23.334106 9.8601011 22.602389
9.0900535 22.676405 9.4028275 22.737933 9.1185443 22.100147
6.8948741 22.58513 7.6831847 24.739145 5.9002404 23.244912
4.6247757 22.264239 7.321322 21.942832 7.5625 21.125)
(m 15.15625 -0.9375)
(c -1.37421 0.06218 -2.005432 1.159129 -2.784107 1.978327
-0.114565 1.368674 0.952693 -0.07002 1.385771 0.968032
0.953881 -0.129572 -0.01507 -1.993413 1.425543 -2.008859
-0.269351 0.525838 -0.494795 1.470731 0.411144 1.15174
-0.646943 0.90275 -1.874871 2.045333 -2.613442 0.960703
0.08813 0.809648 -1.042388 0.509104 -1.186702 1.40851
-0.738698 0.338761 -1.028513 0.375271 -0.383294 1.119927
-1.340908 -0.226887 -1.979854 2.002883 -0.346874 1.903539
3.128783 -3.578714 2.7333 -0.07275 3.379252 -0.61531
-0.408321 -3.069544 0.823059 1.69915 1.30948 -0.328623
0.476726 0.916648 1.583858 0.757279 2.129612 1.386838
-2.140558 2.214946 -4.171988 -1.055384 -6.363065 -0.232922
-2.486751 0.823935 -2.418258 3.347586 -3.103635 4.864439
0.687061 3.597921 3.669743 1.43585 5.132502 2.724104
-0.344691 1.08929 0.484513 1.884668 0.473244 3.022942
-0.01352 2.068761 0.378264 6.65826 1.845318 5.542497
1.472489 0.175399 1.430793 -1.740909 2.30904 -2.30502
-1.36358 -1.181833 2.025569 -1.358588 0.887958 -2.838158
-0.499809 -1.988948 1.367195 -3.177085 1.789594 -4.928946
0.579613 -0.960476 -1.588234 -0.05789 -0.373062 -1.023304
0.927113 -0.301781 2.379761 -2.07879 0.994298 -2.428506
-0.676988 0.933612 -1.737597 -2.080985 -0.549773 -0.651497
0.699549 -0.419557 1.900516 1.563553 1.759683 -0.08984
-0.608903 -3.386912 -2.4601 -6.520148 -5.090986 -8.736865
-0.200722 0.802307 -1.230158 0.889683 -1.228926 0.0694
2.155263 -0.50116 -0.789058 -0.572123 -1.208573 -0.913148)
(M 17.09375 21)
(c -1.221276 0.05745 -0.44882 1.331427 0.232503 0.449916)
(C 17.458514 21.23484 17.234278 21.104353 17.09375 21)
(m -7.5 0.125)
(c -1.2040413 0.60218 1.459244 1.052142 0.289004 0.112253)
(m 8.96875 1.5)
(c 0.38412 0.655402 -0.236077 2.74213 1.030518 1.55154
0.0634 -0.524592 -0.59842 -1.401743 -1.030518 -1.55154)
(m -0.21875 0.75)
(c -1.155615 0.198578 0.509999 1.388302 0.06733 0.201634)
(M 10.5 24.53125)
(c -0.117519 1.313533 1.058399 0.642504 0 0)))
(define water-logo-material
(deep-flomap-material-value
'cubic-zirconia 1.0 0.7 1.0
0.25 0.15 1.0
0.15 0.1 0.2
0.0))
(define logo-under-continents-color "black")
(define logo-continents-color "azure")
(define logo-water-color "lightskyblue")
(define logo-earth-outline-color logo-red-color)
(define (continents-flomap color height)
(define scale (/ height 32))
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen lambda-outline-color 3/8 'solid)
(send dc set-brush color 'solid)
(draw-path-commands dc 0 -17 continents-path-commands))
scale))
(define (planet-flomap height)
(make-cached-flomap
[height]
(define scale (/ height 32))
(define-values (earth-fm earth-z)
(let* ([indent-fm (continents-flomap logo-red-color height)]
[indent-dfm (flomap->deep-flomap indent-fm)]
[indent-dfm (deep-flomap-raise indent-dfm (* -1/8 scale))]
[indent-dfm (deep-flomap-smooth-z indent-dfm (* 1 scale))]
[earth-fm (draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen logo-water-color 1/2 'solid)
(send dc set-brush logo-water-color 'solid)
(draw-ellipse/smoothed dc 0.75 0.75 30.5 30.5))
scale)]
[earth-dfm (flomap->deep-flomap earth-fm)]
[earth-dfm (deep-flomap-bulge-spheroid earth-dfm (* 16 scale))]
[earth-dfm (deep-flomap-cc-superimpose 'add earth-dfm indent-dfm)])
(values (deep-flomap-render-icon earth-dfm water-logo-material)
(deep-flomap-z earth-dfm))))
(define land-fm
(let* ([land-fm (continents-flomap logo-continents-color height)]
[land-dfm (flomap->deep-flomap land-fm)]
;[land-dfm (deep-flomap-emboss land-dfm (* 2 scale) (* 8 scale))]
[land-dfm (deep-flomap-bulge-spheroid land-dfm (* 16 scale))]
[land-dfm (deep-flomap-smooth-z land-dfm (* 1/2 scale))])
(deep-flomap-render-icon land-dfm metal-material)))
(flomap-cc-superimpose
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen "lightblue" 1/2 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-ellipse 0.5 0.5 31 31)
(send dc set-pen lambda-outline-color 1/2 'solid)
(send dc draw-ellipse -0.25 -0.25 32.5 32.5))
scale)
earth-fm
land-fm)))
(define plt-logo (compose flomap->bitmap plt-flomap))
(define planet-logo (compose flomap->bitmap planet-flomap))

4
collects/images/private/utils.rkt
View File

@ -64,9 +64,7 @@
(define (get-total-time-spent) total-time-spent) (define (get-total-time-spent) total-time-spent)
(define (make-cached-flomap* name proc size . args) (define (make-cached-flomap* name proc size . args)
(define rendered-size (define rendered-size (if (size . < . 32) 32 size))
(cond [(size . < . 32) 32]
[else (expt 2 (inexact->exact (ceiling (/ (log size) (log 2)))))]))
(define fm (weak-value-hash-ref! flomap-cache (list name rendered-size args) (define fm (weak-value-hash-ref! flomap-cache (list name rendered-size args)
(λ () (apply proc rendered-size args)))) (λ () (apply proc rendered-size args))))
(flomap-scale fm (/ size rendered-size))) (flomap-scale fm (/ size rendered-size)))

385
collects/images/scribblings/icons.scrbl
View File

@ -3,10 +3,18 @@
@(require scribble/eval @(require scribble/eval
unstable/latent-contract/defthing unstable/latent-contract/defthing
(for-label images/icons/arrow (for-label images/icons/arrow
images/icons/control
images/icons/file
images/icons/misc
images/icons/stickman
mrlib/switchable-button mrlib/switchable-button
racket racket
racket/draw) racket/draw)
images/icons/arrow) images/icons/arrow
images/icons/control
images/icons/file
images/icons/misc
images/icons/stickman)
@(define (author-email) "neil.toronto@gmail.com") @(define (author-email) "neil.toronto@gmail.com")
@ -15,7 +23,8 @@
@(define icons-eval (make-base-eval)) @(define icons-eval (make-base-eval))
@interaction-eval[#:eval icons-eval (require racket/math racket/list images/icons/style)] @interaction-eval[#:eval icons-eval (require racket/class racket/draw racket/math racket/list
images/icons/style)]
@;{ @;{
@section{Introduction (What is an icon, really?)} @section{Introduction (What is an icon, really?)}
@ -41,6 +50,11 @@ It is composed of @(go-icon (solid-icon-color "blue") 16 'diffuse) to connote st
The author of this collection is available to adapt or create SVG icons for DrRacket tools, and charges no more than your immortal soul. The author of this collection is available to adapt or create SVG icons for DrRacket tools, and charges no more than your immortal soul.
@interaction[#:eval icons-eval
(require slideshow/pict)
(cc-superimpose (bitmap (record-icon "forestgreen" 96 glass-icon-material))
(bitmap (step-icon "azure" 48 plastic-icon-material)))]
@section{Icon Parameters} @section{Icon Parameters}
@doc-apply[toolbar-icon-height]{ @doc-apply[toolbar-icon-height]{
@ -64,16 +78,13 @@ The style of DrRacket icons, used as a default argument throughout the @racketmo
@section[#:tag "arrows"]{Arrow Icons} @section[#:tag "arrows"]{Arrow Icons}
@defmodule[images/icons/arrow] @defmodule[images/icons/arrow]
@interaction-eval[#:eval icons-eval (require images/icons/arrow)] @interaction-eval[#:eval icons-eval (require images/icons/arrow)]
@doc-apply[right-arrow-icon] @doc-apply[right-arrow-icon]
@doc-apply[left-arrow-icon] @doc-apply[left-arrow-icon]
@doc-apply[up-arrow-icon] @doc-apply[up-arrow-icon]
@doc-apply[down-arrow-icon]{ @doc-apply[down-arrow-icon]{
Cardinal direction arrows. @examples[#:eval icons-eval
@interaction[#:eval icons-eval
(list (right-arrow-icon syntax-icon-color (toolbar-icon-height)) (list (right-arrow-icon syntax-icon-color (toolbar-icon-height))
(left-arrow-icon run-icon-color) (left-arrow-icon run-icon-color)
(up-arrow-icon halt-icon-color 37) (up-arrow-icon halt-icon-color 37)
@ -84,7 +95,7 @@ Cardinal direction arrows.
@doc-apply[left-over-arrow-icon] @doc-apply[left-over-arrow-icon]
@doc-apply[right-under-arrow-icon] @doc-apply[right-under-arrow-icon]
@doc-apply[left-under-arrow-icon]{ @doc-apply[left-under-arrow-icon]{
@interaction[#:eval icons-eval @examples[#:eval icons-eval
(list (right-over-arrow-icon metal-icon-color (toolbar-icon-height)) (list (right-over-arrow-icon metal-icon-color (toolbar-icon-height))
(left-over-arrow-icon dark-metal-icon-color) (left-over-arrow-icon dark-metal-icon-color)
(right-under-arrow-icon run-icon-color 37) (right-under-arrow-icon run-icon-color 37)
@ -93,274 +104,190 @@ Cardinal direction arrows.
@section[#:tag "control"]{Control Icons} @section[#:tag "control"]{Control Icons}
@section[#:tag "file"]{File Icons} @defmodule[images/icons/control]
@interaction-eval[#:eval icons-eval (require images/icons/control)]
@section[#:tag "tool"]{Tool Icons} @doc-apply[play-icon]
@section[#:tag "stickman"]{Stickman Icons}
@section[#:tag "misc"]{Miscellaneous Icons}
@;{
@subsection{Control Icons}
@doc-apply[go-icon]
@doc-apply[bar-icon]
@doc-apply[back-icon] @doc-apply[back-icon]
@doc-apply[fast-forward-icon]
@doc-apply[rewind-icon]
@doc-apply[bar-icon]
@doc-apply[stop-icon] @doc-apply[stop-icon]
@doc-apply[record-icon] @doc-apply[record-icon]
@doc-apply[pause-icon]
@doc-apply[step-icon] @doc-apply[step-icon]
@doc-apply[step-back-icon] @doc-apply[step-back-icon]
@doc-apply[continue-icon] @doc-apply[continue-icon]
@doc-apply[continue-back-icon] @doc-apply[continue-back-icon]{
@doc-apply[fast-forward-icon] Typical ``playback control'' icons.
@doc-apply[rewind-icon] For example, a colorful tape deck:
@doc-apply[pause-icon]{
These return typical ``playback'' icons.
@interaction[#:eval icons-eval @interaction[#:eval icons-eval
(for/list ([make-icon (list rewind-icon continue-back-icon (for/list ([make-icon (list rewind-icon continue-back-icon
step-back-icon back-icon step-back-icon back-icon
pause-icon stop-icon pause-icon stop-icon
go-icon step-icon play-icon step-icon
continue-icon fast-forward-icon continue-icon fast-forward-icon
record-icon)] record-icon)]
[style (in-cycle icon-styles)]) [color (list run-icon-color halt-icon-color
(make-icon (solid-icon-color "darkseagreen") 32 style))] syntax-icon-color metal-icon-color
dark-metal-icon-color dark-metal-icon-color
The remaining icon @(bar-icon #f 16), returned by @racket[bar-icon], is used to build the others. metal-icon-color syntax-icon-color
halt-icon-color run-icon-color
"red")]
[material (in-cycle (list plastic-icon-material
glass-icon-material))])
(make-icon color 32 material))]
The remaining icon @(bar-icon "red" 16), returned by @racket[bar-icon], is used to build the others.
} }
@subsection{Arrow Icons} @section[#:tag "file"]{File Icons}
@doc-apply[up-arrow-icon] @defmodule[images/icons/file]
@doc-apply[down-arrow-icon] @interaction-eval[#:eval icons-eval (require images/icons/file)]
@doc-apply[left-arrow-icon]
@doc-apply[right-arrow-icon]{ @doc-apply[floppy-disk-icon]{
@examples[#:eval icons-eval (floppy-disk-icon "gold" 32 glass-icon-material)]
}
@doc-apply[save-icon]
@doc-apply[small-save-icon]
@doc-apply[load-icon]
@doc-apply[small-load-icon]{
@examples[#:eval icons-eval @examples[#:eval icons-eval
(for/list ([make-icon (list up-arrow-icon down-arrow-icon (for/list ([make-icon (list save-icon small-save-icon
left-arrow-icon right-arrow-icon)]) load-icon small-load-icon)]
(for/list ([style (in-list icon-styles)]) [color (list run-icon-color halt-icon-color
(make-icon (solid-icon-color "brown") (default-icon-height) style)))] metal-icon-color dark-metal-icon-color)])
(make-icon syntax-icon-color color 32))]
} }
@subsection{Sign Icons} @section[#:tag "misc"]{Miscellaneous Icons}
@doc-apply[stop-sign-icon]{ @defmodule[images/icons/misc]
@examples[#:eval icons-eval (list (stop-sign-icon (default-icon-height) 'diffuse) @interaction-eval[#:eval icons-eval (require images/icons/misc)]
(stop-sign-icon (default-icon-height) 'shiny))]
@doc-apply[text-icon]{
Renders a text string as an icon. For example,
@interaction[#:eval icons-eval
(text-icon "An Important Point!"
(make-object font% 48 'decorative 'normal 'bold #t)
"lightskyblue" #t 2 48)]
Before rendering, the drawn text is scaled so that it is exactly @racket[height] pixels tall.
Make sure the font is large enough that scaling does not create blurry and jagged edge artifacts, as in the following example:
@interaction[#:eval icons-eval
(text-icon "Q" (make-object font% 32 'default 'normal 'bold)
"green" #t 0 96)]
When @racket[str] contains tall letters or @racket[trim?] is @racket[#f], using @racket[height] as the font size should be sufficient.
To make it easy to create a large enough font, @racket[text-icon] always interpets font sizes as being in pixels, never points.
See @racket[font%] for details on font sizes.
If @racket[trim?] is @racket[#f], the drawn text is not cropped before rendering.
Otherwise, it is cropped to the smallest rectangle containing all the non-zero-alpha pixels.
Rendering very small glyphs shows the difference dramatically:
@interaction[#:eval icons-eval
(define font (make-object font% 32 'default))
(list (text-icon "." font "white")
(text-icon "." font "white" #f))]
Note that both icons are @racket[(default-icon-height)] pixels tall.
When @racket[outline] is @racket['auto], the outline drawn around the text is @racket[(/ height 32)] pixels wide.
Because different platforms have slightly different fonts, @racket[text-icon] cannot guarantee the icons it returns have a consistent look or width across all platforms.
} }
@subsection{Check Icons} @doc-apply[recycle-icon]{
Returns the universal recycling symbol, rendered as an icon.
@doc-apply[check-icon]{ Its implementation calls @racket[text-icon] with the string @racket["\u267b"].
@examples[#:eval icons-eval @examples[#:eval icons-eval (recycle-icon "forestgreen" 48)]
(list (check-icon (solid-icon-color "green") 29 'diffuse)
(check-icon (solid-icon-color "green") 29 'shiny))]
} }
@doc-apply[x-icon]{ @doc-apply[x-icon]{
@examples[#:eval icons-eval Returns an ``x'' icon that is guaranteed to look the same on all platforms.
(for/list ([color icon-colors] (Anything similar that would be constructed by @racket[text-icon] would differ at least slightly across platforms.)
[style (in-cycle icon-styles)]) @examples[#:eval icons-eval (x-icon "red" 32)]
(x-icon color 29 style))]
} }
@subsection{Miscellaneous Icons} @doc-apply[check-icon]{
@examples[#:eval icons-eval (check-icon "darkgreen" 32)]
}
@doc-apply[regular-polygon-icon]{
Renders the largest regular polygon with @racket[sides] sides, with the first vertex at angle @racket[start], that can be centered in a @racket[height] × @racket[height] box.
@examples[#:eval icons-eval (for/list ([sides (in-range 1 9)]
[material (in-cycle (list plastic-icon-material
glass-icon-material))])
(regular-polygon-icon sides (* 1/4 pi) "cornflowerblue" 32
material))]
}
@doc-apply[octagon-icon]{
Equivalent to @racket[(regular-polygon-icon 8 (/ (* 2 pi) 16) color height material)].
@examples[#:eval icons-eval (octagon-icon halt-icon-color 32)]
}
@doc-apply[stop-sign-icon]{
@examples[#:eval icons-eval
(stop-sign-icon halt-icon-color 32 glass-icon-material)]
}
@doc-apply[stop-signs-icon]{
@examples[#:eval icons-eval
(stop-signs-icon halt-icon-color 32 plastic-icon-material)]
}
@doc-apply[magnifying-glass-icon]{ @doc-apply[magnifying-glass-icon]{
@examples[#:eval icons-eval (list (magnifying-glass-icon 31 'diffuse)
(magnifying-glass-icon 31 'shiny))]
Note that the uncolorized magnifying glass has a brown handle.
}
@doc-apply[magnifying-glass-left-icon]{
@examples[#:eval icons-eval (list (magnifying-glass-left-icon 31 'diffuse)
(magnifying-glass-left-icon 31 'shiny))]
}
@doc-apply[disk-icon]{
@examples[#:eval icons-eval @examples[#:eval icons-eval
(for/list ([color icon-colors] (magnifying-glass-icon "azure" "lightblue" 32 glass-icon-material)]
[style (in-cycle icon-styles)])
(disk-icon color 33 style))]
} }
@doc-apply[earth-icon]{ @doc-apply[left-magnifying-glass-icon]{
@examples[#:eval icons-eval (list (earth-icon 48 'diffuse)
(earth-icon 48 'shiny))]
}
@doc-apply[moon-icon]{
@examples[#:eval icons-eval (list (moon-icon 48 'diffuse)
(moon-icon 48 'shiny))]
}
@subsection{Symbols}
@doc-apply[hash-quote-icon]{
@examples[#:eval icons-eval (list (hash-quote-icon (toolbar-icon-height) 'diffuse)
(hash-quote-icon (toolbar-icon-height) 'shiny))]
}
@doc-apply[plus-icon]{
@examples[#:eval icons-eval @examples[#:eval icons-eval
(for/list ([color icon-colors] (left-magnifying-glass-icon metal-icon-color "red" 32)]
[style (in-cycle icon-styles)])
(plus-icon color 24 style))]
} }
@doc-apply[times-icon]{ @doc-apply[bomb-icon]{
@examples[#:eval icons-eval @examples[#:eval icons-eval
(for/list ([color icon-colors] (bomb-icon "azure" "black" 32 glass-icon-material)]
[style (in-cycle icon-styles)])
(times-icon color 24 style))]
} }
@subsection{Logos} @doc-apply[left-bomb-icon]{
@doc-apply[plt-logo]{
@examples[#:eval icons-eval @examples[#:eval icons-eval
(list (plt-logo 128 'diffuse) (plt-logo 128 'shiny))] (left-bomb-icon metal-icon-color dark-metal-icon-color 32)]
} }
@doc-apply[planet-logo]{ @section[#:tag "stickman"]{Stickman Icons}
@examples[#:eval icons-eval (list (planet-logo 128 'diffuse)
(planet-logo 128 'shiny))] @defmodule[images/icons/stickman]
@interaction-eval[#:eval icons-eval (require images/icons/stickman)]
@doc-apply[standing-stickman-icon]{
Returns the icon displayed in DrRacket's lower-right corner when no program is running.
@examples[#:eval icons-eval (standing-stickman-icon run-icon-color "white" run-icon-color 64)]
} }
@doc-apply[running-stickman-icon]{
Returns a frame of the icon animated in DrRacket's lower-right corner when a program is running.
The frame returned is for time @racket[t] of a run cycle with a one-second period.
@section{Icon Constants and Contracts} It is difficult to put a code example in the API documentation that produces an animation.
However, we might use code similar to the following to sample from the run cycle:
@;{
@doc-apply[icon-colors]{
A list containing the names of allowed icon colors.
When an SVG icon source file is rendered, it is rendered once directly. Then, for each color corresponding to a symbol in @racket[icon-colors], it is colorized by replacing gradients, and then rendered.
When loading an icon, a @racket[#f] color name loads an uncolorized rendering.
Every icon can be loaded with a @racket[#f] color name.
An icon can be loaded using any name in @racket[icon-colors] only if its SVG source has gradients that can be colorized.
See @secref["new-icons"] for details.
The actual hues associated with the color names are the hues of the first seven @racketmodname[plot] color numbers.
The following example illustrates the correspondence:
@interaction[#:eval icons-eval @interaction[#:eval icons-eval
(require plot) (for/list ([t (in-range 0 1 1/12)])
(for/list ([color (rest icon-colors)]) (running-stickman-icon t run-icon-color "white" run-icon-color 32))]
(stop-flomap color 48)) If instead of putting the icons in a list, we call their @racket[save-file] methods and hand-assemble the files into a GIF, we get something like this:
(parameterize ([plot-width 48]
[plot-height 48]
[plot-decorations? #f]
[plot-background-alpha 0])
(for/list ([n (in-range 7)])
(plot3d-pict (surface3d (λ (x y) (- (sqr x) (sqr y))) -1 1 -1 1
#:color n #:line-color n
#:samples 11 #:line-width 1))))]
This example also shows how to use @racketmodname[plot] to create icon @racket[pict]s from mathematical functions.
}}
@doc-apply[icon-color/c]{ @centered[@image["scribblings/running-stickman.gif"]]
A contract that identifies color names.
Here, the run cycle is sampled and played back at 30 Hz.
The previous example samples the run cycle at 12 Hz, or every @racket[1/12] second.
DrRacket samples it at 12 Hz and plays it back at 5 Hz at the most.
The stickman's joint angles are defined by continuous periodic functions, so the run cycle can be sampled at any resolution, or at any real-valued time @racket[t].
The cycle is modeled after the run cycle of the player's avatar in the Commodore 64 game @link["http://en.wikipedia.org/wiki/Impossible_Mission"]{Impossible Mission}.
} }
@doc-apply[icon-styles]{ @section[#:tag "tool"]{Tool Icons}
Typical icon styles.
It is not necessary to have a version of each icon in each style. @section[#:tag "const"]{Icon Constants and Contracts}
But if an icon has different styles, it should have these.
}
@doc-apply[icon-style/c]{
A contract that identifies icon styles.
}
@section{Icon @racket[pict]s}
@interaction-eval[#:eval icons-eval (require slideshow/pict)]
It is more flexible, but a little more complicated, to load icons as @racket[pict]s.
As picts, icons can easily be appended, inset, superimposed, blurred, and more.
For example, it is easy to make modern-looking media player controls using @racket[cc-superimpose] and the @racket['shiny] style:
@interaction[#:eval icons-eval
(define media-icon-background (record-flomap 'blue 64 'shiny))
(list (cc-superimpose media-icon-background
(step-back-flomap 'white 32 'shiny))
(cc-superimpose media-icon-background
(pause-flomap 'white 32 'shiny))
(cc-superimpose media-icon-background
(step-flomap 'white 32 'shiny)))]
Almost all of the functions in preceeding sections are defined in terms of the @racket[pict]-producing functions documented in this section.
To use these functions effectively, you should require @racketmodname[icons] and @racketmodname[slideshow/pict] together.
Use @racket[bitmap] to convert a @racket[bitmap%] (e.g. an icon) to a @racket[pict], and @racket[pict->bitmap] to convert back.
Converting from @racket[pict]s to bitmaps can be lossy. For example, converting text can look especially horrible:
@interaction[#:eval icons-eval
(scale (text "Hello" null 10) 5)
(scale (bitmap (pict->bitmap (text "Hello" null 10))) 5)]
Therefore, when composing icons from parts, try to work only with @racket[pict]s, and convert to an icon using @racket[pict->bitmap] as the last step.
When composing icons from parts, it is fine to use @racket[pict]s converted from @racket[bitmap%]s.
Without scaling or rotating, the conversion is lossless:
@interaction[#:eval icons-eval
(define not-blurry (magnifying-glass-icon 64 'shiny))
not-blurry
(for/fold ([icon not-blurry]) ([i (in-range 30)])
(pict->bitmap (bitmap icon)))]
Avoid converting between @racket[pict]s and @racket[bitmap%]s more than once if bitmap-backed @racket[pict]s are scaled, rotated by angles that are not multiples of 90 degrees, or superimposed or appended at non-integer coordinates.
Avoid scaling up in general.
@doc-apply[load-flomap]{
Corresponds to @racket[load-icon]. In fact, @racket[load-icon] uses @racket[load-flomap] to load the icon as a @racket[pict], and passes it to @racket[pict->bitmap].
}
@doc-apply[go-flomap]
@doc-apply[bar-flomap]
@doc-apply[back-flomap]
@doc-apply[stop-flomap]
@doc-apply[record-flomap]
@doc-apply[step-flomap]
@doc-apply[step-back-flomap]
@doc-apply[continue-flomap]
@doc-apply[continue-back-flomap]
@doc-apply[fast-forward-flomap]
@doc-apply[rewind-flomap]
@doc-apply[pause-flomap]{
These return typical ``playback'' icons, as @racket[pict]s.
@interaction[#:eval icons-eval
(for/fold ([icon (blank)])
([make-flomap (list rewind-flomap continue-back-flomap
step-back-flomap back-flomap
pause-flomap stop-flomap
go-flomap step-flomap
continue-flomap fast-forward-flomap
record-flomap)])
(hc-append icon (make-flomap 'black 32 'shiny) (blank 12)))]
}
@doc-apply[up-arrow-flomap]{ Corresponds to @racket[up-arrow-icon]. }
@doc-apply[down-arrow-flomap]{ Corresponds to @racket[down-arrow-icon]. }
@doc-apply[left-arrow-flomap]{ Corresponds to @racket[left-arrow-icon]. }
@doc-apply[right-arrow-flomap]{ Corresponds to @racket[right-arrow-icon]. }
@doc-apply[stop-sign-flomap]{ Corresponds to @racket[stop-sign-icon]. }
@doc-apply[check-flomap]{ Corresponds to @racket[check-icon]. }
@doc-apply[x-flomap]{ Corresponds to @racket[x-icon]. }
@doc-apply[magnifying-glass-flomap]{ Corresponds to @racket[magnifying-glass-icon]. }
@doc-apply[magnifying-glass-left-flomap]{ Corresponds to @racket[magnifying-glass-left-icon]. }
@doc-apply[disk-flomap]{ Corresponds to @racket[disk-icon]. }
@doc-apply[earth-flomap]{ Corresponds to @racket[earth-icon]. }
@doc-apply[moon-flomap]{ Corresponds to @racket[moon-icon]. }
@doc-apply[hash-quote-flomap]{ Corresponds to @racket[hash-quote-icon]. }
@doc-apply[plus-flomap]{ Corresponds to @racket[plus-icon]. }
@doc-apply[times-flomap]{ Corresponds to @racket[times-icon]. }
@doc-apply[plt-logo-pict]{ Corresponds to @racket[plt-logo]. }
@doc-apply[planet-logo-pict]{ Corresponds to @racket[planet-logo]. }
}

BIN
collects/images/scribblings/running-stickman.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 43 KiB

2
collects/images/tests/icon-tests.rkt
View File

@ -37,7 +37,7 @@
;; Other icons, various colors ;; Other icons, various colors
(define icon-procss (define icon-procss
(list (list reverse-icon continue-back-icon step-back-icon back-icon pause-icon (list (list rewind-icon continue-back-icon step-back-icon back-icon pause-icon
stop-icon record-icon play-icon step-icon continue-icon fast-forward-icon) stop-icon record-icon play-icon step-icon continue-icon fast-forward-icon)
(list right-arrow-icon left-arrow-icon up-arrow-icon down-arrow-icon (list right-arrow-icon left-arrow-icon up-arrow-icon down-arrow-icon
right-over-arrow-icon left-over-arrow-icon right-under-arrow-icon left-under-arrow-icon) right-over-arrow-icon left-over-arrow-icon right-under-arrow-icon left-under-arrow-icon)