1# ico.tcl -- 2# 3# Win32 ico manipulation code 4# 5# Copyright (c) 2003-2007 Aaron Faupell 6# Copyright (c) 2003-2004 ActiveState Corporation 7# 8# RCS: @(#) $Id: ico.tcl,v 1.31 2010/07/07 20:38:18 andreas_kupries Exp $ 9 10# Sample usage: 11# set file bin/wish.exe 12# set icos [::ico::icons $file] 13# set img [::ico::getIcon $file [lindex $icos 1] -format image -res 32] 14 15package require Tcl 8.4 16 17# Instantiate vars we need for this package 18namespace eval ::ico { 19 namespace export icons iconMembers getIcon getIconByName writeIcon copyIcon transparentColor clearCache EXEtoICO 20 # stores cached indices of icons found 21 variable RES 22 array set RES {} 23 24 # used for 4bpp number conversion 25 variable BITS 26 array set BITS [list {} 0 0000 0 0001 1 0010 2 0011 3 0100 4 \ 27 0101 5 0110 6 0111 7 1000 8 1001 9 \ 28 1010 10 1011 11 1100 12 1101 13 1110 14 1111 15 \ 29 \ 30 00000 00 00001 0F 00010 17 00011 1F \ 31 00100 27 00101 2F 00110 37 00111 3F \ 32 01000 47 01001 4F 01010 57 01011 5F \ 33 01100 67 01101 6F 01110 77 01111 7F \ 34 10000 87 10001 8F 10010 97 10011 9F \ 35 10100 A7 10101 AF 10110 B7 10111 BF \ 36 11000 C7 11001 CF 11010 D7 11011 DF \ 37 11100 E7 11101 EF 11110 F7 11111 FF] 38} 39 40 41# icons -- 42# 43# List of icons in a file 44# 45# ARGS: 46# file File to extract icon info from. 47# ?-type? Type of file. If not specified, it is derived from 48# the file extension. Currently recognized types are 49# EXE, DLL, ICO, ICL, BMP, and ICODATA 50# 51# RETURNS: 52# list of icon names or numerical IDs 53# 54proc ::ico::icons {file args} { 55 parseOpts type $args 56 if {![file exists $file]} { 57 return -code error "couldn't open \"$file\": no such file or directory" 58 } 59 gettype type $file 60 if {![llength [info commands getIconList$type]]} { 61 return -code error "unsupported file format $type" 62 } 63 getIconList$type [file normalize $file] 64} 65 66# iconMembers -- 67# 68# Get info on images which make up an icon 69# 70# ARGS: 71# file File containing icon 72# name Name of the icon in the file 73# ?-type? Type of file. If not specified, it is derived from 74# the file extension. Currently recognized types are 75# EXE, DLL, ICO, ICL, BMP, and ICODATA 76# 77# RETURNS: 78# list of icons as tuples {name width height bpp} 79# 80proc ::ico::iconMembers {file name args} { 81 parseOpts type $args 82 if {![file exists $file]} { 83 return -code error "couldn't open \"$file\": no such file or directory" 84 } 85 gettype type $file 86 if {![llength [info commands getIconMembers$type]]} { 87 return -code error "unsupported file format $type" 88 } 89 getIconMembers$type [file normalize $file] $name 90} 91 92# getIcon -- 93# 94# Get pixel data or image of icon 95# 96# ARGS: 97# file File to extract icon info from. 98# name Name of image in the file to use. The name is the first element 99# in the sublists returned by iconMembers. 100# ?-res? Set the preferred resolution. 101# ?-bpp? Set the preferred color depth in bits per pixel. 102# ?-exact? Accept only exact matches for res and bpp. Returns 103# an error if there is no exact match. 104# ?-type? Type of file. If not specified, it is derived from 105# the file extension. Currently recognized types are 106# EXE, DLL, ICO, ICL, BMP, and ICODATA 107# ?-format? Output format. Must be one of "image" or "colors" 108# 'image' will return the name of a Tk image. 109# 'colors' will return a list of pixel values 110# ?-image? If output is image, use this as the name of Tk image 111# created 112# 113# RETURNS: 114# pixel data as a list that could be passed to 'image create' 115# or the name of a Tk image 116# 117proc ::ico::getIcon {file name args} { 118 set image {} 119 set format image 120 set exact 0 121 set bpp 24 122 parseOpts {type format image res bpp exact} $args 123 if {![file exists $file]} { 124 return -code error "couldn't open \"$file\": no such file or directory" 125 } 126 gettype type $file 127 if {![llength [info commands getRawIconData$type]]} { 128 return -code error "unsupported file format $type" 129 } 130 # ICODATA is a pure data type - not a real file 131 if {$type ne "ICODATA"} { 132 set file [file normalize $file] 133 } 134 135 set mem [getIconMembers$type $file $name] 136 137 if {![info exists res]} { 138 set icon [lindex $mem 0 0] 139 } elseif {$exact} { 140 set icon [lindex [lsearch -inline -glob $mem "* $res $bpp"] 0] 141 if {$icon == ""} { return -code error "No matching icon" } 142 } else { 143 set mem [lsort -integer -index 1 $mem] 144 set match "" 145 foreach x $mem { 146 if {[lindex $x 1] == [lindex $res 0]} { lappend match $x } 147 } 148 if {$match == ""} { 149 # todo: resize a larger icon 150 #return -code error "No matching icon" 151 set match [list [lindex $mem end]] 152 } 153 set match [lsort -integer -decreasing -index 3 $match] 154 foreach x $match { 155 if {[lindex $x 3] <= $bpp} { set icon [lindex $x 0]; break } 156 } 157 if {![info exists icon]} { set icon [lindex $match end 0]} 158 } 159 if {$format eq "name"} { 160 return $icon 161 } 162 set colors [eval [linsert [getRawIconData$type $file $icon] 0 getIconAsColorList]] 163 if {$format eq "image"} { 164 return [createImage $colors $image] 165 } 166 return $colors 167} 168 169# getIconByName -- 170# 171# Get pixel data or image of icon name in file. The icon name 172# is the first element of the sublist from [iconMembers]. 173# 174# ARGS: 175# file File to extract icon info from. 176# name Name of image in the file to use. The name is the first element 177# in the sublists returned by iconMembers. 178# ?-type? Type of file. If not specified, it is derived from 179# the file extension. Currently recognized types are 180# EXE, DLL, ICO, ICL, BMP, and ICODATA 181# ?-format? Output format. Must be one of "image" or "colors" 182# 'image' will return the name of a Tk image. 183# 'colors' will return a list of pixel values 184# ?-image? If output is image, use this as the name of Tk image 185# created 186# 187# RETURNS: 188# pixel data as a list that could be passed to 'image create' 189# 190proc ::ico::getIconByName {file name args} { 191 set format image 192 set image {} 193 parseOpts {type format image} $args 194 if {![file exists $file]} { 195 return -code error "couldn't open \"$file\": no such file or directory" 196 } 197 gettype type $file 198 if {![llength [info commands getRawIconData$type]]} { 199 return -code error "unsupported file format $type" 200 } 201 # ICODATA is a pure data type - not a real file 202 if {$type ne "ICODATA"} { 203 set file [file normalize $file] 204 } 205 set colors [eval [linsert [getRawIconData$type $file $name] 0 getIconAsColorList]] 206 if {$format eq "image"} { 207 return [createImage $colors $image] 208 } 209 return $colors 210} 211 212# getFileIcon -- 213# 214# Get the registered icon for the file under Windows 215# 216# ARGS: 217# file File to get icon for. 218# 219# optional arguments and return values are the same as getIcon 220# 221proc ::ico::getFileIcon {file args} { 222 set icon "%SystemRoot%\\System32\\shell32.dll,0" 223 if {[file isdirectory $file] || $file == "Folder"} { 224 if {![catch {registry get HKEY_CLASSES_ROOT\\Folder\\DefaultIcon ""} reg]} { 225 set icon $reg 226 } 227 } else { 228 set ext [file extension $file] 229 if {![catch {registry get HKEY_CLASSES_ROOT\\$ext ""} doctype]} { 230 if {![catch {registry get HKEY_CLASSES_ROOT\\$doctype\\CLSID ""} clsid] && \ 231 ![catch {registry get HKEY_CLASSES_ROOT\\CLSID\\$clsid\\DefaultIcon ""} reg]} { 232 set icon $reg 233 } elseif {![catch {registry get HKEY_CLASSES_ROOT\\$doctype\\DefaultIcon ""} reg]} { 234 set icon $reg 235 } 236 } 237 } 238 set index [lindex [split $icon ,] 1] 239 set icon [lindex [split $icon ,] 0] 240 if {$index == ""} { set index 0 } 241 set icon [string trim $icon "@'\" "] 242 while {[regexp -nocase {%([a-z]+)%} $icon -> var]} { 243 set icon [string map [list %$var% $::env($var)] $icon] 244 } 245 set icon [string map [list %1 $file] $icon] 246 if {$index < 0} { 247 if {![catch {eval [list getIcon $icon [string trimleft $index -]] $args} output]} { 248 return $output 249 } 250 set index 0 251 } 252 return [eval [list getIcon $icon [lindex [icons $icon] $index]] $args] 253} 254 255# writeIcon -- 256# 257# Overwrite write image in file with depth/pixel data 258# 259# ARGS: 260# file File to extract icon info from. 261# name Name of image in the file to use. The name is the first element 262# in the sublists returned by iconMembers. 263# bpp bit depth of icon we are writing 264# data Either pixel color data (as returned by getIcon -format color) 265# or the name of a Tk image. 266# ?-type? Type of file. If not specified, it is derived from 267# the file extension. Currently recognized types are 268# EXE, DLL, ICO and ICL 269# 270# RETURNS: 271# nothing 272# 273proc ::ico::writeIcon {file name bpp data args} { 274 parseOpts type $args 275 # Bug 3007168 (code is able to create a file if none is present) 276 #if {![file exists $file]} { 277 # return -code error "couldn't open \"$file\": no such file or directory" 278 #} 279 gettype type $file 280 if {![llength [info commands writeIcon$type]]} { 281 return -code error "unsupported file format $type" 282 } 283 if {[llength $data] == 1} { 284 set data [getColorListFromImage $data] 285 } elseif {[lsearch -glob [join $data] #*] > -1} { 286 set data [translateColors $data] 287 } 288 if {$bpp != 1 && $bpp != 4 && $bpp != 8 && $bpp != 24 && $bpp != 32} { 289 return -code error "invalid color depth" 290 } 291 set palette {} 292 if {$bpp <= 8} { 293 set palette [getPaletteFromColors $data] 294 if {[lindex $palette 0] > (1 << $bpp)} { 295 return -code error "specified color depth too low" 296 } 297 set data [lindex $palette 2] 298 set palette [lindex $palette 1] 299 append palette [string repeat \000 [expr {(1 << ($bpp + 2)) - [string length $palette]}]] 300 } 301 set and [getAndMaskFromColors $data] 302 set xor [getXORFromColors $bpp $data] 303 # writeIcon$type file index w h bpp palette xor and 304 writeIcon$type [file normalize $file] $name \ 305 [llength [lindex $data 0]] [llength $data] $bpp $palette $xor $and 306} 307 308 309# copyIcon -- 310# 311# Copies an icon directly from one file to another 312# 313# ARGS: 314# file1 File to extract icon info from. 315# name1 Name of image in the file to use. The name is the first element 316# in the sublists returned by iconMembers. 317# file2 File to write icon to. 318# name2 Name of image in the file to use. The name is the first element 319# in the sublists returned by iconMembers. 320# ?-fromtype? Type of source file. If not specified, it is derived from 321# the file extension. Currently recognized types are 322# EXE, DLL, ICO, ICL, BMP, and ICODATA 323# ?-totype? Type of destination file. If not specified, it is derived from 324# the file extension. Currently recognized types are 325# EXE, DLL, ICO, ICL, BMP, and ICODATA 326# 327# RETURNS: 328# nothing 329# 330proc ::ico::copyIcon {file1 name1 file2 name2 args} { 331 parseOpts {fromtype totype} $args 332 if {![file exists $file1]} { 333 return -code error "couldn't open \"$file1\": no such file or directory" 334 } 335 if {![file exists $file2]} { 336 return -code error "couldn't open \"$file2\": no such file or directory" 337 } 338 gettype fromtype $file1 339 gettype totype $file2 340 if {![llength [info commands writeIcon$totype]]} { 341 return -code error "unsupported file format $totype" 342 } 343 if {![llength [info commands getRawIconData$fromtype]]} { 344 return -code error "unsupported file format $fromtype" 345 } 346 set src [getRawIconData$fromtype $file1 $name1] 347 writeIcon $file2 $name2 [lindex $src 2] [eval getIconAsColorList $src] -type $totype 348} 349 350# 351# transparentColor -- 352# 353# Turns on transparency for all pixels in the image that match the color 354# 355# ARGS: 356# img Name of the Tk image to modify, or an image in color list format 357# color Color in #hex format which will be made transparent 358# 359# RETURNS: 360# the data or image after modification 361# 362proc ::ico::transparentColor {img color} { 363 if {[llength $img] == 1} { 364 package require Tk 365 if {[string match "#*" $color]} { 366 set color [scan $color "#%2x%2x%2x"] 367 } 368 set w [image width $img] 369 set h [image height $img] 370 for {set y 0} {$y < $h} {incr y} { 371 for {set x 0} {$x < $w} {incr x} { 372 if {[$img get $x $y] eq $color} {$img transparency set $x $y 1} 373 } 374 } 375 } else { 376 set y 0 377 foreach row $img { 378 set x 0 379 foreach px $row { 380 if {$px == $color} {lset img $y $x {}} 381 incr x 382 } 383 incr y 384 } 385 } 386 return $img 387} 388 389# 390# clearCache -- 391# 392# Clears the cache of icon offsets 393# 394# ARGS: 395# file optional filename 396# 397# 398# RETURNS: 399# nothing 400# 401proc ::ico::clearCache {{file {}}} { 402 variable RES 403 if {$file ne ""} { 404 array unset RES $file,* 405 } else { 406 unset RES 407 array set RES {} 408 } 409} 410 411# 412# EXEtoICO -- 413# 414# Convert all icons found in exefile into regular icon files 415# 416# ARGS: 417# exeFile Input EXE filename 418# ?icoDir? Output ICO directory. Default is the 419# same directory exeFile is located in 420# 421# RETURNS: 422# nothing 423# 424proc ::ico::EXEtoICO {exeFile {icoDir {}}} { 425 variable RES 426 427 if {![file exists $exeFile]} { 428 return -code error "couldn't open \"$exeFile\": no such file or directory" 429 } 430 431 set file [file normalize $exeFile] 432 FindResources $file 433 434 if {$icoDir == ""} { set icoDir [file dirname $file] } 435 436 set fh [open $file] 437 fconfigure $fh -eofchar {} -encoding binary -translation lf 438 439 foreach group $RES($file,group,names) { 440 set dir {} 441 set data {} 442 foreach icon $RES($file,group,$group,members) { 443 seek $fh $RES($file,icon,$icon,offset) start 444 set ico $RES($file,icon,$icon,data) 445 eval [list lappend dir] $ico 446 append data [read $fh [eval calcSize $ico 40]] 447 } 448 449 # write them out to a file 450 set ifh [open [file join $icoDir [file tail $exeFile]-$group.ico] w+] 451 fconfigure $ifh -eofchar {} -encoding binary -translation lf 452 453 bputs $ifh sss 0 1 [llength $RES($file,group,$group,members)] 454 set offset [expr {6 + ([llength $RES($file,group,$group,members)] * 16)}] 455 foreach {w h bpp} $dir { 456 set len [calcSize $w $h $bpp 40] 457 lappend fix $offset $len 458 bputs $ifh ccccssii $w $h [expr {$bpp <= 8 ? 1 << $bpp : 0}] 0 1 $bpp $len $offset 459 set offset [expr {$offset + $len}] 460 } 461 puts -nonewline $ifh $data 462 foreach {offset size} $fix { 463 seek $ifh [expr {$offset + 20}] start 464 bputs $ifh i $size 465 } 466 close $ifh 467 } 468 close $fh 469} 470 471 472 473## 474## Internal helper commands. 475## Some may be appropriate for exposing later, but would need docs 476## and make sure they "fit" in the API. 477## 478 479# gets the file extension as we use it internally (upper case, no '.') 480proc ::ico::gettype {var file} { 481 upvar $var type 482 if {[info exists type]} { return } 483 set type [string trimleft [string toupper [file extension $file]] .] 484 if {$type == ""} { return -code error "could not determine file type from extension, use -$var option" } 485} 486 487# helper proc to parse optional arguments to some of the public procs 488proc ::ico::parseOpts {acc opts} { 489 foreach {key val} $opts { 490 set key [string trimleft $key -] 491 if {[lsearch -exact $acc $key] >= 0} { 492 upvar $key $key 493 set $key $val 494 } elseif {$key ne ""} { 495 return -code error "unknown option \"$key\": must be one of $acc" 496 } 497 } 498} 499 500# formats a single color from a binary decimal list format to the #hex format 501proc ::ico::formatColor {r g b} { 502 format "#%02X%02X%02X" [scan $r %c] [scan $g %c] [scan $b %c] 503} 504 505# translates a color list from the #hex format to the decimal list format 506# #0000FF {0 0 255} 507proc ::ico::translateColors {colors} { 508 set new {} 509 foreach line $colors { 510 set tline {} 511 foreach x $line { 512 if {$x eq ""} {lappend tline {}; continue} 513 lappend tline [scan $x "#%2x%2x%2x"] 514 } 515 set new [linsert $new 0 $tline] 516 } 517 return $new 518} 519 520# reads a 32 bit signed integer from the filehandle 521proc ::ico::getdword {fh} { 522 binary scan [read $fh 4] i* tmp 523 return $tmp 524} 525 526proc ::ico::getword {fh} { 527 binary scan [read $fh 2] s* tmp 528 return $tmp 529} 530 531proc ::ico::getulong {fh} { 532 binary scan [read $fh 4] i tmp 533 return [format %u $tmp] 534} 535 536proc ::ico::getushort {fh} { 537 binary scan [read $fh 2] s tmp 538 return [expr {$tmp & 0x0000FFFF}] 539} 540 541proc ::ico::bputs {fh format args} { 542 puts -nonewline $fh [eval [list binary format $format] $args] 543} 544 545proc ::ico::createImage {colors {name {}}} { 546 package require Tk 547 set h [llength $colors] 548 set w [llength [lindex $colors 0]] 549 if {$name ne ""} { 550 set img [image create photo $name -width $w -height $h] 551 } else { 552 set img [image create photo -width $w -height $h] 553 } 554 if {0} { 555 # if image supported "" colors as transparent pixels, 556 # we could use this much faster op 557 $img put -to 0 0 $colors 558 } else { 559 for {set x 0} {$x < $w} {incr x} { 560 for {set y 0} {$y < $h} {incr y} { 561 set clr [lindex $colors $y $x] 562 if {$clr ne ""} { 563 $img put -to $x $y $clr 564 } 565 } 566 } 567 } 568 return $img 569} 570 571# return a list of colors in the #hex format from raw icon data 572# returned by readDIB 573proc ::ico::getIconAsColorList {w h bpp palette xor and} { 574 # Create initial empty color array that we'll set indices in 575 set colors {} 576 set row {} 577 set empty {} 578 for {set x 0} {$x < $w} {incr x} { lappend row $empty } 579 for {set y 0} {$y < $h} {incr y} { lappend colors $row } 580 581 set x 0 582 set y [expr {$h-1}] 583 if {$bpp == 1} { 584 binary scan $xor B* xorBits 585 foreach i [split $xorBits {}] a [split $and {}] { 586 if {$x == $w} { set x 0; incr y -1 } 587 if {$a == 0} { 588 lset colors $y $x [lindex $palette $i] 589 } 590 incr x 591 } 592 } elseif {$bpp == 4} { 593 variable BITS 594 binary scan $xor B* xorBits 595 set i 0 596 foreach a [split $and {}] { 597 if {$x == $w} { set x 0; incr y -1 } 598 if {$a == 0} { 599 set bits [string range $xorBits $i [expr {$i+3}]] 600 lset colors $y $x [lindex $palette $BITS($bits)] 601 } 602 incr i 4 603 incr x 604 } 605 } elseif {$bpp == 8} { 606 foreach i [split $xor {}] a [split $and {}] { 607 if {$x == $w} { set x 0; incr y -1 } 608 if {$a == 0} { 609 lset colors $y $x [lindex $palette [scan $i %c]] 610 } 611 incr x 612 } 613 } elseif {$bpp == 16} { 614 variable BITS 615 binary scan $xor b* xorBits 616 set i 0 617 foreach a [split $and {}] { 618 if {$x == $w} { set x 0; incr y -1 } 619 if {$a == 0} { 620 set b1 [string range $xorBits $i [expr {$i+4}]] 621 set b2 [string range $xorBits [expr {$i+5}] [expr {$i+9}]] 622 set b3 [string range $xorBits [expr {$i+10}] [expr {$i+14}]] 623 lset colors $y $x "#$BITS($b3)$BITS($b2)$BITS($b1)" 624 } 625 incr i 16 626 incr x 627 } 628 } elseif {$bpp == 24} { 629 foreach {b g r} [split $xor {}] a [split $and {}] { 630 if {$x == $w} { set x 0; incr y -1 } 631 if {$a == 0} { 632 lset colors $y $x [formatColor $r $g $b] 633 } 634 incr x 635 } 636 } elseif {$bpp == 32} { 637 foreach {b g r n} [split $xor {}] a [split $and {}] { 638 if {$x == $w} { set x 0; incr y -1 } 639 if {$a == 0} { 640 lset colors $y $x [formatColor $r $g $b] 641 } 642 incr x 643 } 644 } 645 return $colors 646} 647 648# creates a binary formatted AND mask by reading a list of colors in the decimal list format 649# and checking for empty colors which designate transparency 650proc ::ico::getAndMaskFromColors {colors} { 651 set and {} 652 foreach line $colors { 653 set l {} 654 foreach x $line {append l [expr {$x eq ""}]} 655 set w [string length $l] 656 append l [string repeat 0 [expr {($w == 24) ? 8 : ($w % 32)}]] 657 foreach {a b c d e f g h} [split $l {}] { 658 append and [binary format B8 $a$b$c$d$e$f$g$h] 659 } 660 } 661 return $and 662} 663 664# creates a binary formatted XOR mask in the specified depth format from 665# a list of colors in the decimal list format 666proc ::ico::getXORFromColors {bpp colors} { 667 set xor {} 668 if {$bpp == 1} { 669 foreach line $colors { 670 foreach {a b c d e f g h} $line { 671 foreach x {a b c d e f g h} { 672 if {[set $x] == ""} {set $x 0} 673 } 674 binary scan $a$b$c$d$e$f$g$h bbbbbbbb h g f e d c b a 675 append xor [binary format b8 $a$b$c$d$e$f$g$h] 676 } 677 } 678 } elseif {$bpp == 4} { 679 foreach line $colors { 680 foreach {a b} $line { 681 if {$a == ""} {set a 0} 682 if {$b == ""} {set b 0} 683 binary scan $a$b b4b4 b a 684 append xor [binary format b8 $a$b] 685 } 686 } 687 } elseif {$bpp == 8} { 688 foreach line $colors { 689 foreach x $line { 690 if {$x == ""} {set x 0} 691 append xor [binary format c $x] 692 } 693 } 694 } elseif {$bpp == 24} { 695 foreach line $colors { 696 foreach x $line { 697 if {![llength $x]} { 698 append xor [binary format ccc 0 0 0] 699 } else { 700 foreach {a b c n} $x { 701 append xor [binary format ccc $c $b $a] 702 } 703 } 704 } 705 } 706 } elseif {$bpp == 32} { 707 foreach line $colors { 708 foreach x $line { 709 if {![llength $x]} { 710 append xor [binary format cccc 0 0 0 0] 711 } else { 712 foreach {a b c n} $x { 713 if {$n == ""} {set n 0} 714 append xor [binary format cccc $c $b $a $n] 715 } 716 } 717 } 718 } 719 } 720 return $xor 721} 722 723# translates a Tk image into a list of colors in the {r g b} format 724# one element per pixel and {} designating transparent 725# used by writeIcon when writing from a Tk image 726proc ::ico::getColorListFromImage {img} { 727 package require Tk 728 set w [image width $img] 729 set h [image height $img] 730 set r {} 731 for {set y [expr $h - 1]} {$y > -1} {incr y -1} { 732 set l {} 733 for {set x 0} {$x < $w} {incr x} { 734 if {[$img transparency get $x $y]} { 735 lappend l {} 736 } else { 737 lappend l [$img get $x $y] 738 } 739 } 740 lappend r $l 741 } 742 return $r 743} 744 745# creates a palette from a list of colors in the decimal list format 746# a palette consists of 3 values, the number of colors, the palette entry itself, 747# and the color list transformed to point to palette entries instead of color names 748# the palette entry itself is stored as 32bpp in "G B R padding" order 749proc ::ico::getPaletteFromColors {colors} { 750 set palette "\x00\x00\x00\x00" 751 array set tpal {{0 0 0} 0} 752 set new {} 753 set i 1 754 foreach line $colors { 755 set tline {} 756 foreach x $line { 757 if {$x eq ""} {lappend tline {}; continue} 758 if {![info exists tpal($x)]} { 759 foreach {a b c n} $x { 760 append palette [binary format cccc $c $b $a 0] 761 } 762 set tpal($x) $i 763 incr i 764 } 765 lappend tline $tpal($x) 766 } 767 lappend new $tline 768 } 769 return [list $i $palette $new] 770} 771 772# calculate byte size of an icon. 773# often passed $w twice because $h is double $w in the binary data 774proc ::ico::calcSize {w h bpp {offset 0}} { 775 set s [expr {int(($w*$h) * ($bpp/8.0)) + 776 ((($w*$h) + ($h*(($w==24) ? 8 : ($w%32))))/8) + $offset}] 777 if {$bpp <= 8} { set s [expr {$s + (1 << ($bpp + 2))}] } 778 return $s 779} 780 781# read a Device Independent Bitmap from the current offset, return: 782# {width height depth palette XOR_mask AND_mask} 783proc ::ico::readDIB {fh} { 784 binary scan [read $fh 16] x4iix2s w h bpp 785 set h [expr {$h / 2}] 786 seek $fh 24 current 787 788 set palette [list] 789 if {$bpp == 1 || $bpp == 4 || $bpp == 8} { 790 set colors [read $fh [expr {1 << ($bpp + 2)}]] 791 foreach {b g r x} [split $colors {}] { 792 lappend palette [formatColor $r $g $b] 793 } 794 } elseif {$bpp == 16 || $bpp == 24 || $bpp == 32} { 795 # do nothing here 796 } else { 797 return -code error "unsupported color depth: $bpp" 798 } 799 800 set xor [read $fh [expr {int(($w * $h) * ($bpp / 8.0))}]] 801 set and1 [read $fh [expr {(($w * $h) + ($h * (($w == 24) ? 8 : ($w % 32)))) / 8}]] 802 803 set and {} 804 set row [expr {((($w - 1) / 32) * 32 + 32) / 8}] 805 set len [expr {$row * $h}] 806 for {set i 0} {$i < $len} {incr i $row} { 807 binary scan [string range $and1 $i [expr {$i + $row}]] B$w tmp 808 append and $tmp 809 } 810 811 return [list $w $h $bpp $palette $xor $and] 812} 813 814# read a Device Independent Bitmap from raw data, return: 815# {width height depth palette XOR_mask AND_mask} 816proc ::ico::readDIBFromData {data loc} { 817 # Read info from location 818 binary scan $data @${loc}x4iix2s w h bpp 819 set h [expr {$h / 2}] 820 # Move over w/h/bpp info + magic offset to start of DIB 821 set cnt [expr {$loc + 16 + 24}] 822 823 set palette [list] 824 if {$bpp == 1 || $bpp == 4 || $bpp == 8} { 825 # Could do: [binary scan $data @${cnt}c$len colors] 826 # and iter over colors, but this is more consistent with $fh version 827 set len [expr {1 << ($bpp + 2)}] 828 set colors [string range $data $cnt [expr {$cnt + $len - 1}]] 829 foreach {b g r x} [split $colors {}] { 830 lappend palette [formatColor $r $g $b] 831 } 832 incr cnt $len 833 } elseif {$bpp == 16 || $bpp == 24 || $bpp == 32} { 834 # do nothing here 835 } else { 836 return -code error "unsupported color depth: $bpp" 837 } 838 839 # Use -1 to account for string range inclusiveness 840 set end [expr {$cnt + int(($w * $h) * ($bpp / 8.0)) - 1}] 841 set xor [string range $data $cnt $end] 842 set and1 [string range $data [expr {$end + 1}] \ 843 [expr {$end + ((($w * $h) + ($h * (($w == 24) ? 8 : ($w % 32)))) / 8) - 1}]] 844 845 set and {} 846 set row [expr {((($w - 1) / 32) * 32 + 32) / 8}] 847 set len [expr {$row * $h}] 848 for {set i 0} {$i < $len} {incr i $row} { 849 # Has to be decoded by row, in order 850 binary scan [string range $and1 $i [expr {$i + $row}]] B$w tmp 851 append and $tmp 852 } 853 854 return [list $w $h $bpp $palette $xor $and] 855} 856 857proc ::ico::getIconListICO {file} { 858 set fh [open $file r] 859 fconfigure $fh -eofchar {} -encoding binary -translation lf 860 861 if {"[getword $fh] [getword $fh]" ne "0 1"} { 862 return -code error "not an icon file" 863 } 864 close $fh 865 return 0 866} 867 868proc ::ico::getIconListICODATA {data} { 869 if {[binary scan $data sss h1 h2 num] != 3 || $h1 != 0 || $h2 != 1} { 870 return -code error "not icon data" 871 } 872 return 0 873} 874 875proc ::ico::getIconListBMP {file} { 876 set fh [open $file] 877 if {[read $fh 2] != "BM"} { close $fh; return -code error "not a BMP file" } 878 close $fh 879 return 0 880} 881 882proc ::ico::getIconListEXE {file} { 883 variable RES 884 885 set file [file normalize $file] 886 if {[FindResources $file] > -1} { 887 return $RES($file,group,names) 888 } else { 889 return "" 890 } 891} 892 893# returns a list of images that make up the named icon 894# as tuples {name width height bpp}. Called by [iconMembers] 895proc ::ico::getIconMembersICO {file name} { 896 variable RES 897 898 if {$name ne "0"} { return -code error "no icon \"$name\"" } 899 set file [file normalize $file] 900 if {[info exists RES($file,group,$name,members)]} { 901 set ret "" 902 foreach x $RES($file,group,$name,members) { 903 lappend ret [linsert $RES($file,icon,$x,data) 0 $x] 904 } 905 return $ret 906 } 907 908 set fh [open $file r] 909 fconfigure $fh -eofchar {} -encoding binary -translation lf 910 911 # both words must be read to keep in sync with later reads 912 if {"[getword $fh] [getword $fh]" ne "0 1"} { 913 close $fh 914 return -code error "not an icon file" 915 } 916 917 set ret "" 918 set num [getword $fh] 919 for {set i 0} {$i < $num} {incr i} { 920 set info "" 921 lappend RES($file,group,$name,members) $i 922 lappend info [scan [read $fh 1] %c] [scan [read $fh 1] %c] 923 set bpp [scan [read $fh 1] %c] 924 if {$bpp == 0} { 925 set orig [tell $fh] 926 seek $fh 9 current 927 seek $fh [expr {[getdword $fh] + 14}] start 928 lappend info [getword $fh] 929 seek $fh $orig start 930 } else { 931 lappend info [expr {int(sqrt($bpp))}] 932 } 933 lappend ret [linsert $info 0 $i] 934 set RES($file,icon,$i,data) $info 935 seek $fh 13 current 936 } 937 close $fh 938 return $ret 939} 940 941# returns a list of images that make up the named icon 942# as tuples {name width height bpp}. Called by [iconMembers] 943proc ::ico::getIconMembersICODATA {data} { 944 if {[binary scan $data sss h1 h2 num] != 3 || $h1 != 0 || $h2 != 1} { 945 return -code error "not icon data" 946 } 947 set r {} 948 set cnt 6 949 for {set i 0} {$i < $num} {incr i} { 950 if {[binary scan $data @${cnt}ccc w h bpp] != 3} { 951 return -code error "error decoding icon data" 952 } 953 incr cnt 3 954 set info [list $i $w $h] 955 if {$bpp == 0} { 956 set off [expr {$cnt + 9}] 957 binary scan $data @${off}i off 958 incr off 14 959 binary scan $data @${off}s bpp 960 lappend info $bpp 961 } else { 962 lappend info [expr {int(sqrt($bpp))}] 963 } 964 lappend r $info 965 incr cnt 13 966 } 967 return $r 968} 969 970# returns a list of images that make up the named icon 971# as tuples {name width height bpp}. Called by [iconMembers] 972proc ::ico::getIconMembersBMP {file {name 0}} { 973 if {$name ne "0"} { return -code error "no icon \"$name\"" } 974 set fh [open $file] 975 if {[read $fh 2] != "BM"} { close $fh; return -code error "not a BMP file" } 976 seek $fh 14 start 977 binary scan [read $fh 16] x4iix2s w h bpp 978 close $fh 979 return [list 1 $w $h $bpp] 980} 981 982# returns a list of images that make up the named icon 983# as tuples {name width height bpp}. Called by [iconMembers] 984proc ::ico::getIconMembersEXE {file name} { 985 variable RES 986 set file [file normalize $file] 987 FindResources $file 988 if {![info exists RES($file,group,$name,members)]} { return -code error "no icon \"$name\"" } 989 set ret "" 990 foreach x $RES($file,group,$name,members) { 991 lappend ret [linsert $RES($file,icon,$x,data) 0 $x] 992 } 993 return $ret 994} 995 996# returns an icon in the form: 997# {width height depth palette xor_mask and_mask} 998proc ::ico::getRawIconDataICO {file name} { 999 set fh [open $file r] 1000 fconfigure $fh -eofchar {} -encoding binary -translation lf 1001 1002 # both words must be read to keep in sync with later reads 1003 if {"[getword $fh] [getword $fh]" ne "0 1"} { 1004 close $fh 1005 return -code error "not an icon file" 1006 } 1007 set num [getword $fh] 1008 if {![string is integer -strict $name] || $name < 0 || $name >= $num} { return -code error "no icon \"$name\"" } 1009 1010 seek $fh [expr {(16 * $name) + 12}] current 1011 seek $fh [getdword $fh] start 1012 1013 # readDIB returns: {w h bpp palette xor and} 1014 set dib [readDIB $fh] 1015 1016 close $fh 1017 return $dib 1018} 1019 1020# returns an icon in the form: 1021# {width height depth palette xor_mask and_mask} 1022proc ::ico::getRawIconDataICODATA {data name} { 1023 if {[binary scan $data sss h1 h2 num] != 3 || $h1 != 0 || $h2 != 1} { 1024 return -code error "not icon data" 1025 } 1026 if {![string is integer -strict $name] || $name < 0 || $name >= $num} { 1027 return -code error "No icon $name" 1028 } 1029 # Move to ico location 1030 set cnt [expr {6 + (16 * $name) + 12}] 1031 binary scan $data @${cnt}i loc 1032 1033 # readDIB returns: {w h bpp palette xor and} 1034 set dib [readDIBFromData $data $loc] 1035 1036 return $dib 1037} 1038 1039# returns an icon in the form: 1040# {width height depth palette xor_mask and_mask} 1041proc ::ico::getRawIconDataBMP {file {name 1}} { 1042 if {$name ne "1"} {return -code error "No icon \"$name\""} 1043 set fh [open $file] 1044 if {[read $fh 2] != "BM"} { close $fh; return -code error "not a BMP file" } 1045 seek $fh 14 start 1046 binary scan [read $fh 16] x4iix2s w h bpp 1047 seek $fh 24 current 1048 1049 set palette [list] 1050 if {$bpp == 1 || $bpp == 4 || $bpp == 8} { 1051 set colors [read $fh [expr {1 << ($bpp + 2)}]] 1052 foreach {b g r x} [split $colors {}] { 1053 lappend palette [formatColor $r $g $b] 1054 } 1055 } elseif {$bpp == 16 || $bpp == 24 || $bpp == 32} { 1056 # do nothing here 1057 } else { 1058 return -code error "unsupported color depth: $bpp" 1059 } 1060 1061 set xor [read $fh [expr {int(($w * $h) * ($bpp / 8.0))}]] 1062 set and [string repeat 0 [expr {$w * $h}]] 1063 close $fh 1064 1065 return [list $w $h $bpp $palette $xor $and] 1066} 1067 1068# returns an icon in the form: 1069# {width height depth palette xor_mask and_mask} 1070proc ::ico::getRawIconDataEXE {file name} { 1071 variable RES 1072 1073 set file [file normalize $file] 1074 FindResources $file 1075 1076 if {![info exists RES($file,icon,$name,offset)]} { error "No icon \"$name\"" } 1077 set fh [open $file] 1078 fconfigure $fh -eofchar {} -encoding binary -translation lf 1079 seek $fh $RES($file,icon,$name,offset) start 1080 1081 # readDIB returns: {w h bpp palette xor and} 1082 set dib [readDIB $fh] 1083 close $fh 1084 return $dib 1085} 1086 1087proc ::ico::writeIconICO {file name w h bpp palette xor and} { 1088 if {![file exists $file]} { 1089 set fh [open $file w+] 1090 fconfigure $fh -eofchar {} -encoding binary -translation lf 1091 set num 0 1092 } else { 1093 set fh [open $file r+] 1094 fconfigure $fh -eofchar {} -encoding binary -translation lf 1095 if {"[getword $fh] [getword $fh]" ne "0 1"} { 1096 close $fh 1097 return -code error "not an icon file" 1098 } 1099 set num [getword $fh] 1100 seek $fh [expr {6 + (16 * $num)}] start 1101 } 1102 1103 set size [expr {[string length $palette] + [string length $xor] + [string length $and]}] 1104 set newicon [binary format iiissiiiiii 40 $w [expr {$h * 2}] 1 $bpp 0 $size 0 0 0 0]$palette$xor$and 1105 1106 set data {} 1107 for {set i 0} {$i < $num} {incr i} { 1108 binary scan [read $fh 24] ix16i a b 1109 seek $fh -24 current 1110 lappend data [read $fh [expr {$a + $b}]] 1111 } 1112 1113 if {![string is integer -strict $name] || $name < 0 || $name >= $num} { 1114 set name [llength $data] 1115 lappend data $newicon 1116 } else { 1117 set data [lreplace $data $name $name $newicon] 1118 } 1119 set num [llength $data] 1120 1121 seek $fh 0 start 1122 bputs $fh sss 0 1 $num 1123 set offset [expr {6 + (16 * $num)}] 1124 foreach x $data { 1125 binary scan $x x4iix2s w h bpp 1126 set len [string length $x] 1127 # use original height in icon table header 1128 bputs $fh ccccssii $w [expr {$h / 2}] [expr {$bpp <= 8 ? 1 << $bpp : 0}] 0 0 $bpp $len $offset 1129 incr offset $len 1130 } 1131 puts -nonewline $fh [join $data {}] 1132 close $fh 1133 1134 return $name 1135} 1136 1137proc ::ico::writeIconICODATA {file name w h bpp palette xor and} { 1138 upvar 2 [file tail $file] input 1139 if {![info exists input] || ([binary scan $input sss h1 h2 num] != 3 || $h1 != 0 || $h2 != 1)} { 1140 set num 0 1141 } 1142 1143 set size [expr {[string length $palette] + [string length $xor] + [string length $and]}] 1144 set newicon [binary format iiissiiiiii 40 $w [expr {$h * 2}] 1 $bpp 0 $size 0 0 0 0]$palette$xor$and 1145 1146 set readpos [expr {6 + (16 * $num)}] 1147 set data {} 1148 for {set i 0} {$i < $num} {incr i} { 1149 binary scan $input @{$readpos}ix16i a b 1150 lappend data [string range $data $readpos [expr {$readpos + $a + $b}]] 1151 incr readpos [expr {$readpos + $a + $b}] 1152 } 1153 1154 if {![string is integer -strict $name] || $name < 0 || $name >= $num} { 1155 set name [llength $data] 1156 lappend data $newicon 1157 } else { 1158 set data [lreplace $data $name $name $newicon] 1159 } 1160 set num [llength $data] 1161 1162 set new [binary format sss 0 1 $num] 1163 set offset [expr {6 + (16 * $num)}] 1164 foreach x $data { 1165 binary scan $x x4iix2s w h bpp 1166 set len [string length $x] 1167 # use original height in icon table header 1168 append new [binary format ccccssii $w [expr {$h / 2}] [expr {$bpp <= 8 ? 1 << $bpp : 0}] 0 0 $bpp $len $offset] 1169 incr offset $len 1170 } 1171 set input $new 1172 append input [join $data {}] 1173 1174 return $name 1175} 1176 1177proc ::ico::writeIconBMP {file name w h bpp palette xor and} { 1178 set fh [open $file w+] 1179 fconfigure $fh -eofchar {} -encoding binary -translation lf 1180 set size [expr {[string length $palette] + [string length $xor]}] 1181 # bitmap header: magic, file size, reserved, reserved, offset of bitmap data 1182 bputs $fh a2issi BM [expr {14 + 40 + $size}] 0 0 54 1183 bputs $fh iiissiiiiii 40 $w $h 1 $bpp 0 $size 0 0 0 0 1184 puts -nonewline $fh $palette$xor 1185 close $fh 1186} 1187 1188proc ::ico::writeIconEXE {file name w h bpp palette xor and} { 1189 variable RES 1190 1191 set file [file normalize $file] 1192 FindResources $file 1193 1194 if {![info exists RES($file,icon,$name,data)]} { 1195 return -code error "no icon \"$name\"" 1196 } 1197 if {"$w $h $bpp" != $RES($file,icon,$name,data)} { 1198 return -code error "icon format differs from original" 1199 } 1200 1201 set fh [open $file r+] 1202 fconfigure $fh -eofchar {} -encoding binary -translation lf 1203 seek $fh [expr {$RES($file,icon,$name,offset) + 40}] start 1204 1205 puts -nonewline $fh $palette$xor$and 1206 close $fh 1207} 1208 1209proc ::ico::FindResources {file} { 1210 variable RES 1211 1212 if {[info exists RES($file,group,names)]} { 1213 return [llength $RES($file,group,names)] 1214 } 1215 1216 set fh [open $file] 1217 fconfigure $fh -eofchar {} -encoding binary -translation lf 1218 if {[read $fh 2] ne "MZ"} { 1219 close $fh 1220 return -code error "file is not a valid executable" 1221 } 1222 seek $fh 60 start 1223 seek $fh [getword $fh] start 1224 set sig [read $fh 4] 1225 seek $fh -4 current 1226 if {$sig eq "PE\000\000"} { 1227 return [FindResourcesPE $fh $file] 1228 } elseif {[string match NE* $sig]} { 1229 return [FindResourcesNE $fh $file] 1230 } else { 1231 return -code error "file is not a valid executable" 1232 } 1233} 1234 1235# parse the resource table of 16 bit windows files for icons 1236proc ::ico::FindResourcesNE {fh file} { 1237 variable RES 1238 1239 seek $fh 36 current 1240 seek $fh [expr {[getword $fh] - 38}] current 1241 set base [tell $fh] 1242 set shift [expr {int(pow(2, [getushort $fh]))}] 1243 while {[set type [expr {[getushort $fh] & 0x7fff}]] != 0} { 1244 set num [getushort $fh] 1245 if {$type != 3 && $type != 14} { 1246 seek $fh [expr {($num * 12) + 4}] current 1247 continue 1248 } 1249 set type [string map {3 icon 14 group} $type] 1250 seek $fh 4 current 1251 for {set i 0} {$i < $num} {incr i} { 1252 set offset [expr {[getushort $fh] * $shift}] 1253 seek $fh 4 current 1254 set name [getNEResName $fh $base [getushort $fh]] 1255 set RES($file,$type,$name,offset) $offset 1256 lappend RES($file,$type,names) $name 1257 seek $fh 4 current 1258 } 1259 } 1260 if {[array names RES $file,*] == ""} { 1261 close $fh 1262 return -1 1263 } 1264 foreach x [array names RES $file,group,*,offset] { 1265 seek $fh [expr {$RES($x) + 4}] start 1266 binary scan [read $fh 2] s a 1267 set x [lindex [split $x ,] 2] 1268 for {set i 0} {$i < $a} {incr i} { 1269 binary scan [read $fh 14] x12s n 1270 lappend RES($file,group,$x,members) $n 1271 } 1272 } 1273 foreach x [array names RES $file,icon,*,offset] { 1274 seek $fh [expr {$RES($x)}] start 1275 set x [lindex [split $x ,] 2] 1276 binary scan [read $fh 16] x4iix2s w h bpp 1277 set RES($file,icon,$x,data) [list $w [expr {$h / 2}] $bpp] 1278 } 1279 close $fh 1280 return [llength $RES($file,group,names)] 1281} 1282 1283proc ::ico::getNEResName {fh base data} { 1284 if {$data == 0} { 1285 return 0 1286 } 1287 binary scan $data b* tmp 1288 if {[string index $tmp 0] == 0} { 1289 set cur [tell $fh] 1290 seek $fh [expr {$data + $base}] start 1291 binary scan [read $fh 1] c len 1292 set name [read $fh $len] 1293 seek $fh $cur start 1294 return $name 1295 } else { 1296 return [expr {$data & 0x7fff}] 1297 } 1298} 1299 1300# parse the resource tree of 32 bit windows files for icons 1301proc ::ico::FindResourcesPE {fh file} { 1302 variable RES 1303 1304 # find the .rsrc section by reading the coff header 1305 binary scan [read $fh 24] x6sx12s sections headersize 1306 seek $fh $headersize current 1307 for {set i 0} {$i < $sections} {incr i} { 1308 binary scan [read $fh 40] a8x4ix4i type baserva base 1309 if {[string match .rsrc* $type]} {break} 1310 } 1311 # no resource section found = no icons 1312 if {![string match .rsrc* $type]} { 1313 close $fh 1314 return -1 1315 } 1316 seek $fh $base start 1317 1318 seek $fh 12 current 1319 # number of entries in the resource table. each one is a different resource type 1320 set entries [expr {[getushort $fh] + [getushort $fh]}] 1321 for {set i 0} {$i < $entries} {incr i} { 1322 set type [getulong $fh] 1323 set offset [expr {[getulong $fh] & 0x7fffffff}] 1324 if {$type != 3 && $type != 14} {continue} 1325 set type [string map {3 icon 14 group} $type] 1326 1327 set cur [tell $fh] 1328 seek $fh [expr {$base + $offset + 12}] start 1329 set entries2 [expr {[getushort $fh] + [getushort $fh]}] 1330 for {set i2 0} {$i2 < $entries2} {incr i2} { 1331 set name [getPEResName $fh $base [getulong $fh]] 1332 lappend RES($file,$type,names) $name 1333 set offset [expr {[getulong $fh] & 0x7fffffff}] 1334 1335 set cur2 [tell $fh] 1336 seek $fh [expr {$offset + $base + 12}] start 1337 set entries3 [expr {[getushort $fh] + [getushort $fh]}] 1338 for {set i3 0} {$i3 < $entries3} {incr i3} { 1339 seek $fh 4 current 1340 set offset [expr {[getulong $fh] & 0x7fffffff}] 1341 set cur3 [tell $fh] 1342 1343 seek $fh [expr {$offset + $base}] start 1344 set rva [getulong $fh] 1345 set RES($file,$type,$name,offset) [expr {$rva - $baserva + $base}] 1346 1347 seek $fh $cur3 start 1348 } 1349 1350 seek $fh $cur2 start 1351 } 1352 seek $fh $cur start 1353 } 1354 if {[array names RES $file,*] == ""} { 1355 close $fh 1356 return -1 1357 } 1358 foreach x [array names RES $file,group,*,offset] { 1359 seek $fh [expr {$RES($x) + 4}] start 1360 binary scan [read $fh 2] s a 1361 set x [lindex [split $x ,] 2] 1362 for {set i 0} {$i < $a} {incr i} { 1363 binary scan [read $fh 14] x12s n 1364 lappend RES($file,group,$x,members) $n 1365 } 1366 } 1367 foreach x [array names RES $file,icon,*,offset] { 1368 seek $fh [expr {$RES($x)}] start 1369 set x [lindex [split $x ,] 2] 1370 binary scan [read $fh 16] x4iix2s w h bpp 1371 set RES($file,icon,$x,data) [list $w [expr {$h / 2}] $bpp] 1372 } 1373 1374 close $fh 1375 return [llength $RES($file,group,names)] 1376} 1377 1378proc ::ico::getPEResName {fh start data} { 1379 if {($data & 0x80000000) != 0} { 1380 set cur [tell $fh] 1381 seek $fh [expr {($data & 0x7fffffff) + $start}] start 1382 set len [getushort $fh] 1383 set name [read $fh [expr {$len * 2}]] 1384 seek $fh $cur start 1385 return [encoding convertfrom unicode $name] 1386 } else { 1387 return $data 1388 } 1389} 1390 1391interp alias {} ::ico::getIconListDLL {} ::ico::getIconListEXE 1392interp alias {} ::ico::getIconMembersDLL {} ::ico::getIconMembersEXE 1393interp alias {} ::ico::getRawIconDataDLL {} ::ico::getRawIconDataEXE 1394interp alias {} ::ico::writeIconDLL {} ::ico::writeIconEXE 1395interp alias {} ::ico::getIconListICL {} ::ico::getIconListEXE 1396interp alias {} ::ico::getIconMembersICL {} ::ico::getIconMembersEXE 1397interp alias {} ::ico::getRawIconDataICL {} ::ico::getRawIconDataEXE 1398interp alias {} ::ico::writeIconICL {} ::ico::writeIconEXE 1399 1400package provide ico 1.0.5 1401