Contracts for almost all icon-producing functions

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

View File

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

View File

@ -1,50 +1,57 @@
#lang racket/base
(require racket/class
(require racket/class racket/draw
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt"
"../private/deep-flomap.rkt"
"../private/utils.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
(list '(0 . 0) '(4 . 0)
'(23 . 13) '(23 . 18)
'(4 . 31) '(0 . 31)))
(define (flat-play-flomap color height)
(draw-icon-flomap
24 32
(λ (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
[height color material]
(draw-rendered-icon-flomap
24 32 (λ (dc)
(send dc set-brush color 'solid)
(send dc draw-polygon play-points))
(/ height 32)
material)))
(define fm (flat-play-flomap color height))
(flomap-render-icon fm material)))
(define (fast-forward-flomap color [height (default-icon-height)] [material (default-icon-material)])
(make-cached-flomap
[height color material]
(draw-rendered-icon-flomap
32 32 (λ (dc)
(send dc set-brush color 'solid)
(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)))
(defproc (fast-forward-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 (play-flomap color height material))
(flomap-pin* 3/2 1/2 1 1/2 fm fm))
(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
[height color material]
(draw-rendered-icon-flomap
@ -54,7 +61,10 @@
(/ height 32)
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
[height color material]
(draw-rendered-icon-flomap
@ -64,7 +74,10 @@
(/ height 32)
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
[height color material]
(draw-rendered-icon-flomap
@ -74,52 +87,76 @@
(/ height 32)
material)))
(define back-flomap (compose flomap-flip-horizontal play-flomap))
(define reverse-flomap (compose flomap-flip-horizontal fast-forward-flomap))
(defproc (back-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 (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
(bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/8 height)))) 0)
(bar-flomap color height material)))
(define (step-flomap color [height (default-icon-height)]
[material (default-icon-material)])
(defproc (step-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
(play-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(bar-flomap color height material)))
(define (step-back-flomap color [height (default-icon-height)]
[material (default-icon-material)])
(defproc (step-back-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
(bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(back-flomap color height material)))
(define (continue-flomap color [height (default-icon-height)]
[material (default-icon-material)])
(defproc (continue-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
(bar-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(play-flomap color height material)))
(define (continue-back-flomap color [height (default-icon-height)]
[material (default-icon-material)])
(defproc (continue-back-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
(back-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(bar-flomap color height material)))
(define play-icon (compose flomap->bitmap play-flomap))
(define back-icon (compose flomap->bitmap back-flomap))
(define fast-forward-icon (compose flomap->bitmap fast-forward-flomap))
(define reverse-icon (compose flomap->bitmap reverse-flomap))
(define bar-icon (compose flomap->bitmap bar-flomap))
(define stop-icon (compose flomap->bitmap stop-flomap))
(define record-icon (compose flomap->bitmap record-flomap))
(define pause-icon (compose flomap->bitmap pause-flomap))
(define step-icon (compose flomap->bitmap step-flomap))
(define step-back-icon (compose flomap->bitmap step-back-flomap))
(define continue-icon (compose flomap->bitmap continue-flomap))
(define continue-back-icon (compose flomap->bitmap continue-back-flomap))
(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)])
[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])

View File

@ -1,15 +1,25 @@
#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/deep-flomap.rkt"
"../private/utils.rkt"
"arrow.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
[height color material]
(define scale (/ height 32))
@ -96,36 +106,54 @@
[fm (flomap-ct-superimpose fm label-fm)])
fm)))
(define (save-flomap arrow-color color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (save-flomap [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)]
) flomap?
(flomap-hc-append (right-arrow-flomap arrow-color (* 3/4 height) material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(floppy-disk-flomap color height material)))
(define (load-flomap arrow-color color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (load-flomap [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)]
) flomap?
(flomap-hc-append (floppy-disk-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(right-arrow-flomap arrow-color (* 3/4 height) material)))
(define (small-save-flomap arrow-color color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (small-save-flomap [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)]
) flomap?
(flomap-pin* 0 0 11/16 0
(floppy-disk-flomap color height material)
(right-arrow-flomap arrow-color (* 3/4 height) material)))
(define (small-load-flomap arrow-color color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (small-load-flomap [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)]
) flomap?
(flomap-pin* 1 1 5/16 1
(floppy-disk-flomap color height material)
(right-arrow-flomap arrow-color (* 3/4 height) material)))
(define floppy-disk-icon (compose flomap->bitmap floppy-disk-flomap))
(define save-icon (compose flomap->bitmap save-flomap))
(define load-icon (compose flomap->bitmap load-flomap))
(define small-save-icon (compose flomap->bitmap small-save-flomap))
(define small-load-icon (compose flomap->bitmap small-load-flomap))
(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)])
[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])

View File

@ -1,12 +1,26 @@
#lang racket/base
(require racket/draw racket/class racket/math racket/sequence
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"../private/flomap.rkt"
"../private/deep-flomap.rkt"
"../private/utils.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
@ -37,39 +51,41 @@
(/ height 32)))
(define (flat-regular-polygon-flomap sides start color size)
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-brush color 'solid)
(define (/ (* 2 pi) sides))
(define θs (sequence->list (in-range start (+ start (* 2 pi)) )))
(define max-frac (apply max (append (map (compose abs cos) θs)
(map (compose abs sin) θs))))
(send dc draw-polygon (for/list ([θ (in-list θs)])
(cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac))
(+ 15.5 (/ (* 15.5 (sin θ)) max-frac))))))
(/ size 32)))
(let ([start (- start)])
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-brush color 'solid)
(define (/ (* 2 pi) sides))
(define θs (sequence->list (in-range start (+ start (* 2 pi)) )))
(define max-frac (apply max (append (map (compose abs cos) θs)
(map (compose abs sin) θs))))
(send dc draw-polygon (for/list ([θ (in-list θs)])
(cons (+ 15.5 (/ (* 15.5 (cos θ)) max-frac))
(+ 15.5 (/ (* 15.5 (sin θ)) max-frac))))))
(/ size 32))))
;; ===================================================================================================
;; Rendered flomaps
(define (text-flomap str font color trim? outline?
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (text-flomap [str string?] [font (is-a?/c font%)]
[color (or/c string? (is-a?/c color%))]
[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 style (send font get-style))
(define weight (send font get-weight))
(define underline? (send font get-underlined))
(define smoothing (send font get-smoothing))
(define size
(let* ([size (inexact->exact (ceiling height))])
(min 255 (if trim? (* 2 size) size))))
(make-cached-flomap
[height str family style weight underline? smoothing color trim? outline? material]
(let ([font (make-object font% size family style weight underline? smoothing #t)])
[height str family style weight underline? smoothing color trim? outline material]
(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 outline-amt (if outline? (/ height 32) 0))
(define ceiling-amt (inexact->exact (ceiling outline-amt)))
(define ceiling-amt (inexact->exact (ceiling outline)))
(define fm
(let* ([fm (draw-flomap
w h (λ (dc)
@ -79,14 +95,19 @@
[fm (if trim? (flomap-trim fm) fm)]
[fm (flomap-resize fm #f (- height (* 2 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))
(flomap-render-icon fm material))))
(define (recycle-flomap color [height (default-icon-height)] [material (default-icon-material)])
(text-flomap "" (make-object font% 64 'default) color #t #t height material))
(defproc (recycle-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 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
[height color material]
(define scale (/ height 32))
@ -96,7 +117,9 @@
[dfm (deep-flomap-raise dfm (* -8 scale))])
(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
[height color material]
(define scale (/ height 32))
@ -106,29 +129,44 @@
[dfm (deep-flomap-raise dfm (* -12 scale))])
(deep-flomap-render-icon dfm material))))
(define (regular-polygon-flomap sides start color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (regular-polygon-flomap [sides exact-positive-integer?]
[start real?]
[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
[height sides start color 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))
(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
[height color material]
(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))]
[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 (deep-flomap-cc-superimpose 'add dfm indent-dfm)]
[dfm (deep-flomap-icon-style dfm)]
[dfm (deep-flomap-cc-superimpose 'add dfm indent-dfm)]
[fm (deep-flomap-render-icon dfm 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
@ -146,9 +184,11 @@
0.2 0.8 0.0
0.0))
(define (magnifying-glass-flomap metal-color handle-color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (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?
(make-cached-flomap
[height metal-color handle-color material]
(define scale (/ height 32))
@ -213,12 +253,21 @@
handle-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
(define (left-bomb-flomap cap-color bomb-color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (left-bomb-flomap [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)]
) flomap?
(make-cached-flomap
[height cap-color bomb-color material]
(define scale (/ height 32))
@ -229,15 +278,15 @@
(send dc set-brush "gold" 'solid)
(draw-path-commands
dc 0 0
'((m 3.5 0)
(c -5 0 -3.29080284 10.4205 -3 11.5
1.1137011 4.1343 2 6.5 0 8.5
-0.5711131 2.0524 1.5 4 3.5 3.5
2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5
-2 -7 -2 -9 -1.5 -9
0 1 -0.5 2 1 3.5
2 0.5 4 -1.5 3.5 -3.5
-2 -2 -2 -5 -5.5 -5))))
'((m 3.5 0)
(c -5 0 -3.29080284 10.4205 -3 11.5
1.1137011 4.1343 2 6.5 0 8.5
-0.5711131 2.0524 1.5 4 3.5 3.5
2.5711131 -2.5524 3.1327042 -5.5355 2 -9.5
-2 -7 -2 -9 -1.5 -9
0 1 -0.5 2 1 3.5
2 0.5 4 -1.5 3.5 -3.5
-2 -2 -2 -5 -5.5 -5))))
scale)]
[dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-icon-style dfm)]
@ -281,26 +330,56 @@
(deep-flomap-render-icon sphere-dfm material)))
(flomap-lt-superimpose sphere-fm cap-fm fuse-fm)))
(define (stop-signs-flomap color [height (default-icon-height)] [material (default-icon-material)])
(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)))
(define left-magnifying-glass-flomap (compose flomap-flip-horizontal magnifying-glass-flomap))
(define bomb-flomap (compose flomap-flip-horizontal left-bomb-flomap))
(defproc (bomb-flomap [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)]
) flomap?
(flomap-flip-horizontal (left-bomb-flomap cap-color bomb-color height material)))
;; ===================================================================================================
;; Bitmaps (icons)
(define text-icon (compose flomap->bitmap text-flomap))
(define recycle-icon (compose flomap->bitmap recycle-flomap))
(define regular-polygon-icon (compose flomap->bitmap regular-polygon-flomap))
(define octagon-icon (compose flomap->bitmap octagon-flomap))
(define x-icon (compose flomap->bitmap x-flomap))
(define stop-sign-icon (compose flomap->bitmap stop-sign-flomap))
(define stop-signs-icon (compose flomap->bitmap stop-signs-flomap))
(define check-icon (compose flomap->bitmap check-flomap))
(define magnifying-glass-icon (compose flomap->bitmap magnifying-glass-flomap))
(define left-magnifying-glass-icon (compose flomap->bitmap left-magnifying-glass-flomap))
(define bomb-icon (compose flomap->bitmap bomb-flomap))
(define left-bomb-icon (compose flomap->bitmap left-bomb-flomap))
(defproc (text-icon [str string?] [font (is-a?/c font%)]
[color (or/c string? (is-a?/c color%))]
[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)]
) (is-a?/c bitmap%)
(flomap->bitmap (text-flomap str font color trim? outline height material)))
(defproc (regular-polygon-icon [sides exact-positive-integer?]
[start real?]
[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])

View File

@ -1,13 +1,19 @@
#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/deep-flomap.rkt"
"../private/utils.rkt"
"style.rkt")
(provide standing-stickman-flomap standing-stickman-icon
running-stickman-flomap running-stickman-icon)
(provide (activate-contract-out
standing-stickman-icon standing-stickman-flomap
running-stickman-icon running-stickman-flomap)
(only-doc-out (all-defined-out)))
;; ===================================================================================================
;; Common
(define (cons+ p1 p2)
(match-define (cons x1 y1) p1)
@ -31,6 +37,9 @@
(define shin-length 6.5)
(define shoulder-breadth 7)
;; ===================================================================================================
;; Standing
(define standing-torso-angle -90)
(define standing-neck-angle 5)
(define standing-left-knee-angle 200)
@ -100,9 +109,12 @@
(polar->cartesian (+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle)
lower-arm-length)))
(define (standing-stickman-flomap color arm-color head-color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (standing-stickman-flomap [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)]
) flomap?
(make-cached-flomap
[height color arm-color head-color material]
(flomap-lt-superimpose
@ -161,6 +173,9 @@
(/ height 32)
material))))
;; ===================================================================================================
;; Running
(define running-neck-angle 20)
(define running-torso-angle -70)
@ -245,7 +260,7 @@
(define (running-head-flomap t color height material)
(make-cached-flomap
[height t color material]
(draw-short-rendered-icon-flomap
(draw-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" line-width 'solid)
(send dc set-brush color 'solid)
@ -257,7 +272,7 @@
(define (running-leg-flomap t body? color height material)
(make-cached-flomap
[height t body? color material]
(draw-short-rendered-icon-flomap
(draw-rendered-icon-flomap
26 32 (λ (dc)
(draw-running-leg dc t "black" (+ leg-width (* 2 line-width)))
(when body?
@ -270,16 +285,20 @@
(define (running-arm-flomap t color height material)
(make-cached-flomap
[height t color material]
(draw-short-rendered-icon-flomap
(draw-rendered-icon-flomap
26 32 (λ (dc)
(draw-running-arm dc t "black" (+ arm-width (* 2 line-width)))
(draw-running-arm dc t color arm-width))
(/ height 32)
material)))
(define (running-stickman-flomap t color arm-color head-color
[height (default-icon-height)]
[material (default-icon-material)])
(defproc (running-stickman-flomap [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)]
) flomap?
(make-cached-flomap
[height t color arm-color head-color 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-arm-flomap t arm-color height material))))
(define standing-stickman-icon (compose flomap->bitmap standing-stickman-flomap))
(define running-stickman-icon (compose flomap->bitmap running-stickman-flomap))
(defproc (standing-stickman-icon [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 (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!
(begin
(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)

View File

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

View File

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

View File

@ -1,287 +1,33 @@
#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/deep-flomap.rkt"
"icons/style.rkt"
"private/utils.rkt")
"compile-time.rkt"
(for-syntax racket/base
(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
(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))
;; 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 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 (plt-logo height)
(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)]))
(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 standard-planet-logo (delay (compiled-bitmap (private-planet-logo 256))))
(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))
(define (planet-logo height)
(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)]))

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))

View File

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

View File

@ -3,10 +3,18 @@
@(require scribble/eval
unstable/latent-contract/defthing
(for-label images/icons/arrow
images/icons/control
images/icons/file
images/icons/misc
images/icons/stickman
mrlib/switchable-button
racket
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")
@ -15,7 +23,8 @@
@(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?)}
@ -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.
@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}
@doc-apply[toolbar-icon-height]{
@ -64,303 +78,216 @@ The style of DrRacket icons, used as a default argument throughout the @racketmo
@section[#:tag "arrows"]{Arrow Icons}
@defmodule[images/icons/arrow]
@interaction-eval[#:eval icons-eval (require images/icons/arrow)]
@doc-apply[right-arrow-icon]
@doc-apply[left-arrow-icon]
@doc-apply[up-arrow-icon]
@doc-apply[down-arrow-icon]{
Cardinal direction arrows.
@interaction[#:eval icons-eval
(list (right-arrow-icon syntax-icon-color (toolbar-icon-height))
(left-arrow-icon run-icon-color)
(up-arrow-icon halt-icon-color 37)
(down-arrow-icon "lightblue" 44 glass-icon-material))]
@examples[#:eval icons-eval
(list (right-arrow-icon syntax-icon-color (toolbar-icon-height))
(left-arrow-icon run-icon-color)
(up-arrow-icon halt-icon-color 37)
(down-arrow-icon "lightblue" 44 glass-icon-material))]
}
@doc-apply[right-over-arrow-icon]
@doc-apply[left-over-arrow-icon]
@doc-apply[right-under-arrow-icon]
@doc-apply[left-under-arrow-icon]{
@interaction[#:eval icons-eval
(list (right-over-arrow-icon metal-icon-color (toolbar-icon-height))
(left-over-arrow-icon dark-metal-icon-color)
(right-under-arrow-icon run-icon-color 37)
(left-under-arrow-icon "lightgreen" 44 glass-icon-material))]
@examples[#:eval icons-eval
(list (right-over-arrow-icon metal-icon-color (toolbar-icon-height))
(left-over-arrow-icon dark-metal-icon-color)
(right-under-arrow-icon run-icon-color 37)
(left-under-arrow-icon "lightgreen" 44 glass-icon-material))]
}
@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}
@section[#:tag "stickman"]{Stickman Icons}
@section[#:tag "misc"]{Miscellaneous Icons}
@;{
@subsection{Control Icons}
@doc-apply[go-icon]
@doc-apply[bar-icon]
@doc-apply[play-icon]
@doc-apply[back-icon]
@doc-apply[fast-forward-icon]
@doc-apply[rewind-icon]
@doc-apply[bar-icon]
@doc-apply[stop-icon]
@doc-apply[record-icon]
@doc-apply[pause-icon]
@doc-apply[step-icon]
@doc-apply[step-back-icon]
@doc-apply[continue-icon]
@doc-apply[continue-back-icon]
@doc-apply[fast-forward-icon]
@doc-apply[rewind-icon]
@doc-apply[pause-icon]{
These return typical ``playback'' icons.
@interaction[#:eval icons-eval
@doc-apply[continue-back-icon]{
Typical ``playback control'' icons.
For example, a colorful tape deck:
@interaction[#:eval icons-eval
(for/list ([make-icon (list rewind-icon continue-back-icon
step-back-icon back-icon
pause-icon stop-icon
go-icon step-icon
play-icon step-icon
continue-icon fast-forward-icon
record-icon)]
[style (in-cycle icon-styles)])
(make-icon (solid-icon-color "darkseagreen") 32 style))]
The remaining icon @(bar-icon #f 16), returned by @racket[bar-icon], is used to build the others.
[color (list run-icon-color halt-icon-color
syntax-icon-color metal-icon-color
dark-metal-icon-color dark-metal-icon-color
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]
@doc-apply[down-arrow-icon]
@doc-apply[left-arrow-icon]
@doc-apply[right-arrow-icon]{
@defmodule[images/icons/file]
@interaction-eval[#:eval icons-eval (require images/icons/file)]
@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
(for/list ([make-icon (list up-arrow-icon down-arrow-icon
left-arrow-icon right-arrow-icon)])
(for/list ([style (in-list icon-styles)])
(make-icon (solid-icon-color "brown") (default-icon-height) style)))]
(for/list ([make-icon (list save-icon small-save-icon
load-icon small-load-icon)]
[color (list run-icon-color halt-icon-color
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]{
@examples[#:eval icons-eval (list (stop-sign-icon (default-icon-height) 'diffuse)
(stop-sign-icon (default-icon-height) 'shiny))]
@defmodule[images/icons/misc]
@interaction-eval[#:eval icons-eval (require images/icons/misc)]
@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[check-icon]{
@examples[#:eval icons-eval
(list (check-icon (solid-icon-color "green") 29 'diffuse)
(check-icon (solid-icon-color "green") 29 'shiny))]
@doc-apply[recycle-icon]{
Returns the universal recycling symbol, rendered as an icon.
Its implementation calls @racket[text-icon] with the string @racket["\u267b"].
@examples[#:eval icons-eval (recycle-icon "forestgreen" 48)]
}
@doc-apply[x-icon]{
@examples[#:eval icons-eval
(for/list ([color icon-colors]
[style (in-cycle icon-styles)])
(x-icon color 29 style))]
Returns an ``x'' icon that is guaranteed to look the same on all platforms.
(Anything similar that would be constructed by @racket[text-icon] would differ at least slightly across platforms.)
@examples[#:eval icons-eval (x-icon "red" 32)]
}
@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]{
@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
(for/list ([color icon-colors]
[style (in-cycle icon-styles)])
(disk-icon color 33 style))]
(magnifying-glass-icon "azure" "lightblue" 32 glass-icon-material)]
}
@doc-apply[earth-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]{
@doc-apply[left-magnifying-glass-icon]{
@examples[#:eval icons-eval
(for/list ([color icon-colors]
[style (in-cycle icon-styles)])
(plus-icon color 24 style))]
(left-magnifying-glass-icon metal-icon-color "red" 32)]
}
@doc-apply[times-icon]{
@doc-apply[bomb-icon]{
@examples[#:eval icons-eval
(for/list ([color icon-colors]
[style (in-cycle icon-styles)])
(times-icon color 24 style))]
(bomb-icon "azure" "black" 32 glass-icon-material)]
}
@subsection{Logos}
@doc-apply[plt-logo]{
@doc-apply[left-bomb-icon]{
@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]{
@examples[#:eval icons-eval (list (planet-logo 128 'diffuse)
(planet-logo 128 'shiny))]
@section[#:tag "stickman"]{Stickman Icons}
@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}
@;{
@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:
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:
@interaction[#:eval icons-eval
(require plot)
(for/list ([color (rest icon-colors)])
(stop-flomap color 48))
(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.
}}
(for/list ([t (in-range 0 1 1/12)])
(running-stickman-icon t run-icon-color "white" run-icon-color 32))]
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:
@doc-apply[icon-color/c]{
A contract that identifies color names.
@centered[@image["scribblings/running-stickman.gif"]]
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]{
Typical icon styles.
@section[#:tag "tool"]{Tool Icons}
It is not necessary to have a version of each icon in each style.
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]. }
}
@section[#:tag "const"]{Icon Constants and Contracts}

Binary file not shown.

After

Width:  |  Height:  |  Size: 43 KiB

View File

@ -37,7 +37,7 @@
;; Other icons, various colors
(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)
(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)