Bwidget Source Code
View Ticket
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.
Ticket UUID: 9a8b2ee42ef7ec0ea894c424fd363bf2cf81dd66
Title: xpm2image failing with qt generated xpm files
Type: Bug Version: 1.9.6
Submitter: oehhar Created on: 2013-09-02 09:08:09
Subsystem: bwidget 1.x Assigned To: nobody
Priority: 5 Medium Severity: Minor
Status: Closed Last Modified: 2014-01-21 13:16:59
Resolution: Accepted Closed By: oehhar
    Closed on: 2014-01-21 13:16:59

From Matthias Hembruch 2013-09-01 1:45 to Johann Oberdorfer:

I had a reason to try the "xpm2image.tcl" code included with BWidget 1.96, and found that it had several issues when trying to convert some .xpm files I wanted to use. Those .xpm files may have been created by Qt, but I'm not sure.

In any case, I updated the code to fix the problems (the problems were all parsing issues, the actual building of the images seemed to work fine). However, I have not tried it with other .xpm images, and of course, I may have broken something that used to work.

In any case, I am attaching a patched "xpm2image.tcl" file with comments explaining the changes I made. If you feel they are useful, feel free to integrate any or all of them into the BWidget source tree. I release all rights, although I would love to get a mention in the header of the .tcl file if you use some of my patches.

User Comments: oehhar added on 2014-01-21 13:16:59:

Accepted, checkin [f7299663b4]. Thank you, Harald

oehhar added on 2013-09-11 16:11:21:
Mail by Matthias 06.09.2013 21:02 with 3 attachments:

Hi Harald.

Here's the latest patch. I found a few more issues. I had to re-write the structure somewhat, and introduce a new proc called "process_line", because, as you can see from the comments, I found at least one .xpm file where they counted the number of colors NOT including the "none" line. So, if we get to an undefined color, and there was a "none" definition, we try to process that line as a color definition instead. It makes at least one more .xpm file work.

I have tried to write it using only [string equal] to compare strings, so may even work for Tcl 8.3, I'm not sure.

This code now passes for every .xpm I found in /usr on my Slackware build - 5243 .xpm files, some quite large (whole toolbars as ONE .xpm image). I had to remap the color "opaque" to "black" for one. It also passes for the google chrome .xpm icon, and a few others at work that I tested (including the ones I'm interested in). It failed for some v1 xpm files (which have a 100% C structure), but the original code couldn't handle those either. Maybe in a month or two if I get bored :-)

Using a tcl 8.5 build, it parses all 5243 files and creates an image out of them in approx 8-9 seconds on my system (i5-3570k around 4 Ghz). I also wrote a small app to display the .xpm files in a scrolled window. You can run them as:
xpmt `find . -name "*.xpm"`
to test the parsing of the files (it prints output every 100 images)
xpmv `find . -name "*.xpm"`
to display the images (it was nice to see that they appeared to visually look correct!)

Note: you'll have to edit xpmv/xpmt to fix up the auto_path and where it sources the xpm2image.tcl file from.

Please let me know if you need anything else, or anything is unclear.


oehhar added on 2013-09-02 09:46:02:

I have some remarks to the patch, here maked by #HaO:

        ## pretty sure this needs the \[list ... \] around it..
	## HaO: well, this does not loop any more, as there is always only one element in the list
        foreach record [list [lrange $colors 1 end]] {
            set idx 0

            ## some files use symbolic names and have entries like:
            ## "a. s symbol1 c #000000 m white"
            ## I'm guessing this is a "in case this is a mono display, use the
            ## 'm' attribute for mono # fallback?? Fix: scan the list for
            ## the first 'c' entry, use the next entry for color RGB value
            set key [lindex $record $idx]
            while { ($key != "c") && ($key != "") } {
                incr idx
                set key [lindex $record $idx]
            if { $key eq "c" } {
                incr idx
                set color [string tolower [lindex $record $idx]]
            # HaO: color is undefined if key ne "c"
            set data(color-$key-$cname) $color
            if { [string equal -nocase $color "none"] } {
                set data(transparent) $cname