240 lines
6.7 KiB
240 lines
6.7 KiB
# Module to on-demand render MaterialIcons-Regular.svg |
|
# into photo images using tksvg. |
|
# |
|
# chw January 2019 |
|
# image_ncg contributed by dzach May/July 2019 |
|
|
|
package require Tk |
|
package require tdom |
|
package require tksvg |
|
|
|
namespace eval ::MaterialIcons { |
|
|
|
variable glyph ;# SVG glyph cache |
|
array set glyph {} ;# indexed by glyph name |
|
|
|
variable viewbox ;# common viewBox {x y w h} for glyphs |
|
|
|
variable icache ;# image cache indexed by glyph name, size, |
|
array set icache {} ;# opacity, color, e.g. "zoom_out,24,1.0,black" |
|
|
|
variable template ;# SVG template for a glyph |
|
|
|
# Module initializer: parse and cache the SVG file. |
|
|
|
proc _init {file} { |
|
variable glyph |
|
variable viewbox |
|
variable template |
|
set f [open $file] |
|
set doc [dom parse -channel $f] |
|
close $f |
|
set root [$doc documentElement] |
|
foreach node [$root getElementsByTagName glyph] { |
|
if {[$node hasAttribute glyph-name] && [$node hasAttribute d]} { |
|
set d [$node getAttribute d] |
|
if {$d eq "M0 0z"} { |
|
# skip empty icon |
|
continue |
|
} |
|
set glyph([$node getAttribute glyph-name]) $d |
|
} |
|
} |
|
foreach node [$root getElementsByTagName font-face] { |
|
if {[$node hasAttribute bbox]} { |
|
set bbox [$node getAttribute bbox] |
|
# keep only first bbox |
|
break |
|
} |
|
} |
|
$doc delete |
|
if {![info exists bbox]} { |
|
return -code error "no bbox attribute found" |
|
} |
|
set template0 { |
|
<?xml version="1.0" encoding="UTF-8" standalone="no"?> |
|
<svg id="%%s" width="%g" height="%g" viewBox="%s" version="1.1"> |
|
<g> |
|
<path fill="%%s" fill-opacity="%%g" |
|
stroke="%%s" stroke-width="%%g" |
|
transform="rotate(%%g,256,256) scale(1,-1) translate(0,%g)" |
|
d="%%s"/> |
|
</g> |
|
</svg> |
|
} |
|
lassign $bbox x1 y1 x2 y2 |
|
set w [expr {$x2 - $x1}] |
|
set h [expr {$y2 - $y1}] |
|
set viewbox [list $x1 $y1 $w $h] |
|
set template [format $template0 $w $h $viewbox [expr {0 - $y2 - $y1}]] |
|
} |
|
|
|
# Invoke and release initializer. |
|
|
|
_init [file join [file dirname [info script]] MaterialIcons-Regular.svg] |
|
rename _init {} |
|
|
|
# Return list of icon (glyph) names which can be rendered. |
|
|
|
proc names {{pattern *}} { |
|
variable glyph |
|
tailcall lsort [array names glyph $pattern] |
|
} |
|
|
|
# Return SVG for named icon with optional fill color and opacity. |
|
|
|
proc svg {name {color black} {opacity 1.0} |
|
{stroke none} {strokewidth 1.0} {angle 0}} { |
|
variable glyph |
|
variable template |
|
if {![info exists glyph($name)]} { |
|
return -code error "glyph $name does not exist" |
|
} |
|
tailcall format $template $name $color $opacity \ |
|
$stroke $strokewidth $angle $glyph($name) |
|
} |
|
|
|
# Return photo image for named icon with optional size, fill color, |
|
# and opacity. If size is negative, it specifies pixels, else points |
|
# taking the current tk scaling into account. |
|
|
|
proc image {name {size 16} {color black} {opacity 1.0}} { |
|
variable icache |
|
set fullname ${name},${size},${opacity},${color} |
|
if {[info exists icache($fullname)]} { |
|
if {![catch {::image inuse $icache($fullname)}]} { |
|
return $icache($fullname) |
|
} |
|
unset icache($fullname) |
|
} |
|
set icache($fullname) [image_nc $name $size $color $opacity] |
|
return $icache($fullname) |
|
} |
|
|
|
# Like the "image" method above but without caching. |
|
|
|
proc image_nc {name {size 16} {color black} {opacity 1.0}} { |
|
variable viewbox |
|
if {![string is integer $size]} { |
|
return -code error "expect integer size" |
|
} |
|
if {$size == 0} { |
|
return -code error "invalid size" |
|
} |
|
lassign $viewbox x y w h |
|
if {$size < 0} { |
|
set size [expr {-1.0 * $size}] |
|
} else { |
|
set dpi [expr {72.0 * [tk scaling]}] |
|
set size [expr {$dpi * $size / 72.0}] |
|
} |
|
set scale [expr {1.0 * $size / $w}] |
|
tailcall ::image create photo -format [list svg -scale $scale] \ |
|
-data [svg $name $color $opacity] |
|
} |
|
|
|
# Flush image cache. |
|
|
|
proc flush {} { |
|
variable icache |
|
foreach fullname [array names icache] { |
|
catch {::image delete $icache($fullname)} |
|
unset icache($fullname) |
|
} |
|
} |
|
|
|
# Rebuild image cache; useful when tk scaling has changed. |
|
|
|
proc rebuild {} { |
|
variable icache |
|
variable viewbox |
|
set dpi [expr {72.0 * [tk scaling]}] |
|
lassign $viewbox x y w h |
|
foreach fullname [array names icache] { |
|
if {[scan $fullname {%[^,],%d,%g,%s} name size opacity color] == 4 |
|
&& $size > 0} { |
|
set size [expr {$dpi * $size / 72.0}] |
|
set scale [expr {1.0 * $size / $w}] |
|
if {[catch {::image inuse $icache($fullname)}]} { |
|
set this [::image create photo \ |
|
-format [list svg -scale $scale] \ |
|
-data [svg $name $color $opacity]] |
|
set icache($fullname) $this |
|
} else { |
|
$icache($fullname) configure -width 1 -height 1 |
|
$icache($fullname) configure -width 0 -height 0 |
|
$icache($fullname) configure \ |
|
-format [list svg -scale $scale] |
|
} |
|
} |
|
} |
|
} |
|
|
|
# Convert a display size including optional unit to pixels. |
|
# Valid unit suffixes are d (density points), p (points), |
|
# and m (millimeters), and without unit suffix, pixels. |
|
|
|
proc val2px {val} { |
|
set dval "" |
|
if {[scan $val "%g" dval] == 1} { |
|
if {[string match "*d" $val]} { |
|
set val [expr {[tk scaling] * 72.0 / 160.0 * $dval}] |
|
} elseif {[string match "*p" $val]} { |
|
set val [expr {[tk scaling] * $dval}] |
|
} elseif {[string match "*m" $val]} { |
|
set val [expr {[tk scaling] * 72.0 / 25.4 * $dval}] |
|
} |
|
} |
|
if {![string is double $val]} { |
|
return -code error "expect number for size" |
|
} elseif {$val < 0} { |
|
set val [expr {-1.0 * $val}] |
|
} |
|
return $val |
|
} |
|
|
|
# Like the "image_nc" method but accepting many options: |
|
# name glyph name to be rendered |
|
# imgname name of photo image |
|
# -size S size with optional unit suffix |
|
# -fill C fill color |
|
# -opacity O fill opacity |
|
# -stroke C stroke color |
|
# -strokewidth S stroke width with optional unit suffix |
|
# -angle A angle in degrees |
|
|
|
proc image_ncg {name imgname args} { |
|
variable viewbox |
|
array set opts { |
|
-size 24d -fill black -opacity 1.0 -stroke none |
|
-strokewidth 1.0 -angle 0 |
|
} |
|
array set opts $args |
|
lassign $viewbox x y w h |
|
set size [val2px $opts(-size)] |
|
if {$size == 0} { |
|
return -code error "invalid size" |
|
} |
|
set scale [expr {1.0 * $size / $w}] |
|
# if stroke width has units or is negative, don't scale it |
|
if {![string is double -strict $opts(-strokewidth)] || |
|
$opts(-strokewidth) < 0} { |
|
# reverse the scale |
|
set opts(-strokewidth) \ |
|
[expr {abs([val2px $opts(-strokewidth)] / $scale)}] |
|
} |
|
tailcall ::image create photo $imgname \ |
|
-format [list svg -scale $scale] \ |
|
-data [svg $name $opts(-fill) $opts(-opacity) $opts(-stroke) \ |
|
$opts(-strokewidth) $opts(-angle)] |
|
} |
|
|
|
# Make some procs visible in MaterialIcons ensemble. |
|
|
|
namespace ensemble create -subcommands { |
|
names svg image image_nc flush rebuild image_ncg |
|
} |
|
|
|
} |
|
|
|
package provide MaterialIcons 0.2
|
|
|