Lightened icon outlines

Added lambda icon, foot icon, search forward/back icons

Doc fixes

Stepper: icons on buttons, logo and about dialog

Macro stepper: icons on buttons, logo and about dialog

Please merge into release
(cherry picked from commit 4a09c04581)
This commit is contained in:
Neil Toronto 2012-01-15 20:57:02 -07:00 committed by Ryan Culpepper
parent b96b647e2b
commit a8642d8a4b
35 changed files with 851 additions and 487 deletions

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.5 KiB

97
collects/images/gui.rkt Normal file
View File

@ -0,0 +1,97 @@
#lang racket/base
(require racket/gui racket/class string-constants)
(provide bitmap-canvas% logo-about-dialog%)
(define bitmap-canvas%
(class canvas%
(init parent)
(init-field bitmap)
(init [enabled #t] [vert-margin 0] [horiz-margin 0])
(inherit get-dc refresh min-width min-height)
(super-new [parent parent]
[enabled enabled]
[vert-margin vert-margin]
[horiz-margin horiz-margin]
[stretchable-width #f]
[stretchable-height #f]
[style '(transparent no-focus)])
(min-width (send bitmap get-width))
(min-height (send bitmap get-height))
(define/public (set-bitmap new-bitmap)
(set! bitmap new-bitmap)
(min-width (send bitmap get-width))
(min-height (send bitmap get-height))
(refresh))
(define/override (on-paint)
(send (get-dc) draw-bitmap bitmap 0 0))
))
(define message-text%
(class text%
(init messages)
(super-new [auto-wrap #t])
(define writable? #t)
(define/augment (can-change-style? start len) writable?)
(define/augment (can-delete? start len) writable?)
(define/augment (can-insert? start len) writable?)
(define/augment (can-load-file? filename format) writable?)
(define/augment (can-save-file? filename format) writable?)
(define/override (can-do-edit-operation? op [recursive? #t])
(case op
[(copy select-all) #t]
[else writable?]))
(for ([message (in-list messages)])
(send this insert message))
(set! writable? #f)))
(define message-canvas%
(class editor-canvas%
(init parent messages [horiz-margin 0] [vert-margin 0])
(super-new [parent parent]
[editor (new message-text% [messages messages])]
[horizontal-inset 0] [vertical-inset 0]
[horiz-margin 0] [vert-margin 0]
[enabled #t] [style '(auto-vscroll auto-hscroll no-border transparent)])))
(define logo-about-dialog%
(class dialog%
(init label parent bitmap messages [width 640] [height 200] [enabled #t])
(super-new [label label]
[parent parent]
[width width]
[height height]
[enabled enabled]
[spacing 10]
[border 10])
(define top-panel
(new horizontal-panel% [parent this] [alignment '(center top)] [spacing 20]))
(define bitmap-canvas
(new bitmap-canvas% [parent top-panel] [bitmap bitmap]))
(define message-canvas
(new message-canvas% [parent top-panel] [messages messages]))
(define close-button
(new button%
[label (string-constant close)]
[parent this]
[callback (λ (_1 _2)
(when (send this can-close?)
(send this on-close)
(send this show #f)))]
[style '(border)]))
(send close-button focus)
))

View File

@ -26,6 +26,7 @@
(let ([color (->color% color)])
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 9) '(15 . 9) '(14 . 0)
'(31 . 15.5)
@ -37,6 +38,7 @@
) flomap?
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(draw-path-commands
dc 0 0 '((m 0 15)

View File

@ -18,14 +18,17 @@
pause-icon pause-flomap
step-icon step-flomap
step-back-icon step-back-flomap
continue-icon continue-flomap
continue-back-icon continue-back-flomap)
continue-forward-icon continue-forward-flomap
continue-backward-icon continue-backward-flomap
search-forward-icon search-forward-flomap
search-backward-icon search-backward-flomap)
(only-doc-out (all-defined-out)))
(define (flat-play-flomap color height)
(draw-icon-flomap
24 32
(λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list (cons 0 0) (cons 4 0)
(cons 23 13) (cons 23 18)
@ -45,8 +48,18 @@
[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))
(make-cached-flomap
[height color material]
(define fm (draw-rendered-icon-flomap
20 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list (cons 0 0) (cons 4 0)
(cons 19 13) (cons 19 18)
(cons 4 31) (cons 0 31))))
(/ height 32)
material))
(flomap-hc-append fm fm)))
(defproc (stop-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -56,6 +69,7 @@
[height color material]
(draw-rendered-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 0) '(31 . 0) '(31 . 31) '(0 . 31))))
(/ height 32)
@ -69,6 +83,7 @@
[height color material]
(draw-rendered-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(draw-ellipse/smoothed dc 0 0 32 32))
(/ height 32)
@ -82,6 +97,7 @@
[height color material]
(draw-rendered-icon-flomap
8 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 0) '(7 . 0) '(7 . 31) '(0 . 31))))
(/ height 32)
@ -126,24 +142,42 @@
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(back-flomap color height 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?
(defproc (continue-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?
(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)))
(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?
(defproc (continue-backward-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)))
(defproc (search-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?
(flomap-hc-append
(fast-forward-flomap color height material)
(make-flomap 4 (max 1 (inexact->exact (round (* 1/16 height)))) 0)
(bar-flomap color height material)))
(defproc (search-backward-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)
(rewind-flomap color height material)))
(define-icon-wrappers
([color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -158,5 +192,7 @@
[pause-icon pause-flomap]
[step-icon step-flomap]
[step-back-icon step-back-flomap]
[continue-icon continue-flomap]
[continue-back-icon continue-back-flomap])
[continue-forward-icon continue-forward-flomap]
[continue-backward-icon continue-backward-flomap]
[search-forward-icon search-forward-flomap]
[search-backward-icon search-backward-flomap])

View File

@ -69,7 +69,7 @@
(send dc draw-rectangle 2.5 i 16 1)))
scale)]
[dfm (flomap->deep-flomap fm)]
[dfm (deep-flomap-bulge-vertical dfm (* 4 scale))])
[dfm (deep-flomap-bulge-vertical dfm (* 2 scale))])
(deep-flomap-render-icon dfm matte-material)))
(define top-indent-fm
@ -84,6 +84,7 @@
(define case-fm
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(send dc draw-polygon (list '(0 . 3) '(3 . 0)
'(28 . 0) '(31 . 3)

View File

@ -16,6 +16,8 @@
octagon-icon octagon-flomap
stop-sign-icon stop-sign-flomap
stop-signs-icon stop-signs-flomap
foot-icon foot-flomap
lambda-icon lambda-flomap
magnifying-glass-icon magnifying-glass-flomap
left-magnifying-glass-icon left-magnifying-glass-flomap
bomb-icon bomb-flomap
@ -30,7 +32,8 @@
(define mx 23.5)
(draw-icon-flomap
32 32 (λ (dc)
(send dc set-pen (make-object pen% "black" 12 'solid 'projecting 'miter))
(send dc set-pen (make-object pen% (icon-color->outline-color color)
12 'solid 'projecting 'miter))
(send dc draw-line mn mn mx mx)
(send dc draw-line mn mx mx mn)
(send dc set-pen (make-object pen% color 10 'solid 'projecting 'miter))
@ -41,6 +44,7 @@
(define (flat-check-flomap color height)
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(draw-path-commands
dc 0 0 '((m 0 19)
@ -54,6 +58,7 @@
(let ([start (- start)])
(draw-icon-flomap
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(define (/ (* 2 pi) sides))
(define θs (sequence->list (in-range start (+ start (* 2 pi)) )))
@ -84,20 +89,22 @@
[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 outline-color (icon-color->outline-color color))
(define r (/ (send outline-color red) 255.0))
(define g (/ (send outline-color green) 255.0))
(define b (/ (send outline-color blue) 255.0))
(define-values (w h) (get-text-size str font))
(define ceiling-amt (inexact->exact (ceiling outline)))
(define fm
(let* ([fm (draw-flomap
w h (λ (dc)
(send dc set-font font)
(send dc set-text-foreground color)
(send dc draw-text str 0 0 #t)))]
[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 . > . 0) (flomap-outlined fm outline) fm)])
fm))
(flomap-render-icon fm material))))
(let* ([fm (draw-flomap
w h (λ (dc)
(send dc set-font font)
(send dc set-text-foreground color)
(send dc draw-text str 0 0 #t)))]
[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 . > . 0) (flomap-outlined fm outline (list r g b)) fm)])
(flomap-render-icon fm material)))))
(defproc (recycle-flomap [color (or/c string? (is-a?/c color%))]
[height (and/c rational? (>=/c 0)) (default-icon-height)]
@ -129,6 +136,79 @@
[dfm (deep-flomap-raise dfm (* -12 scale))])
(deep-flomap-render-icon dfm material))))
(define lambda-path-commands
'((m 8.5 1.5)
(c -1.6356765828908555 0.029546719528023596
-3.191760877876106 0.5981878749262537
-4.720477489085545 1.1242189706194692)
(c 0.6669351268436579 0.7142825307374631
0.5663221427728614 0.9399074888495575
0.8574087929203539 0.8856493838348083)
(c 1.1139361982300886 -0.26979469970501474
2.7661170029498527 -0.8976661899705014
3.5022074713864306 0.2920653404129794)
(c 1.604836361061947 2.027318824778761
2.2854387162241885 4.621830343362832
2.528554440117994 7.151444427138643)
(c 0.3116530407079646 1.536908007079646
-2.857777387610619 7.039676186430679
-3.8315742017699113 9.23609637758112)
(c -1.5828472448377582 2.792818935693215
-2.9889992117994097 5.691217406489675
-4.772427818289086 8.366316818879056)
(c 0.42649146902654866 0.5644402784660767
1.0427237946902654 0.34355411445427725
1.6228086182890855 0.25676724483775815)
(c 0.49529097817109147 -0.07420284601769911
0.9905831646017699 -0.14840448377581122
1.4858741427728612 -0.22260672566371684)
(c 1.5973270277286136 -3.787185161061947
3.3219870961651914 -7.263537085545722
4.820870569911505 -11.091467780530973)
(c 0.6830176660766961 -1.5775599008849557
1.0166688849557521 -2.445292667846608
1.8281710631268435 -3.4783485734513273)
(c 0.9620301781710914 0.5885710348082596
1.2484493215339232 2.040281637758112
1.77328405899705 3.0419137321533922)
(c 1.5467160542772862 3.979993184660766
3.0867486206489674 7.962568420058997
4.546565437168141 11.975105472566373)
(c 0.3820927622418879 0.13305596224188793
0.7742605970501475 0.5306156554572271
1.1366913510324481 0.14744150088495575)
(c 0.9533687693215339 -0.5878412460176992
2.0633098572271384 -0.9560281486725664
2.857080825958702 -1.7685525144542773)
(c -0.2264924884955752 -1.0982469474926253
-0.9541940106194691 -2.1254820625368733
-1.3975098902654866 -3.181664056637168)
(c -2.8100934230088495 -5.615961562241888
-5.519535197640117 -11.572843233038348
-7.278479027728613 -17.620018746902655)
(c -0.6478138147492625 -1.9033066855457228
-1.4455158560471977 -4.19687149120944
-3.5071903339233037 -4.948212008023599)
(c -0.46965654277286134 -0.13943394171091444
-0.9645608778761062 -0.1662308436578171
-1.451858010619469 -0.16614886324483774)))
(defproc (lambda-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
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 4 'solid)
(send dc set-brush (icon-color->outline-color color) 'solid)
(draw-path-commands dc 4 0 lambda-path-commands)
(set-icon-pen dc color 2 'solid)
(send dc set-brush color 'solid)
(draw-path-commands dc 4 0 lambda-path-commands))
(/ height 32)
material)))
(defproc (regular-polygon-flomap [sides exact-positive-integer?]
[start real?]
[color (or/c string? (is-a?/c color%))]
@ -167,6 +247,24 @@
(flomap-pin* 3/16 1/4 0 0
fm (flomap-pin* 3/16 1/4 0 0 fm fm)))
(defproc (foot-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
32 32 (λ (dc)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(draw-ellipse/smoothed dc 4 8 24 24)
(draw-ellipse/smoothed dc 0 10 5 4.5)
(draw-ellipse/smoothed dc 3 4.5 5.5 5.5)
(draw-ellipse/smoothed dc 8.75 1 6.25 6.25)
(draw-ellipse/smoothed dc 16 0 7 7)
(draw-ellipse/smoothed dc 23.5 1.5 8.5 10))
(/ height 32)
material)))
;; ---------------------------------------------------------------------------------------------------
;; Magnifying glass
@ -188,12 +286,8 @@
(define glass-fm
(let* ([fm (draw-icon-flomap
18 18 (λ (dc)
(send dc set-pen handle-color 1 'solid)
(set-icon-pen dc (icon-color->outline-color "azure") 1 'solid)
(send dc set-brush "azure" 'solid)
(draw-ellipse/smoothed dc 0 0 18 18)
(send dc set-alpha 0.5)
(send dc set-pen "black" 1 'solid)
(send dc set-brush "white" 'transparent)
(draw-ellipse/smoothed dc 0 0 18 18))
scale)]
[dfm (flomap->deep-flomap fm)]
@ -204,8 +298,9 @@
(define circle-fm
(let* ([fm (draw-icon-flomap
28 28 (λ (dc)
(send dc set-pen "black" 3 'solid)
(send dc set-brush "black" 'solid)
(define outline-color (icon-color->outline-color frame-color))
(send dc set-pen outline-color 3 'solid)
(send dc set-brush outline-color 'solid)
(draw-ellipse/smoothed dc 1 1 26 26)
(send dc set-pen frame-color 1 'solid)
(send dc set-brush frame-color 'solid)
@ -228,6 +323,7 @@
(define handle-fm
(let* ([fm (draw-icon-flomap
11 11 (λ (dc)
(set-icon-pen dc (icon-color->outline-color handle-color) 1 'solid)
(send dc set-brush handle-color 'solid)
(define p (new dc-path%))
(send p move-to 4 0)
@ -286,7 +382,7 @@
(define (bomb-cap-flomap color)
(draw-icon-flomap
20 20 (λ (dc)
(send dc set-pen "black" 1 'solid)
(set-icon-pen dc (icon-color->outline-color color) 1 'solid)
(send dc set-brush color 'solid)
(draw-path-commands dc 0 0 '((m 1.5 11.5)
(l 10 -10 2.5 2.5)
@ -306,6 +402,7 @@
(define sphere-fm
(let* ([sphere-fm (draw-icon-flomap
30 30 (λ (dc)
(set-icon-pen dc (icon-color->outline-color bomb-color) 1 'solid)
(send dc set-brush bomb-color 'solid)
(draw-ellipse/smoothed dc 0 0 30 30))
scale)]
@ -356,7 +453,9 @@
[check-icon check-flomap]
[octagon-icon octagon-flomap]
[stop-sign-icon stop-sign-flomap]
[stop-signs-icon stop-signs-flomap])
[stop-signs-icon stop-signs-flomap]
[foot-icon foot-flomap]
[lambda-icon lambda-flomap])
(define-icon-wrappers
([frame-color (or/c string? (is-a?/c color%))]

View File

@ -106,8 +106,9 @@
(define standing-right-hand-point
(cons+ standing-right-elbow-point
(polar->cartesian (+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle)
lower-arm-length)))
(polar->cartesian
(+ standing-right-elbow-angle standing-torso-angle standing-right-hand-angle)
lower-arm-length)))
(defproc (standing-stickman-flomap [color (or/c string? (is-a?/c color%))]
[arm-color (or/c string? (is-a?/c color%))]
@ -120,7 +121,8 @@
(flomap-lt-superimpose
(draw-short-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" (+ arm-width (* 2 line-width)) 'solid)
(send dc set-pen (icon-color->outline-color arm-color)
(+ arm-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-right-shoulder-point
standing-right-elbow-point
standing-right-hand-point))
@ -132,17 +134,22 @@
material)
(draw-short-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" (+ body-width (* 2 line-width)) 'solid)
(send dc set-pen (icon-color->outline-color color)
(+ body-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-neck-point standing-hip-point))
(send dc set-pen "black" (+ leg-width (* 2 line-width)) 'solid)
(send dc set-pen (icon-color->outline-color color)
(+ leg-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-hip-point
standing-left-knee-point
standing-left-foot-point))
(send dc draw-lines (list standing-hip-point
standing-right-knee-point
standing-right-foot-point))
(send dc set-pen color body-width 'solid)
(send dc draw-lines (list standing-neck-point standing-hip-point))
(send dc set-pen color leg-width 'solid)
(send dc draw-lines (list standing-hip-point
standing-left-knee-point
@ -154,7 +161,8 @@
material)
(draw-short-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" (+ arm-width (* 2 line-width)) 'solid)
(send dc set-pen (icon-color->outline-color arm-color)
(+ arm-width (* 2 line-width)) 'solid)
(send dc draw-lines (list standing-left-shoulder-point
standing-left-elbow-point
standing-left-hand-point))
@ -166,7 +174,7 @@
material)
(draw-short-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" line-width 'solid)
(send dc set-pen (icon-color->outline-color head-color) line-width 'solid)
(send dc set-brush head-color 'solid)
(match-define (cons x y) standing-head-point)
(draw-ellipse/smoothed dc (- x 3.5) (- y 3.5) 8 8))
@ -262,7 +270,7 @@
[height t color material]
(draw-rendered-icon-flomap
26 32 (λ (dc)
(send dc set-pen "black" line-width 'solid)
(send dc set-pen (icon-color->outline-color color) line-width 'solid)
(send dc set-brush color 'solid)
(match-define (cons x y) (running-head-point t))
(draw-ellipse/smoothed dc (- x 3.5) (- y 3.5) 8 8))
@ -274,9 +282,10 @@
[height t body? color material]
(draw-rendered-icon-flomap
26 32 (λ (dc)
(draw-running-leg dc t "black" (+ leg-width (* 2 line-width)))
(draw-running-leg dc t (icon-color->outline-color color) (+ leg-width (* 2 line-width)))
(when body?
(draw-running-body dc t "black" (+ body-width (* 2 line-width)))
(draw-running-body dc t (icon-color->outline-color color)
(+ body-width (* 2 line-width)))
(draw-running-body dc t color body-width))
(draw-running-leg dc t color leg-width))
(/ height 32)
@ -287,7 +296,7 @@
[height t color material]
(draw-rendered-icon-flomap
26 32 (λ (dc)
(draw-running-arm dc t "black" (+ arm-width (* 2 line-width)))
(draw-running-arm dc t (icon-color->outline-color color) (+ arm-width (* 2 line-width)))
(draw-running-arm dc t color arm-width))
(/ height 32)
material)))

View File

@ -74,7 +74,24 @@
draw-rendered-icon-flomap
flomap-render-thin-icon
draw-short-rendered-icon-flomap
define-icon-wrappers)
define-icon-wrappers
(activate-contract-out
icon-color->outline-color
set-icon-pen))
(defproc (set-icon-pen [dc (is-a?/c dc<%>)]
[color (or/c string? (is-a?/c color%))]
[width (>=/c 0)]
[style symbol?]) void?
(send dc set-pen (make-object pen% color width style 'projecting 'miter)))
(defproc (icon-color->outline-color [color (or/c string? (is-a?/c color%))]) (is-a?/c color%)
(cond [(string? color) (icon-color->outline-color (send the-color-database find-color color))]
[else
(define r (send color red))
(define g (send color green))
(define b (send color blue))
(make-object color% (quotient r 2) (quotient g 2) (quotient b 2))]))
(define icon-lighting
(deep-flomap-lighting-value
@ -103,7 +120,7 @@
(send dc set-scale scale scale)
(send dc set-smoothing 'smoothed)
(send dc set-origin (* 0.5 scale) (* 0.5 scale))
(send dc set-pen (make-object pen% "black" 1 'solid 'projecting 'miter))
(set-icon-pen dc "black" 10 'solid)
(draw-proc dc))))
(define (flomap-render-icon fm material)

View File

@ -1,40 +1,331 @@
#lang racket/base
(require racket/class racket/draw racket/promise
(require racket/class racket/draw racket/math racket/match
racket/contract unstable/latent-contract unstable/latent-contract/defthing
(rename-in "private/logos.rkt"
[plt-logo uncached-plt-logo]
[planet-logo uncached-planet-logo])
"private/flomap.rkt"
"compile-time.rkt"
(for-syntax racket/base
(rename-in "private/logos.rkt"
[plt-logo uncached-plt-logo]
[planet-logo uncached-planet-logo])
"private/flomap.rkt"))
"private/deep-flomap.rkt"
"private/utils.rkt"
"icons/misc.rkt"
"icons/style.rkt")
(provide (activate-contract-out
plt-logo plt-flomap
planet-logo planet-flomap)
(only-doc-out (all-from-out "private/logos.rkt"))
planet-logo planet-flomap
stepper-logo stepper-flomap
macro-stepper-logo macro-stepper-logo-flomap)
(only-doc-out (all-defined-out)))
;; Use a delay to keep from using more memory than necessary (saves 256KB)
(define standard-plt-logo (delay (compiled-bitmap (uncached-plt-logo 256))))
(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))
(defproc (plt-logo [height (and/c rational? (>=/c 0)) 256]) (is-a?/c bitmap%)
(cond [(height . = . 256) (force standard-plt-logo)]
[(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-plt-logo)) #f height))]
[else
(uncached-plt-logo height)]))
(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 standard-planet-logo (delay (compiled-bitmap (uncached-planet-logo 256))))
(define blue-θ-start (* -45 (/ pi 180)))
(define blue-θ-end (* 110 (/ pi 180)))
(defproc (planet-logo [height (and/c rational? (>=/c 0)) 256]) (is-a?/c bitmap%)
(cond [(height . = . 256) (force standard-planet-logo)]
[(height . <= . 256)
(flomap->bitmap (flomap-resize (bitmap->flomap (force standard-planet-logo)) #f height))]
[else
(uncached-planet-logo height)]))
(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))))
(defproc (plt-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(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))
(defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(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)))
(defproc (stepper-flomap [height (and/c rational? (>=/c 0)) 96]) flomap?
(flomap-pin*
1/2 20/32 1/2 1/2
(foot-flomap "forestgreen" height glass-icon-material)
(lambda-flomap light-metal-icon-color (* 5/8 height) metal-icon-material)))
(defproc (macro-stepper-logo-flomap [height (and/c rational? (>=/c 0)) 96]) flomap?
(define outline-color (icon-color->outline-color light-metal-icon-color))
(define (draw-hash dc)
(send dc draw-polygon '((5 . 0) (8 . 0) (6 . 19) (3 . 19)))
(send dc draw-polygon '((13 . 0) (16 . 0) (14 . 19) (11 . 19)))
(send dc draw-polygon '((1 . 4) (1 . 7) (19 . 7) (19 . 4)))
(send dc draw-polygon '((0 . 12) (0 . 15) (18 . 15) (18 . 12))))
(flomap-pin*
1/2 20/32 1/2 1/2
(foot-flomap (make-object color% 34 42 160) height glass-icon-material)
(draw-rendered-icon-flomap
32 32 (λ (dc)
(send dc translate 6 6)
(set-icon-pen dc outline-color 2 'solid)
(send dc set-brush outline-color 'solid)
(draw-hash dc)
(send dc set-pen "black" 1 'transparent)
(send dc set-brush light-metal-icon-color 'solid)
(draw-hash dc))
(/ (* 3/4 height) 32)
metal-icon-material)))
(define-icon-wrappers
([height (and/c rational? (>=/c 0)) 256])
[plt-logo plt-flomap])
(define-icon-wrappers
([height (and/c rational? (>=/c 0)) 96])
[planet-logo planet-flomap]
[stepper-logo stepper-flomap]
[macro-stepper-logo macro-stepper-logo-flomap])

View File

@ -1,290 +0,0 @@
#lang racket/base
(require racket/draw racket/class racket/match racket/math racket/flonum
racket/contract unstable/latent-contract unstable/latent-contract/defthing
"flomap.rkt"
"deep-flomap.rkt"
"utils.rkt"
"../icons/style.rkt")
(provide plt-logo planet-logo
plt-flomap planet-flomap
(only-doc-out (all-defined-out)))
(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))))
(defproc (plt-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(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))
(defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
(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

@ -9,3 +9,5 @@
@title{Embedding Bitmaps in Compiled Files}
@author{@(author+email "Neil Toronto" (author-email))}
@defmodule[images/compile-time]

View File

@ -31,6 +31,8 @@
@(define icons-eval (make-base-eval))
@interaction-eval[#:eval icons-eval (require racket/class racket/draw racket/math racket/list)]
@;====================================================================================================
@section{What is an icon?}
@margin-note*{This section describes an ideal that DrRacket and its tools are steadily approaching.}
@ -58,6 +60,8 @@ especially for new users and people with certain forms of color-blindness, and t
As another example, the Check Syntax icon @(check-syntax-icon 16) connotes inspecting and passing. Note that the check mark is also the color of syntax.
@;====================================================================================================
@section{About These Icons}
The icons in this collection are designed to be composed to create new ones: they are simple, thematically consistent, and can be constructed in any size and color.
@ -80,6 +84,11 @@ See the @racket[plt-logo] and @racket[planet-logo] functions for more striking e
When the rendering API is stable enough to publish, it will allow anyone who can draw a shape to turn that shape into a visually consistent icon.
As with any sort of rendering (such as @link["http://en.wikipedia.org/wiki/Scalable_Vector_Graphics"]{SVG} rendering), ray tracing takes time.
For icons, this usually happens during tool or application start up.
You can reduce the portion of start-up time taken by rendering to almost nothing by using the @racketmodname[images/compile-time] library to embed bitmaps directly into compiled modules.
@;====================================================================================================
@section{Icon Style}
@ -139,7 +148,8 @@ It has the high refractive index of @link["http://en.wikipedia.org/wiki/Cubic_zi
The ``glassy look'' cannot actually be achieved using glass.
Metal reflects the most, its @link["http://en.wikipedia.org/wiki/Specular_highlight"]{specular highlight} is nearly the same color as the material (in the others, the highlight is white),
and it diffuses much more ambient light than directional. This is because, while plastic and glass mostly reflect light directly, metal mostly absorbs light and re-emits it.
and it diffuses much more ambient light than directional.
This is because, while plastic and glass mostly reflect light directly, metal mostly absorbs light and re-emits it.
@examples[#:eval icons-eval
(require images/icons/misc)
@ -154,6 +164,8 @@ The material used for rendering most icons and icon parts.
There are exceptions; for example, the @racket[floppy-disk-icon] always renders the sliding cover in metal.
}
@;====================================================================================================
@section[#:tag "arrows"]{Arrow Icons}
@defmodule[images/icons/arrow]
@ -163,6 +175,7 @@ There are exceptions; for example, the @racket[floppy-disk-icon] always renders
@doc-apply[left-arrow-icon]
@doc-apply[up-arrow-icon]
@doc-apply[down-arrow-icon]{
Standard directional arrows.
@examples[#:eval icons-eval
(list (right-arrow-icon syntax-icon-color (toolbar-icon-height))
(left-arrow-icon run-icon-color)
@ -174,6 +187,7 @@ There are exceptions; for example, the @racket[floppy-disk-icon] always renders
@doc-apply[left-over-arrow-icon]
@doc-apply[right-under-arrow-icon]
@doc-apply[left-under-arrow-icon]{
Standard bent arrows.
@examples[#:eval icons-eval
(list (right-over-arrow-icon metal-icon-color (toolbar-icon-height))
(left-over-arrow-icon dark-metal-icon-color)
@ -181,43 +195,32 @@ There are exceptions; for example, the @racket[floppy-disk-icon] always renders
(left-under-arrow-icon "lightgreen" 44 glass-icon-material))]
}
@;====================================================================================================
@section[#:tag "control"]{Control Icons}
@defmodule[images/icons/control]
@interaction-eval[#:eval icons-eval (require images/icons/control)]
@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]{
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
play-icon step-icon
continue-icon fast-forward-icon
record-icon)]
[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.
@doc-apply[bar-icon]{
@examples[#:eval icons-eval (bar-icon run-icon-color 32)]
This is not a ``control'' icon @italic{per se}, but is used to make many others.
}
@doc-apply[play-icon]{ @examples[#:eval icons-eval (play-icon run-icon-color 32)] }
@doc-apply[back-icon]{ @examples[#:eval icons-eval (back-icon run-icon-color 32)] }
@doc-apply[fast-forward-icon]{ @examples[#:eval icons-eval (fast-forward-icon syntax-icon-color 32)] }
@doc-apply[rewind-icon]{ @examples[#:eval icons-eval (rewind-icon syntax-icon-color 32)] }
@doc-apply[stop-icon]{ @examples[#:eval icons-eval (stop-icon halt-icon-color 32)] }
@doc-apply[record-icon]{ @examples[#:eval icons-eval (record-icon "red" 32)] }
@doc-apply[pause-icon]{ @examples[#:eval icons-eval (pause-icon halt-icon-color 32)] }
@doc-apply[step-icon]{ @examples[#:eval icons-eval (step-icon run-icon-color 32)] }
@doc-apply[step-back-icon]{ @examples[#:eval icons-eval (step-back-icon run-icon-color 32)] }
@doc-apply[continue-forward-icon]{ @examples[#:eval icons-eval (continue-forward-icon run-icon-color 32)] }
@doc-apply[continue-backward-icon]{ @examples[#:eval icons-eval (continue-backward-icon run-icon-color 32)] }
@doc-apply[search-forward-icon]{ @examples[#:eval icons-eval (search-forward-icon syntax-icon-color 32)] }
@doc-apply[search-backward-icon]{ @examples[#:eval icons-eval (search-backward-icon syntax-icon-color 32)] }
@;====================================================================================================
@section[#:tag "file"]{File Icons}
@ -240,6 +243,8 @@ The remaining icon @(bar-icon "red" 16), returned by @racket[bar-icon], is used
(make-icon syntax-icon-color color 32))]
}
@;====================================================================================================
@section[#:tag "misc"]{Miscellaneous Icons}
@defmodule[images/icons/misc]
@ -316,6 +321,16 @@ Equivalent to @racket[(regular-polygon-icon 8 (/ (* 2 pi) 16) color height mater
(stop-signs-icon halt-icon-color 32 plastic-icon-material)]
}
@doc-apply[foot-icon]{
@examples[#:eval icons-eval
(foot-icon "chocolate" 32 glass-icon-material)]
}
@doc-apply[lambda-icon]{
@examples[#:eval icons-eval
(lambda-icon light-metal-icon-color 32 metal-icon-material)]
}
@doc-apply[magnifying-glass-icon]{
@examples[#:eval icons-eval
(magnifying-glass-icon light-metal-icon-color "lightblue" 32
@ -337,6 +352,8 @@ Equivalent to @racket[(regular-polygon-icon 8 (/ (* 2 pi) 16) color height mater
(left-bomb-icon metal-icon-color dark-metal-icon-color 32)]
}
@;====================================================================================================
@section[#:tag "stickman"]{Stickman Icons}
@defmodule[images/icons/stickman]
@ -368,6 +385,8 @@ The stickman's joint angles are defined by continuous periodic functions, so the
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}.
}
@;====================================================================================================
@section[#:tag "tool"]{Tool Icons}
@defmodule[images/icons/tool]

View File

@ -18,19 +18,23 @@
@doc-apply[plt-logo]{
Returns the PLT logo, rendered in tinted glass and azure metal by the ray tracer that renders icons.
@examples[#:eval logos-eval (plt-logo)]
A 256×256 (default height) rendering is compiled into the @racketmodname[images/logos] module using @racket[compiled-bitmap], meaning that constructing the logo at that size and smaller is cheap.
In fact, constructing the logo at the default height is essentially free because it does not need to be downscaled.
The default height is the size used for DrRacket splash screen.
}
@doc-apply[planet-logo]{
Returns an unofficial PLaneT logo. This is used as the PLaneT icon when DrRacket downloads PLaneT packages.
@examples[#:eval logos-eval
(planet-logo)
(planet-logo (default-icon-height))]
As with the @racket[plt-logo], a default-height rendering is compiled into the @racketmodname[images/logos] module for performance reasons.
}
@doc-apply[stepper-logo]{
An algebraic stepper logo.
@examples[#:eval logos-eval (stepper-logo)]
}
@doc-apply[macro-stepper-logo]{
A macro stepper logo.
@examples[#:eval logos-eval (macro-stepper-logo)]
}

Binary file not shown.

Before

Width:  |  Height:  |  Size: 43 KiB

After

Width:  |  Height:  |  Size: 44 KiB

View File

@ -2,4 +2,5 @@
(define drracket-tools '(["tool.rkt"]))
(define drracket-tool-names '("Macro Stepper"))
(define drracket-tool-icons (list '("macro-stepper-32x32.png" "icons")))
(define scribblings '(("macro-debugger.scrbl" () (tool-library))))

View File

@ -15,10 +15,33 @@
"gui-util.rkt"
"../syntax-browser/util.rkt"
unstable/gui/notify
images/compile-time
images/gui
(for-syntax racket/base
images/icons/arrow images/icons/control images/logos
images/icons/style)
(only-in mzscheme [#%top-interaction mz-top-interaction]))
(provide macro-stepper-widget%
macro-stepper-widget/process-mixin)
;; Compiled-in assets (button icons)
(define navigate-up-icon
(compiled-bitmap (up-arrow-icon syntax-icon-color (toolbar-icon-height))))
(define navigate-to-start-icon
(compiled-bitmap (search-backward-icon syntax-icon-color (toolbar-icon-height))))
(define navigate-previous-icon
(compiled-bitmap (step-back-icon syntax-icon-color (toolbar-icon-height))))
(define navigate-next-icon
(compiled-bitmap (step-icon syntax-icon-color (toolbar-icon-height))))
(define navigate-to-end-icon
(compiled-bitmap (search-forward-icon syntax-icon-color (toolbar-icon-height))))
(define navigate-down-icon
(compiled-bitmap (down-arrow-icon syntax-icon-color (toolbar-icon-height))))
(define small-logo (compiled-bitmap (macro-stepper-logo 32)))
(define large-logo (compiled-bitmap (macro-stepper-logo)))
;; Macro Stepper
;; macro-stepper-widget%
@ -112,9 +135,14 @@
(new vertical-panel%
(parent superarea)
(enabled #f)))
(define supernavigator
(define top-panel
(new horizontal-panel%
(parent area)
(horiz-margin 5)
(stretchable-height #f)))
(define supernavigator
(new horizontal-panel%
(parent top-panel)
(stretchable-height #f)
(alignment '(center center))))
(define navigator
@ -130,7 +158,25 @@
(stretchable-height #f)
(alignment '(left center))
(style '(deleted))))
(define about-dialog
(new logo-about-dialog%
(label "About the Macro Stepper")
(parent frame)
(bitmap large-logo)
(messages '("The Macro Stepper is formalized and proved correct in\n"
"\n"
" Ryan Culpepper and Matthias Felleisen\n"
" Debugging Hygienic Macros\n"
" Science of Computer Programming, July 2010\n"))))
(define logo-canvas
(new (class bitmap-canvas%
(super-new (parent top-panel) (bitmap small-logo))
(define/override (on-event evt)
(when (eq? (send evt get-event-type) 'left-up)
(send about-dialog show #t))))))
(define/i sbview sb:syntax-browser<%>
(new stepper-syntax-widget%
(parent area)
@ -179,22 +225,22 @@
(lambda (_) (update/preserve-view)))
(define nav:up
(new button% (label "Previous term") (parent navigator)
(new button% (label (list navigate-up-icon "Previous term" 'left)) (parent navigator)
(callback (lambda (b e) (navigate-up)))))
(define nav:start
(new button% (label "<-- Start") (parent navigator)
(new button% (label (list navigate-to-start-icon "Start" 'left)) (parent navigator)
(callback (lambda (b e) (navigate-to-start)))))
(define nav:previous
(new button% (label "<- Step") (parent navigator)
(new button% (label (list navigate-previous-icon "Step" 'left)) (parent navigator)
(callback (lambda (b e) (navigate-previous)))))
(define nav:next
(new button% (label "Step ->") (parent navigator)
(new button% (label (list navigate-next-icon "Step" 'right)) (parent navigator)
(callback (lambda (b e) (navigate-next)))))
(define nav:end
(new button% (label "End -->") (parent navigator)
(new button% (label (list navigate-to-end-icon "End" 'right)) (parent navigator)
(callback (lambda (b e) (navigate-to-end)))))
(define nav:down
(new button% (label "Next term") (parent navigator)
(new button% (label (list navigate-down-icon "Next term" 'right)) (parent navigator)
(callback (lambda (b e) (navigate-down)))))
(define nav:text

View File

@ -7,5 +7,5 @@
(define stepper-drracket-button
(list
(string-constant stepper-button-label)
x:foot-img/horizontal
x:step-img
(λ (drs-frame) (send drs-frame stepper-button-callback))))

View File

@ -4,6 +4,6 @@
(define drracket-tool-names (list "The Stepper"))
(define drracket-tool-icons (list '("foot-up.png" "icons")))
(define drracket-tool-icons (list '("stepper-32x32.png" "icons")))
(define scribblings '(("scribblings/stepper.scrbl")))

View File

@ -5,11 +5,12 @@
(prefix-in f: framework)
mzlib/pretty
#;"testing-shared.rkt"
"shared.rkt")
"shared.rkt"
images/compile-time
(for-syntax images/icons/control images/icons/style))
(provide
foot-img/horizontal
foot-img/vertical
step-img
stepper-canvas%
stepper-text%
snip?
@ -516,14 +517,8 @@
(strip-regular stx))
;; the bitmap to use in a horizontal toolbar:
(define foot-img/horizontal (make-object bitmap% (build-path (collection-path
"icons") "foot.png") 'png/mask))
;; the bitmap to use in a vertical toolbar:
(define foot-img/vertical (make-object bitmap% (build-path (collection-path
"icons") "foot-up.png") 'png/mask))
;; the bitmap to use in a horizontal or vertical toolbar:
(define step-img (compiled-bitmap (step-icon run-icon-color (toolbar-icon-height))))
;; testing code

View File

@ -14,7 +14,10 @@
(prefix-in x: "mred-extensions.rkt")
"shared.rkt"
"model-settings.rkt"
"xml-sig.rkt")
"xml-sig.rkt"
images/compile-time
images/gui
(for-syntax racket/base images/icons/control images/icons/style images/logos))
(import drracket:tool^ xml^ stepper-frame^)
@ -214,20 +217,50 @@
;; GUI ELEMENTS:
(define s-frame
(make-object stepper-frame% drracket-tab))
(define top-panel
(new horizontal-panel% [parent (send s-frame get-area-container)] [horiz-margin 5]
;[style '(border)] ; for layout testing only
[stretchable-width #t]
[stretchable-height #f]))
(define button-panel
(make-object horizontal-panel% (send s-frame get-area-container)))
(define (add-button name fun)
(new button%
[label name]
[parent button-panel]
[callback (lambda (_1 _2) (fun))]
[enabled #f]))
(define (add-choice-box name fun)
(new choice% [label name]
[choices (map first pulldown-choices)]
[parent button-panel]
[callback fun]
[enabled #f]))
(new horizontal-panel% [parent top-panel] [alignment '(center top)]
;[style '(border)] ; for layout testing only
[stretchable-width #t]
[stretchable-height #f]))
(define about-dialog
(new logo-about-dialog%
[label "About the Stepper"]
[parent s-frame]
[bitmap (compiled-bitmap (stepper-logo))]
[messages '("The Algebraic Stepper is formalized and proved correct in\n"
"\n"
" John Clements, Matthew Flatt, Matthias Felleisen\n"
" Modeling an Algebraic Stepper\n"
" European Symposium on Programming, 2001\n")]))
(define logo-canvas
(new (class bitmap-canvas%
(super-new [parent top-panel] [bitmap (compiled-bitmap (stepper-logo 32))])
(define/override (on-event evt)
(when (eq? (send evt get-event-type) 'left-up)
(send about-dialog show #t))))))
(define prev-img (compiled-bitmap (step-back-icon run-icon-color (toolbar-icon-height))))
(define previous-button (new button%
[label (list prev-img (string-constant stepper-previous) 'left)]
[parent button-panel]
[callback (λ (_1 _2) (previous))]
[enabled #f]))
(define next-img (compiled-bitmap (step-icon run-icon-color (toolbar-icon-height))))
(define next-button (new button%
[label (list next-img (string-constant stepper-next) 'right)]
[parent button-panel]
[callback (λ (_1 _2) (next))]
[enabled #f]))
(define pulldown-choices
`((,(string-constant stepper-jump-to-beginning) ,jump-to-beginning)
@ -236,10 +269,12 @@
(,(string-constant stepper-jump-to-next-application) ,jump-to-next-application)
(,(string-constant stepper-jump-to-previous-application) ,jump-to-prior-application)))
(define previous-button (add-button (string-constant stepper-previous) previous))
(define next-button (add-button (string-constant stepper-next) next))
(define jump-button (add-choice-box (string-constant stepper-jump) jump-to))
(define jump-button (new choice%
[label (string-constant stepper-jump)]
[choices (map first pulldown-choices)]
[parent button-panel]
[callback jump-to]
[enabled #f]))
(define canvas
(make-object x:stepper-canvas% (send s-frame get-area-container)))
@ -252,6 +287,7 @@
(new editor-canvas%
[parent button-panel]
[editor status-text]
[stretchable-width #f]
[style '(transparent no-border no-hscroll no-vscroll)]
;; some way to get the height of a line of text?
[min-width 100]))
@ -332,8 +368,6 @@
;; CONFIGURE GUI ELEMENTS
(send s-frame set-printing-proc print-current-view)
(send button-panel stretchable-width #f)
(send button-panel stretchable-height #f)
(send canvas stretchable-height #t)
(send (send s-frame edit-menu:get-undo-item) enable #f)
(send (send s-frame edit-menu:get-redo-item) enable #f)

View File

@ -182,8 +182,7 @@
(new switchable-button%
[parent stepper-button-parent-panel]
[label (string-constant stepper-button-label)]
[bitmap x:foot-img/horizontal]
[alternate-bitmap x:foot-img/vertical]
[bitmap x:step-img]
[callback (lambda (dont-care) (send (get-current-tab)
stepper-button-callback))]))

View File

@ -1125,10 +1125,10 @@ please adhere to these guidelines:
(stepper-language-level-message
"Sprogniveauet er sat til \"~a\". Indtil videre virker stepperen kun for sprogniveauerne fra \"~a\" til \"~a\".")
(stepper-button-label "Step")
(stepper-previous-application "|< Funktionskald")
(stepper-previous "< Step")
(stepper-next "Step >")
(stepper-next-application "Funktionskald >|")
(stepper-previous-application "Funktionskald")
(stepper-previous "Step")
(stepper-next "Step")
(stepper-next-application "Funktionskald")
(stepper-jump-to-beginning "Hjem")
(debug-tool-button-name "Debug")

View File

@ -1348,8 +1348,8 @@ please adhere to these guidelines:
(stepper-language-level-message "The stepper does not work for language \"~a\".")
(stepper-button-label "Step")
(stepper-previous "< Step")
(stepper-next "Step >")
(stepper-previous "Step")
(stepper-next "Step")
(stepper-jump "Jump...")
(stepper-jump-to-beginning "to beginning")
(stepper-jump-to-end "to end")

View File

@ -1348,8 +1348,8 @@
(stepper-language-level-message "Le Pas à Pas n'est pas disponible pour le langage \"~a\".")
(stepper-button-label "Pas")
(stepper-previous "< Pas")
(stepper-next "Pas >")
(stepper-previous "Pas")
(stepper-next "Pas")
(stepper-jump "Sauter...")
(stepper-jump-to-beginning "au début")
(stepper-jump-to-end "à la fin")

View File

@ -1250,8 +1250,8 @@
"Der Stepper unterstützt die Sprachebene \"~a\" nicht.")
(stepper-button-label "Stepper")
(stepper-previous "< Schritt")
(stepper-next "Schritt >")
(stepper-previous "Schritt")
(stepper-next "Schritt")
(stepper-jump "Springen...")
(stepper-jump-to-beginning "an den Anfang")
(stepper-jump-to-end "ans Ende")

View File

@ -1240,10 +1240,10 @@ please adhere to these guidelines:
(stepper-name "ステッパ")
(stepper-language-level-message "ステッパは \"~a\" 言語に対しては動作しません")
(stepper-button-label "ステップ")
(stepper-previous-application "|< アプリケーション")
(stepper-previous "< ステップ")
(stepper-next "ステップ >")
(stepper-next-application "アプリケーション >|")
(stepper-previous-application "アプリケーション")
(stepper-previous "ステップ")
(stepper-next "ステップ")
(stepper-next-application "アプリケーション")
(stepper-jump-to-beginning "ホーム")
(stepper-jump-to-end "終端まで")

View File

@ -1187,8 +1187,8 @@
(stepper-language-level-message "한 단계씩 실행은 \"~a\" 언어에서 지원하지 않습니다.")
(stepper-button-label "한 단계씩 실행")
(stepper-previous "< 이전단계")
(stepper-next "다음단계 >")
(stepper-previous "이전단계")
(stepper-next "다음단계")
(stepper-jump "건너뛰기...")
(stepper-jump-to-beginning "처음으로")
(stepper-jump-to-end "끝으로")

View File

@ -1064,11 +1064,11 @@ please adhere to these guidelines:
(stepper-language-level-message
"The language level is set to \"~a\". Currently, the stepper works only for the \"~a\" through the \"~a\" language levels.")
(stepper-button-label "Step")
(stepper-previous-application "|< Application")
(stepper-previous "< Step")
(stepper-next "Step >")
(stepper-previous-application "Application")
(stepper-previous "Step")
(stepper-next "Step")
(stepper-jump-to-beginning "Home")
(stepper-next-application "Application >|")
(stepper-next-application "Application")
(dialog-back "Back")

View File

@ -1252,10 +1252,10 @@ please adhere to these guidelines:
(stepper-language-level-message "Пошаговое выполнение не работает для языка \"~a\".")
(stepper-button-label "Шаг")
(stepper-previous-application "|< Программа")
(stepper-previous "< Шаг")
(stepper-next "Шаг >")
(stepper-next-application "Программа >|")
(stepper-previous-application "Программа")
(stepper-previous "Шаг")
(stepper-next "Шаг")
(stepper-next-application "Программа")
(stepper-jump "Перейти...") ;; this one is changed. action?
(stepper-out-of-steps "Вычисления завершены ранее, чем достигнут искомый шаг.")
(stepper-no-such-step/title "Шаг не найден")

View File

@ -1145,10 +1145,10 @@
(stepper-name "单步执行器")
(stepper-language-level-message "单步执行不支持语言“~a”。")
(stepper-button-label "单步执行")
(stepper-previous-application "|< 调用")
(stepper-previous "< 上一步")
(stepper-next "下一步 >")
(stepper-next-application "调用 >|")
(stepper-previous-application "调用")
(stepper-previous "上一步")
(stepper-next "下一步")
(stepper-next-application "调用")
(stepper-jump-to-beginning "源程序")
(stepper-jump-to-end "最终运行结果")

View File

@ -975,8 +975,10 @@
(stepper-language-level-message
"El nivel del lenguaje es \"~a\". Actualmente el Stepper funciona para los niveles \"~a\" al \"~a\".")
(stepper-button-label "Paso")
(stepper-previous-application "|< Aplicación")
(stepper-previous "< Paso")
(stepper-previous-application "Aplicación")
(stepper-previous "Paso")
(stepper-next "Paso")
(stepper-next-application "Aplicación")
(stepper-jump-to-beginning "Hogar")
(dialog-back "Atrás")

View File

@ -1142,10 +1142,10 @@
(stepper-name "单步执行器")
(stepper-language-level-message "单步执行不支持语言“~a”。")
(stepper-button-label "单步执行")
(stepper-previous-application "|< 调用")
(stepper-previous "< 上一步")
(stepper-next "下一步 >")
(stepper-next-application "调用 >|")
(stepper-previous-application "调用")
(stepper-previous "上一步")
(stepper-next "下一步")
(stepper-next-application "调用")
(stepper-jump-to-beginning "源程序")
(stepper-jump-to-end "最终运行结果")

View File

@ -1252,10 +1252,10 @@ please adhere to these guidelines:
(stepper-language-level-message "Покрокове виконання не працює для мови \"~a\".")
(stepper-button-label "Крок")
(stepper-previous-application "|< Програма")
(stepper-previous "< Крок")
(stepper-next "Крок >")
(stepper-next-application "Програма >|")
(stepper-previous-application "Програма")
(stepper-previous "Крок")
(stepper-next "Крок")
(stepper-next-application "Програма")
(stepper-jump "Перейти...") ;; this one is changed. action?
(stepper-out-of-steps "Обчислення завершено раніше, ніж досягнуто шуканий крок.")
(stepper-no-such-step/title "Крок не знайдено")