Icon fixes:
Split images/icons/misc into images/icons/symbol and images/icons/misc Updated tests Fixed Gtk assertion failure in Macro Stepper (came from "about" dialog being created before the stepper window was shown; fixed by creating it on demand) Changed Stepper similarly (though there was no assertion failure) Put a quote in the Macro Stepper logo Portable recycle-icon Removed recycle unicode from the docs (was causing PDF build to fail) Internal API fixes Please merge into release
This commit is contained in:
Neil Toronto
parent
10f8222bf4
commit
ea68677d2f
Binary file not shown.
|
Before Width: | Height: | Size: 2.5 KiB After Width: | Height: | Size: 2.6 KiB |
|
|
@ -40,12 +40,12 @@
|
|||
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)
|
||||
(c 9 -14 19.5 -8 24 -2)
|
||||
(l 5 -7 2 20 -20 -2 7 -5)
|
||||
(c -2.5 -4 -8 -8.5 -14 0)
|
||||
(l -4 -4))))
|
||||
(draw-path-commands dc '((m 0 15)
|
||||
(c 9 -14 19.5 -8 24 -2)
|
||||
(l 5 -7 2 20 -20 -2 7 -5)
|
||||
(c -2.5 -4 -8 -8.5 -14 0)
|
||||
(l -4 -4))
|
||||
0 0))
|
||||
(/ height 32)))
|
||||
|
||||
(defproc (right-arrow-flomap [color (or/c string? (is-a?/c color%))]
|
||||
|
|
|
|||
|
|
@ -5,55 +5,21 @@
|
|||
"../private/flomap.rkt"
|
||||
"../private/deep-flomap.rkt"
|
||||
"../private/utils.rkt"
|
||||
"symbol.rkt"
|
||||
"style.rkt")
|
||||
|
||||
(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
|
||||
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
|
||||
left-bomb-icon left-bomb-flomap)
|
||||
(only-doc-out (all-defined-out)))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Unrendered flomaps
|
||||
|
||||
(define (flat-x-flomap color height)
|
||||
(define mn 7.5)
|
||||
(define mx 23.5)
|
||||
(draw-icon-flomap
|
||||
32 32 (λ (dc)
|
||||
(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))
|
||||
(send dc draw-line mn mn mx mx)
|
||||
(send dc draw-line mn mx mx mn))
|
||||
(/ height 32)))
|
||||
|
||||
(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)
|
||||
(c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23)
|
||||
(l -9 -8)
|
||||
(c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5)
|
||||
(l -6 9))))
|
||||
(/ height 32)))
|
||||
|
||||
(define (flat-regular-polygon-flomap sides start color size)
|
||||
(let ([start (- start)])
|
||||
(draw-icon-flomap
|
||||
|
|
@ -69,146 +35,6 @@
|
|||
(+ 15.5 (/ (* 15.5 (sin θ)) max-frac))))))
|
||||
(/ size 32))))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Rendered flomaps
|
||||
|
||||
(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))
|
||||
|
||||
(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)]
|
||||
[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)))
|
||||
(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)]
|
||||
[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))
|
||||
|
||||
(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))
|
||||
(let* ([fm (flat-x-flomap color height)]
|
||||
[dfm (flomap->deep-flomap fm)]
|
||||
[dfm (deep-flomap-icon-style dfm)]
|
||||
[dfm (deep-flomap-raise dfm (* -8 scale))])
|
||||
(deep-flomap-render-icon dfm 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))
|
||||
(let* ([fm (flat-check-flomap color height)]
|
||||
[dfm (flomap->deep-flomap fm)]
|
||||
[dfm (deep-flomap-icon-style dfm)]
|
||||
[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%))]
|
||||
|
|
@ -362,17 +188,16 @@
|
|||
10 25 (λ (dc)
|
||||
(send dc set-pen "darkred" 1 'solid)
|
||||
(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))))
|
||||
(draw-path-commands dc '((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))
|
||||
0 0))
|
||||
scale)]
|
||||
[dfm (flomap->deep-flomap fm)]
|
||||
[dfm (deep-flomap-icon-style dfm)]
|
||||
|
|
@ -384,13 +209,15 @@
|
|||
20 20 (λ (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 1.5 11.5)
|
||||
(l 10 -10 2.5 2.5)
|
||||
(c 4 5 -5 14 -10 10)
|
||||
(l -2.5 -2.5)))
|
||||
(draw-path-commands dc 0 0 '((m 1.5 11.5)
|
||||
(c -2 -5 5 -12 10 -10
|
||||
4 5 -5 14 -10 10))))
|
||||
(draw-path-commands dc '((m 1.5 11.5)
|
||||
(l 10 -10 2.5 2.5)
|
||||
(c 4 5 -5 14 -10 10)
|
||||
(l -2.5 -2.5))
|
||||
0 0)
|
||||
(draw-path-commands dc '((m 1.5 11.5)
|
||||
(c -2 -5 5 -12 10 -10
|
||||
4 5 -5 14 -10 10))
|
||||
0 0))
|
||||
scale))
|
||||
|
||||
(define cap-fm
|
||||
|
|
@ -427,15 +254,6 @@
|
|||
;; ===================================================================================================
|
||||
;; Bitmaps (icons)
|
||||
|
||||
(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%))]
|
||||
|
|
@ -448,14 +266,10 @@
|
|||
([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]
|
||||
[foot-icon foot-flomap]
|
||||
[lambda-icon lambda-flomap])
|
||||
[foot-icon foot-flomap])
|
||||
|
||||
(define-icon-wrappers
|
||||
([frame-color (or/c string? (is-a?/c color%))]
|
||||
|
|
|
|||
260
collects/images/icons/symbol.rkt
Normal file
260
collects/images/icons/symbol.rkt
Normal file
|
|
@ -0,0 +1,260 @@
|
|||
#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 flat-x-flomap
|
||||
(activate-contract-out
|
||||
text-icon text-flomap
|
||||
recycle-icon recycle-flomap
|
||||
x-icon x-flomap
|
||||
check-icon check-flomap
|
||||
lambda-icon lambda-flomap)
|
||||
(only-doc-out (all-defined-out)))
|
||||
|
||||
(define (flat-x-flomap color height)
|
||||
(define mn 7.5)
|
||||
(define mx 23.5)
|
||||
(draw-icon-flomap
|
||||
32 32 (λ (dc)
|
||||
(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))
|
||||
(send dc draw-line mn mn mx mx)
|
||||
(send dc draw-line mn mx mx mn))
|
||||
(/ height 32)))
|
||||
|
||||
(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 '((m 0 19)
|
||||
(c 0 0 7 4 14 12 5.5 -13.5 17 -23 17 -23)
|
||||
(l -9 -8)
|
||||
(c 0 0 -6.5 7.5 -9.5 16 -2.5 -4 -6 -6.5 -6 -6.5)
|
||||
(l -6 9))
|
||||
0 0))
|
||||
(/ height 32)))
|
||||
|
||||
(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))
|
||||
|
||||
(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)]
|
||||
[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)))
|
||||
(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)))))
|
||||
|
||||
(define recycle-path-commands
|
||||
'((m 13.28125 0.65625)
|
||||
(c 0.463636 0.0842975 0.965857 0.50656 1.21875 0.84375)
|
||||
(l 4.09375 7.09375)
|
||||
(l -2.125 1.25)
|
||||
(l 7.0 0.0)
|
||||
(l 3.5 -6.0625)
|
||||
(l -2.15625 1.21875)
|
||||
(l -2.125 -3.78125)
|
||||
(c -0.210743 -0.37933886 -0.630114 -0.5625 -1.09375 -0.5625)
|
||||
(l -8.3125 0.0)
|
||||
(m -2.40625 0.4375)
|
||||
(c -1.0747934 0.0368802 -2.119938 0.438998 -2.5625 1.21875)
|
||||
(l -3.21875 5.59375)
|
||||
(l 6.15625 3.59375)
|
||||
(l 3.9375 -6.84375)
|
||||
(l -1.5625 -2.59375)
|
||||
(c -0.569008 -0.6743802 -1.675207 -1.0056302 -2.75 -0.96875)
|
||||
(m 16.65625 8.65625)
|
||||
(l -6.21875 3.5625)
|
||||
(l 3.9375 6.6875)
|
||||
(l 3.3125 0)
|
||||
(c 1.34876 -0.252893 3.398916 -2.442717 2.21875 -4.71875)
|
||||
(l -3.25 -5.53125)
|
||||
(m -27.4375 1.5)
|
||||
(l 2.21875 1.28125)
|
||||
(l -1.4375 2.40625)
|
||||
(c -1.2644628 2.360331 0.8605372 4.956767 2.125 5.09375)
|
||||
(l 3.28125 0.0)
|
||||
(l 2.21875 -3.875)
|
||||
(l 2.25 1.21875)
|
||||
(l -3.59375 -6.125)
|
||||
(l -7.0625 0.0)
|
||||
(m 20.09375 7.1875)
|
||||
(l -3.59375 6.15625)
|
||||
(l 3.59375 6.125)
|
||||
(l 0.0 -2.59375)
|
||||
(l 4.375 0.0)
|
||||
(c 0.505785 0.0 0.862655 -0.28781 1.03125 -0.625)
|
||||
(l 3.96875 -7.0)
|
||||
(c -0.210743 0.126446 -0.355424 0.3532 -1.15625 0.4375)
|
||||
(l -8.21875 0.0)
|
||||
(l 0.0 -2.5)
|
||||
(m -18.21875 2.15625)
|
||||
(c 0.168595 0.210744 0.1346592 0.174793 3.84375 6.75)
|
||||
(c 0.2528926 0.379339 0.5988637 0.8234 1.0625 0.78125)
|
||||
(l 7.875 0.0)
|
||||
(l 0.0 -7.1875)
|
||||
(l -11.71875 0.0)
|
||||
(c -0.6322314 0.0 -0.8622934 -0.175155 -1.0625 -0.34375)))
|
||||
|
||||
(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?
|
||||
(make-cached-flomap
|
||||
[height color material]
|
||||
(draw-short-rendered-icon-flomap
|
||||
32 32 (λ (dc)
|
||||
(set-icon-pen dc (icon-color->outline-color color) 1/2 'solid)
|
||||
(send dc set-brush color 'solid)
|
||||
(draw-path-commands dc recycle-path-commands 0 0))
|
||||
(/ height 32)
|
||||
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))
|
||||
(let* ([fm (flat-x-flomap color height)]
|
||||
[dfm (flomap->deep-flomap fm)]
|
||||
[dfm (deep-flomap-icon-style dfm)]
|
||||
[dfm (deep-flomap-raise dfm (* -8 scale))])
|
||||
(deep-flomap-render-icon dfm 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))
|
||||
(let* ([fm (flat-check-flomap color height)]
|
||||
[dfm (flomap->deep-flomap fm)]
|
||||
[dfm (deep-flomap-icon-style dfm)]
|
||||
[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 lambda-path-commands 4 0)
|
||||
(set-icon-pen dc color 2 'solid)
|
||||
(send dc set-brush color 'solid)
|
||||
(draw-path-commands dc lambda-path-commands 4 0))
|
||||
(/ height 32)
|
||||
material)))
|
||||
|
||||
;; ===================================================================================================
|
||||
;; Bitmaps (icons)
|
||||
|
||||
(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)))
|
||||
|
||||
(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]
|
||||
[lambda-icon lambda-flomap])
|
||||
|
|
@ -6,6 +6,7 @@
|
|||
"../private/deep-flomap.rkt"
|
||||
"../private/utils.rkt"
|
||||
"control.rkt"
|
||||
"symbol.rkt"
|
||||
"misc.rkt"
|
||||
"style.rkt")
|
||||
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
"private/flomap.rkt"
|
||||
"private/deep-flomap.rkt"
|
||||
"private/utils.rkt"
|
||||
"icons/symbol.rkt"
|
||||
"icons/misc.rkt"
|
||||
"icons/style.rkt")
|
||||
|
||||
|
|
@ -81,7 +82,7 @@
|
|||
|
||||
(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)))
|
||||
(draw-path-commands dc (scale-path-commands lambda-path-commands (/ w 240) (/ h 240)) x y)
|
||||
(send dc set-scale sx sy))
|
||||
|
||||
(define blue-θ-start (* -45 (/ pi 180)))
|
||||
|
|
@ -246,7 +247,7 @@
|
|||
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))
|
||||
(draw-path-commands dc continents-path-commands 0 -17))
|
||||
scale))
|
||||
|
||||
(defproc (planet-flomap [height (and/c rational? (>=/c 0)) 256]) flomap?
|
||||
|
|
@ -299,24 +300,29 @@
|
|||
(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)
|
||||
(define (draw-hash-quote dc)
|
||||
;; vertical lines
|
||||
(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))))
|
||||
(send dc draw-polygon '((12 . 0) (15 . 0) (13 . 19) (10 . 19)))
|
||||
;; horizontal lines
|
||||
(send dc draw-polygon '((1 . 4) (1 . 7) (18 . 7) (18 . 4)))
|
||||
(send dc draw-polygon '((0 . 12) (0 . 15) (17 . 15) (17 . 12)))
|
||||
;; quote
|
||||
(send dc draw-polygon '((20 . 0) (23 . 0) (22.75 . 6) (20.25 . 6)))
|
||||
)
|
||||
|
||||
(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)
|
||||
(send dc translate 5 6)
|
||||
(set-icon-pen dc outline-color 2 'solid)
|
||||
(send dc set-brush outline-color 'solid)
|
||||
(draw-hash dc)
|
||||
(draw-hash-quote dc)
|
||||
(send dc set-pen "black" 1 'transparent)
|
||||
(send dc set-brush light-metal-icon-color 'solid)
|
||||
(draw-hash dc))
|
||||
(draw-hash-quote dc))
|
||||
(/ (* 3/4 height) 32)
|
||||
metal-icon-material)))
|
||||
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@
|
|||
[_ (error 'apply-path-commands "unknown path command ~e" cmd)])]))
|
||||
(void))
|
||||
|
||||
(define (draw-path-commands dc x y cmds)
|
||||
(define (draw-path-commands dc cmds x y)
|
||||
(define p (new dc-path%))
|
||||
(apply-path-commands p cmds)
|
||||
(define t (send dc get-transformation))
|
||||
|
|
@ -166,7 +166,7 @@
|
|||
[`(M ,ax ,ay ,as ...) (cons `(m ,(- ax x) ,(- ay y))
|
||||
(loop ax ay (cons `(M ,@as) (rest cmds))))]
|
||||
[`(L ,ax ,ay ,as ...) (cons `(l ,(- ax x) ,(- ay y))
|
||||
(loop ax ay (cons '(L ,@as) (rest cmds))))]
|
||||
(loop ax ay (cons `(L ,@as) (rest cmds))))]
|
||||
[`(C ,ax1 ,ay1 ,ax2 ,ay2 ,ax ,ay ,as ...)
|
||||
(cons `(c ,(- ax1 x) ,(- ay1 y) ,(- ax2 x) ,(- ay2 y) ,(- ax x) ,(- ay y))
|
||||
(loop ax ay (cons `(C ,@as) (rest cmds))))]
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
images/icons/arrow
|
||||
images/icons/control
|
||||
images/icons/file
|
||||
images/icons/symbol
|
||||
images/icons/misc
|
||||
images/icons/stickman
|
||||
images/icons/tool
|
||||
|
|
@ -19,6 +20,7 @@
|
|||
images/icons/file
|
||||
images/icons/misc
|
||||
images/icons/stickman
|
||||
images/icons/symbol
|
||||
images/icons/tool
|
||||
images/icons/style)
|
||||
|
||||
|
|
@ -227,28 +229,18 @@ This is not a ``control'' icon @italic{per se}, but is used to make many others.
|
|||
@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 "crimson" 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 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))]
|
||||
}
|
||||
@doc-apply[floppy-disk-icon]{ @examples[#:eval icons-eval (floppy-disk-icon "crimson" 32 glass-icon-material)] }
|
||||
@doc-apply[save-icon]{ @examples[#:eval icons-eval (save-icon syntax-icon-color run-icon-color 32)] }
|
||||
@doc-apply[load-icon]{ @examples[#:eval icons-eval (load-icon syntax-icon-color metal-icon-color 32)] }
|
||||
@doc-apply[small-save-icon]{ @examples[#:eval icons-eval (small-save-icon syntax-icon-color halt-icon-color 32)] }
|
||||
@doc-apply[small-load-icon]{ @examples[#:eval icons-eval (small-load-icon syntax-icon-color dark-metal-icon-color 32)] }
|
||||
|
||||
@;====================================================================================================
|
||||
|
||||
@section[#:tag "misc"]{Miscellaneous Icons}
|
||||
@section[#:tag "symbol"]{Symbol and Text Icons}
|
||||
|
||||
@defmodule[images/icons/misc]
|
||||
@interaction-eval[#:eval icons-eval (require images/icons/misc)]
|
||||
@defmodule[images/icons/symbol]
|
||||
@interaction-eval[#:eval icons-eval (require images/icons/symbol)]
|
||||
|
||||
@doc-apply[text-icon]{
|
||||
Renders a text string as an icon. For example,
|
||||
|
|
@ -278,13 +270,12 @@ 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.
|
||||
Because different platforms have different fonts, @racket[text-icon] cannot guarantee the icons it returns have a consistent look or width across all platforms, or that the unicode characters will exist.
|
||||
}
|
||||
|
||||
@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)]
|
||||
@examples[#:eval icons-eval (recycle-icon (make-object color% 0 153 0) 48)]
|
||||
}
|
||||
|
||||
@doc-apply[x-icon]{
|
||||
|
|
@ -297,6 +288,18 @@ Returns an ``x'' icon that is guaranteed to look the same on all platforms.
|
|||
@examples[#:eval icons-eval (check-icon "darkgreen" 32)]
|
||||
}
|
||||
|
||||
@doc-apply[lambda-icon]{
|
||||
@examples[#:eval icons-eval
|
||||
(lambda-icon light-metal-icon-color 32 metal-icon-material)]
|
||||
}
|
||||
|
||||
@;====================================================================================================
|
||||
|
||||
@section[#:tag "misc"]{Miscellaneous Icons}
|
||||
|
||||
@defmodule[images/icons/misc]
|
||||
@interaction-eval[#:eval icons-eval (require images/icons/misc)]
|
||||
|
||||
@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)]
|
||||
|
|
@ -326,11 +329,6 @@ Equivalent to @racket[(regular-polygon-icon 8 (/ (* 2 pi) 16) color height mater
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
images/icons/control
|
||||
images/icons/arrow
|
||||
images/icons/file
|
||||
images/icons/symbol
|
||||
images/icons/misc
|
||||
images/icons/tool
|
||||
images/icons/style
|
||||
|
|
@ -37,8 +38,9 @@
|
|||
;; Other icons, various colors
|
||||
|
||||
(define icon-procss
|
||||
(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 (list search-backward-icon rewind-icon continue-backward-icon step-back-icon back-icon
|
||||
pause-icon stop-icon record-icon play-icon step-icon continue-forward-icon
|
||||
fast-forward-icon search-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)
|
||||
(list floppy-disk-icon
|
||||
|
|
@ -46,7 +48,8 @@
|
|||
(λ (color) (load-icon syntax-icon-color color))
|
||||
(λ (color) (small-save-icon syntax-icon-color color))
|
||||
(λ (color) (small-load-icon syntax-icon-color color)))
|
||||
(list x-icon check-icon octagon-icon stop-sign-icon stop-signs-icon
|
||||
(list x-icon check-icon recycle-icon lambda-icon)
|
||||
(list octagon-icon stop-sign-icon stop-signs-icon foot-icon
|
||||
(λ (color) (magnifying-glass-icon metal-icon-color color))
|
||||
(λ (color) (left-magnifying-glass-icon metal-icon-color color))
|
||||
(λ (color) (bomb-icon metal-icon-color color))
|
||||
|
|
|
|||
|
|
@ -2,5 +2,7 @@
|
|||
|
||||
(require images/logos)
|
||||
|
||||
(time (plt-logo 256))
|
||||
(time (planet-logo 256))
|
||||
(time (plt-logo))
|
||||
(time (planet-logo))
|
||||
(time (stepper-logo))
|
||||
(time (macro-stepper-logo))
|
||||
|
|
|
|||
|
|
@ -42,6 +42,19 @@
|
|||
(define small-logo (compiled-bitmap (macro-stepper-logo 32)))
|
||||
(define large-logo (compiled-bitmap (macro-stepper-logo)))
|
||||
|
||||
(define (show-about-dialog parent)
|
||||
(define dlg
|
||||
(new logo-about-dialog%
|
||||
(label "About the Macro Stepper")
|
||||
(parent parent)
|
||||
(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"))))
|
||||
(send dlg show #t))
|
||||
|
||||
;; Macro Stepper
|
||||
|
||||
;; macro-stepper-widget%
|
||||
|
|
@ -159,23 +172,12 @@
|
|||
(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))))))
|
||||
(show-about-dialog frame))))))
|
||||
|
||||
(define/i sbview sb:syntax-browser<%>
|
||||
(new stepper-syntax-widget%
|
||||
|
|
|
|||
|
|
@ -31,6 +31,19 @@
|
|||
;; the stored representation of a step
|
||||
(define-struct step (text kind posns) #:transparent)
|
||||
|
||||
(define (show-about-dialog parent)
|
||||
(define dlg
|
||||
(new logo-about-dialog%
|
||||
[label "About the Stepper"]
|
||||
[parent parent]
|
||||
[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")]))
|
||||
(send dlg show #t))
|
||||
|
||||
(define (go drracket-tab program-expander selection-start selection-end)
|
||||
|
||||
;; get the language-level:
|
||||
|
|
@ -230,23 +243,12 @@
|
|||
[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))))))
|
||||
(show-about-dialog s-frame))))))
|
||||
|
||||
(define prev-img (compiled-bitmap (step-back-icon run-icon-color (toolbar-icon-height))))
|
||||
(define previous-button (new button%
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user