Getting an X11 Window List and Icons

[Kirsle]

I'm playing around with the idea of creating an X11 desktop panel using something like Tkx (ActivePerl) or Tcl::Tk, so I was experimenting with some of the X11 modules on CPAN to get a window list, which would be a necessity to create a task list applet for my panel.

I found X11::Tops which gets a window list, including the window titles and their "icon names" (the names for a task switcher applet), but not their icon images. So I used its source code and looked up the X11 docs and wrote the following:

#!/usr/bin/perl -w

# see also: [URL unfurl="true"]http://standards.freedesktop.org/wm-spec/wm-spec-latest.html[/URL]

use 5.10.0;
use strict;
use warnings;
use X11::Protocol;
use MIME::Base64 qw(encode_base64);

my @getpropconst = ('AnyPropertyType', 0, -1, 0);

# based on X11::Tops but to get more info
my $X = X11::Protocol->new();
my $xtops = {};
$xtops->{X} = $X;
$xtops->{root} = $X->root; # assumes only 1 screen
$xtops->{$_} = $X->InternAtom($_, 0) for qw(
    _NET_CLIENT_LIST
    _XCHAR_CHAR
    _XCHAR_COMMAND
);
$xtops->{$_} = $X->atom($_) for qw(
    _WIN_CLIENT_LIST
    _NET_ACTIVE_WINDOW
    _NET_CLIENT_LIST_STACKING
    WM_CLASS
    WM_NAME
    WM_ICON_NAME
    _NET_WM_ICON_GEOMETRY
    _NET_WM_ICON
    STRING
    WM_NORMAL_HINTS
    WM_SIZE_HINTS
);
$xtops->{$_} || croak("failed to create atom $_") for qw(
    _XCHAR_CHAR
    _XCHAR_COMMAND
);

# fetch the ID's taken from X11::Tops::fetch_ids()
my $_NET_CLIENT_LIST = $xtops->{_NET_CLIENT_LIST};
my ($value,$type,$format,$bytes_after) =
    $X->GetProperty($xtops->{root}, $_NET_CLIENT_LIST, @getpropconst);
my @ids = unpack('L*', $value);
print "Window IDs: @ids\n";

foreach my $id (@ids) {
    # Window class
    my $WM_CLASS = $xtops->{WM_CLASS};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_CLASS, @getpropconst);
        my ($instance,$class) = split("\0", $value);
        print "Window ID: $id\nInstance: $instance\nClass: $class\n";
    }

    # Get its title
    my $WM_NAME = $xtops->{WM_NAME};
    my $wintitle;
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_NAME, @getpropconst);
        print "Title: $value\n";
        $wintitle = $value;
    }

    # Icon title
    my $WM_ICON_NAME = $xtops->{WM_ICON_NAME};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON_NAME, @getpropconst);
        print "Icon name: $value\n";
    }

    # Get icon geometry
    my $WM_ICON_GEOMETRY = $xtops->{_NET_WM_ICON_GEOMETRY};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON_GEOMETRY, @getpropconst);
        print "Geometry: $value\n";
    }

    # Get its icon image
    my $WM_ICON = $xtops->{_NET_WM_ICON};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON, @getpropconst);
        print "Icon: " . length($value) . "\n\n";

        open (TEST, ">$wintitle.png");
        binmode TEST;
        print TEST $value;
        close (TEST);

        my @atoms = $X->ListProperties($id);
        my @names = map { $X->atom_name($_) } @atoms;
        print "props: @names\n";
    }
}

Basically I used the source of X11::Tops to figure out how to get the list of window ID's and pull info out of them, but added support for pulling the _NET_WM_ICON (icon data) and _NET_WM_ICON_GEOMETRY (icon geometry).

According to

http://standards.freedesktop.org/wm-spec/wm-spec-latest.html

_NET_WM_ICON

_NET_WM_ICON CARDINAL[][2+n]/32

This is an array of possible icons for the client. This specification does not stipulate what size these icons should be, but individual desktop environments or toolkits may do so. The Window Manager MAY scale any of these icons to an appropriate size.

This is an array of 32bit packed CARDINAL ARGB with high byte being A, low byte being B. The first two cardinals are width, height. Data is in rows, left to right and top to bottom.

So, my code gets a big binary blog of data for _NET_WM_ICON and I tried dumping it to a file to see if Linux would recognize it as any sort of image file (regardless of the .png extension, Linux should see it as its real file type even if the extension was wrong).

If I run the `file` command on the files it created, some of them return GLS_BINARY_LSB_FIRST and some return just "data"

I've narrowed the problem down to, somehow I need to parse and unpack this binary blob I get from X11:rotocol to get the actual image data in some format I can use. Does anybody know more about unpacking this data? I'm not a C programmer and I dunno what "_NET_WM_ICON CARDINAL[][2+n]/32" is supposed to mean.

Kirsle.net | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'

 

[Annihilannic]

It sounds to me like raw/uncompressed image data, i.e. exactly what you would blit to the video card to display. Each set of 32-bits consists of 4 8-bit numbers, Alpha, Red, Green and Blue (the same as what is used when you set your display mode to 32-bit colour depth).

So for a 64x64 icon you should get 64x64x4 = 16384 bytes, plus 2x4 bytes prefix for the width and height = 16392 bytes.

What I don't fully understand for that description is how it would appear should there be multiple icons in that array... does each individual icon have a width and height prefix? You could probably figure this out by examining the various array sizes you get.

Annihilannic.

 

[Kirsle]

I've got it sorta figured out.

The format seemed to be: in the binary blob...

First 4 bytes were the width (unsigned long)
Next 4 were the height (unsigned long)

Followed by 4 bytes for each pixel in the image, in RGBA format, until every pixel in the width*height*4 is exhausted, and then the following icon's data would start.

I went through 3 different image generation modules before I got some code that mostly works. GD I tried first but it wasn't doing the trick (kept making solid black icons), then Image::Magick refused to write PNG files, claiming "no images defined", so I finally got Imager to work for me.

Half the icons have wrong palettes but they're still otherwise identifiable. The wrong palettes probably have to do with my pixels being in the wrong order. But anyway, here's the code as I have it now:

#!/usr/bin/perl -w

# see also: [URL unfurl="true"]http://standards.freedesktop.org/wm-spec/wm-spec-latest.html[/URL]

use 5.10.0;
use strict;
use warnings;
use Imager;
use X11::Protocol;
use MIME::Base64 qw(encode_base64);

my @getpropconst = ('AnyPropertyType', 0, -1, 0);

# based on X11::Tops but to get more info
my $X = X11::Protocol->new();
my $xtops = {};
$xtops->{X} = $X;
$xtops->{root} = $X->root; # assumes only 1 screen
$xtops->{$_} = $X->InternAtom($_, 0) for qw(
    _NET_CLIENT_LIST
    _XCHAR_CHAR
    _XCHAR_COMMAND
);
$xtops->{$_} = $X->atom($_) for qw(
    _WIN_CLIENT_LIST
    _NET_ACTIVE_WINDOW
    _NET_CLIENT_LIST_STACKING
    WM_CLASS
    WM_NAME
    WM_ICON_NAME
    _NET_WM_ICON_GEOMETRY
    _NET_WM_ICON
    STRING
    WM_NORMAL_HINTS
    WM_SIZE_HINTS
);
$xtops->{$_} || croak("failed to create atom $_") for qw(
    _XCHAR_CHAR
    _XCHAR_COMMAND
);

# fetch the ID's taken from X11::Tops::fetch_ids()
my $_NET_CLIENT_LIST = $xtops->{_NET_CLIENT_LIST};
my ($value,$type,$format,$bytes_after) =
    $X->GetProperty($xtops->{root}, $_NET_CLIENT_LIST, @getpropconst);
my @ids = unpack('L*', $value);
print "Window IDs: @ids\n";

foreach my $id (@ids) {
    # Window class
    my $WM_CLASS = $xtops->{WM_CLASS};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_CLASS, @getpropconst);
        my ($instance,$class) = split("\0", $value);
        print "Window ID: $id\nInstance: $instance\nClass: $class\n";
    }

    # Get its title
    my $WM_NAME = $xtops->{WM_NAME};
    my $wintitle;
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_NAME, @getpropconst);
        print "Title: $value\n";
        $wintitle = $value;
    }

    # Icon title
    my $WM_ICON_NAME = $xtops->{WM_ICON_NAME};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON_NAME, @getpropconst);
        print "Icon name: $value\n";
    }

    # Get icon geometry
    my $WM_ICON_GEOMETRY = $xtops->{_NET_WM_ICON_GEOMETRY};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON_GEOMETRY, @getpropconst);
        print "Geometry: $value\n";
    }

    # Get its icon image
    my $WM_ICON = $xtops->{_NET_WM_ICON};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON, @getpropconst);
        print "Icon Length: " . length($value) . "\n\n";

        while (length $value > 0) {
            # First 2 bytes = width and height in pixels (16 00 00 00 = 22 pix)
            my @dimensions = ();
            for (0..1) {
                my $bin = substr($value, 0, 4);
                $value = substr($value, 4);
                my $size = unpack("L", $bin); # L = unsigned LONG, 32 bits
                push (@dimensions, $size);
            }

            my $dims = join("x", @dimensions);

            print "Icon Size: $dims\n";
            my ($w,$h) = @dimensions;

            # How many bytes will make up this icon? w*h*4 bytes
            my $datasize = $w * $h * 4; # 4 bytes for RGBA
            my $bin = substr($value, 0, $datasize);
            $value = substr($value, $datasize);

            # Construct a GD image for this dimension.
            my $img = Imager->new (xsize => $w, ysize => $h);
            $img->box(xmin => 0, xmax => $w, ymin => 0, ymax => $h, color => 'white');

            # Begin reading colors a pixel at a time (32 bits per pixel, RGBA).
            my ($x,$y) = (0,0);
            while (length $bin) {
                my $cardinal = substr($bin, 0, 4);
                $bin = substr($bin, 4);
                my ($red,$green,$blue,$alpha) = unpack("C4", $cardinal);
                print "PX $x,$y: $red:$green:$blue:$alpha\n";

                my $color = Imager::Color->new ($red, $green, $blue, $alpha);
                $img->setpixel(x => $x, 'y' => $y, color => $color);

                # Increment x/y counters.
                $x++;
                if ($x == $w) {
                    $x = 0;
                    $y++;
                }
                if ($y > $h) {
                    print "what? error!?\n";
                    last;
                }
            }

            # save the icon
            $wintitle =~ s/[^A-Za-z0-9 ]/_/g;
            my $file = "./$dims-$wintitle.png";
            print "## WRITE: $file ##\n";
            my $no = $img->write(file => $file);
            undef $img;
        }

        my @atoms = $X->ListProperties($id);
        my @names = map { $X->atom_name($_) } @atoms;
        print "props: @names\n";
        last;
    }
}

sub flip {
    my $number = shift;
    my $orig = $number;

    # flips $number (0-255) in reverse
    my $offset = 255 - $number;
    $number += $offset;
    return $number;
}

Kirsle.net | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'

 

[Kirsle]

Fixed the palette issue, and by adding channels=>4 to the Imager constructor it all looks much nicer.

Final proof of concept code:

    # Get its icon image
    my $WM_ICON = $xtops->{_NET_WM_ICON};
    {
        my ($value,$type,$format,$bytes_after) = $X->GetProperty($id, $WM_ICON, @getpropconst);
        print "Icon Length: " . length($value) . "\n\n";

        while (length $value > 0) {
            # First 2 bytes = width and height in pixels (16 00 00 00 = 22 pix)
            my @dimensions = ();
            for (0..1) {
                my $bin = substr($value, 0, 4);
                $value = substr($value, 4);
                my $size = unpack("L", $bin); # L = unsigned LONG, 32 bits
                push (@dimensions, $size);
            }

            my $dims = join("x", @dimensions);

            print "Icon Size: $dims\n";
            my ($w,$h) = @dimensions;

            # How many bytes will make up this icon? w*h*4 bytes
            my $datasize = $w * $h * 4; # 4 bytes for RGBA
            if ($w > 128) { # skip big icons
                $value = substr($value, $datasize);
                next;
            }
            my $bin = substr($value, 0, $datasize);
            $value = substr($value, $datasize);

            # Construct a GD image for this dimension.
            my $img = Imager->new (xsize => $w, ysize => $h, channels => 4);
            $img->box(xmin => 0, xmax => $w, ymin => 0, ymax => $h, color => 'white');

            # Begin reading colors a pixel at a time (32 bits per pixel, RGBA).
            my ($x,$y) = (0,0);
            while (length $bin) {
                my $cardinal = substr($bin, 0, 4);
                $bin = substr($bin, 4);
                my ($blue,$green,$red,$alpha) = unpack("C4", $cardinal);
            #    print "PX $x,$y: $red:$green:$blue:$alpha\n";

                my $color = Imager::Color->new ($red, $green, $blue, $alpha);
                $img->setpixel(x => $x, 'y' => $y, color => $color);

                # Increment x/y counters.
                $x++;
                if ($x == $w) {
                    $x = 0;
                    $y++;
                }
                if ($y > $h) {
                    print "what? error!?\n";
                    last;
                }
            }

            # save the icon
            $wintitle =~ s/[^A-Za-z0-9 ]/_/g;
            my $file = "./$dims-$wintitle.png";
            print "## WRITE: $file ##\n";
            my $no = $img->write(file => $file);
            undef $img;
        }

        my @atoms = $X->ListProperties($id);
        my @names = map { $X->atom_name($_) } @atoms;
        print "props: @names\n";
        last;
    }

Kirsle.net | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'