[radeonhd] ptkxrandr: Perl/Tk wrapper around xrandr

5 Dec 2007

      Hi,

there seems to be no GUI application with working RandR 1.2 support. So 
I sat down and wrote this little Perl/Tk wrapper around xrandr. On my 
Lenovo T60 with Fedora 8 I bound it via KDE input action to the Fn-F7 
key (keycode: XF86Display). Voilá: nice and easy display selection :-)

Please make sure that you modify the script to point to the location of 
a xrandr binary with the latest fixes from git. If the script should 
happen to barf on the xrandr output for your setup then please reply to 
this mail and attach the output from "xrandr --verbose -q".

To quote from the script header:

THIS SCRIPT COMES WITH ABSOLUTELY NO WARRANTEE. USE AT YOUR OWN RISK!
It does what I need it to do. If it works for you too then enjoy it :-)

Regards,

	Stefan

---
Stefan Becker
E-Mail: Stefan.Becker@nokia.com

#!/usr/bin/perl -w
#
# THIS SCRIPT COMES WITH ABSOLUTELY NO WARRANTEE. USE AT YOUR OWN RISK!
#
# It does what I need it to do. If it works for you too then enjoy it :-)
#
use 5.008;
use strict;
use warnings;
use File::Slurp qw(slurp);
use Tk;

#----------------------> MODIFY FOR YOUR SETUP <----------------------
# NOTE: point to a xrandr binary that includes the latest fixes, i.e.
#       at least commit 20c8a60950cb5b4ddef305dc9822bec1c33e938c
#use constant XRANDR => "/usr/bin/xrandr";
use constant XRANDR => "$ENV{HOME}/laptop/xrandr/xrandr";
#---------------------------------------------------------------------

###############################################################################
#
# Parse xrandr output
#
###############################################################################
sub _AddMode($$) {
  my($modes, $new) = @_;

  # No new mode found
  return(1) unless defined $new;

  # Sanity checks
  my $id = $new->{id};
  print(STDERR "Duplicate mode '$id' found!\n"), return
    if exists $modes->{modes}->{$id};
  print(STDERR "No refresh rate found for mode $new->{resolution}!\n"), return
    unless defined $new->{refresh};

  # Add mode
  $modes->{modes}->{$id} = "$new->{resolution} @ $new->{refresh}";
  $modes->{current}      = $id if $new->{current};
  $modes->{preferred}    = $id if $new->{preferred};
  return(1);
}

# Parse one output section
sub _ParseModes($) {
  my($input) = @_;
  my $modes  = {};

  # Scan for modes
  my $modesfound;
  my $currentmode;
 LINE:
  foreach my $line (split("\n", $input)) {

    # Currently processing a mode?
    if ($currentmode) {

      # Additional mode information?
      if (my($type, $clock) = ($line =~ /^\s+([hv]):\s.+\s+clock\s+(\d+\.\d+\w+)/)) {
	$currentmode->{refresh} = $clock if ($type eq "v");
	next LINE;
      }

      # No. Current mode is complete.
      return unless _AddMode($modes, $currentmode);
      undef $currentmode;
    }

    # Start of new mode?
    if (my($resolution, $id, $remainder) =
	($line =~ /^\s+(\d+x\d+)\s+\(([^\)]+)\)\s*(.+)/)) {

      # Yes
      $currentmode = {
		      id         => $id,
		      resolution => $resolution,
		      current    => ($remainder =~ /\*current/)   ? 1 : 0,
		      preferred  => ($remainder =~ /\+preferred/) ? 1 : 0
		     };
      $modesfound++;

    # There should not be anything after the last mode
    } elsif ($modesfound) {
      print STDERR "Expected new mode, got '$line'!\n";
      return;
    }
  }

  # Complete last mode
  return unless _AddMode($modes, $currentmode);

  # Return all modes for this output
  return($modes);
}

# Parse one screen section
sub _ParseScreen($) {
  my($input)  = @_;
  my $outputs;

  # Split output sections
  my @matches;
  if ((@matches = ($input =~ /\G^(\S+)\s+(\S+)\s+[^\n]+\n((?:\s+[^\n]+\n)+)/gm)) &&
      (@matches % 3 == 0)) {

    # For each output
  OUTPUT:
    while (my($output, $state, $config) = splice(@matches, 0, 3)) {

      # Output without modes are valid
      $outputs->{$output} = undef;

      # Only parse information for outputs with connected display
      if ($state eq "connected") {
	if (my $modes = _ParseModes($config)) {
	  $outputs->{$output} = $modes;
	  next OUTPUT;
	}
	print STDERR "Can't parse output '$output'!\n";
	return;
      }
    }
  }
  return($outputs);
}

# Parse complete xrandr output
sub _ParsexrandrOutput($) {
  my($input)  = @_;
  my $screens;

  # Split screen sections
  my @matches;
  if ((@matches = ($input =~ /\G^Screen (\d+):.*\n((?:[^\n]+\n)*)(?=(?:Screen \d+|$))/gm)) &&
      (@matches % 2 == 0)) {

    # For each screen
  SCREEN:
    while (my($screen, $config) = splice(@matches, 0, 2)) {
      if (my $outputs = _ParseScreen($config)) {
	$screens->[$screen] = $outputs;
	next SCREEN;
      }
      print STDERR "Can't parse outputs for screen $screen!\n";
      return;
    }
  }
  return($screens);
}

sub _TestParser() {
  # Additional modules for testing
  require Data::Compare;
  require Data::Dumper;

  # Load test data
  my $testdata = eval slurp(\*DATA);
  die "Invalid test data: $@\n" if $@;

  # Run each test
  my $tests;
  foreach my $test (@{$testdata}) {
    my $result = _ParsexrandrOutput($test->{output});
    die "Parse error for '$test->{name}'!\n" unless defined $result;
    unless (Data::Compare::Compare($test->{result}, $result)) {
      print STDERR "Parse difference for '$test->{name}'!\n\n";
      print STDERR "xrandr output:\n$test->{output}\n";
      print STDERR Data::Dumper->Dump([$test->{result}], ['EXPECTED']), "\n";
      print STDERR Data::Dumper->Dump([$result],         ['GOT     ']), "\n";
      exit 1;
    }
    $tests++;
  }

  # All tests completed
  die "No tests defined!\n" unless $tests;
  print "$tests test(s) PASSED\n";
  exit 0;
}

###############################################################################
#
# xrandr command handling
#
###############################################################################
# Query current display setup with xrandr
sub QueryDisplaySetup() {
  my $result;

  # Run xrandr query
  if (open(my $fh, "-|", XRANDR, qw(-q --verbose))) {

    # Parse output
    $result = _ParsexrandrOutput(slurp($fh));
    print(STDERR "xrandr query failed: $!\n"), return unless close($fh);
  } else {
    print STDERR "Can't execute " . XRANDR . ": $!\n";
  }
  return($result);
}

sub _Testxrandr() {
  # Additional modules for testing
  require Data::Dumper;

  # Run test
  exit 1 unless (my $setup = QueryDisplaySetup());
  print Data::Dumper->Dump([$setup], ['result']);
  print "Test PASSED\n";
  exit 0;
}

###############################################################################
#
# Test steps
#
###############################################################################
_TestParser() if (@ARGV && ($ARGV[0] eq "--test-parser"));
_Testxrandr() if (@ARGV && ($ARGV[0] eq "--test-xrandr"));

###############################################################################
#
# Perl TK stuff
#
###############################################################################
my @OffButtons;
my $ActiveOutputs = 0;

sub UpdateOffButtons() {
  my($state) = ($ActiveOutputs <= 1) ? "disabled" : "normal";
  $_->configure(-state => $state) foreach (@OffButtons);
}

sub SetOutputMode($$$$) {
  my($window, $output, $modes, $ref) = @_;
  my $id                             = ${ $ref };
  my $disable                        = $id eq "off";
  my $wasactive                      = $modes->{current};

  # Call xrandr
  if (system(XRANDR, '--verbose',
	     '--output', $output,
	     $disable ? qw(--off) : ('--mode', $id)) == 0) {

    # Update output count
    $ActiveOutputs++ unless ($wasactive || $disable);
    $ActiveOutputs-- if     ($wasactive && $disable);
    UpdateOffButtons();

    # Remember new current output
    $modes->{current} = $disable ? undef : $id;

  } else {

    # Failure
    $window->bell();
    ${ $ref } = $wasactive ? $wasactive : "off";
  }
}

sub SetupModesUI($$) {
  my($window, $container) = @_;

  # Get current setup
  my $setup = QueryDisplaySetup();

  # FIXME: we only support screen 0
  return unless (my $screen = $setup->[0]);

  # For each output on this screen
  foreach my $output (sort keys %{ $screen }) {

    # Skip outputs without valid modes
    next unless my $modes = $screen->{$output};

    # Add frame for output
    my $frame = $container->Labelframe(
				       -text => $output,
				       -padx => 2,
				       -pady => 2
				      )->pack(-fill => 'x');

    # Add modes
    my $selected = $modes->{current} || "off";
    my $callback = sub { SetOutputMode($window, $output, $modes, \$selected); };
    foreach my $mode (sort keys %{ $modes->{modes} }) {
      $frame->Radiobutton(
			  -text       => $modes->{modes}->{$mode},
			  -value      => $mode,
			  -variable   => \$selected,
			  ($modes->{preferred} && ($modes->{preferred} eq $mode)) ? (-background => "green") : (),
			  -command    => $callback
			  )->pack(-anchor => 'w');
    }
    my $off = $frame->Radiobutton(
			  -text     => "disable",
			  -value    => "off",
			  -variable => \$selected,
			  -command  => $callback
			  )->pack(-anchor => 'w');
    push(@OffButtons, $off);

    # Is output active?
    $ActiveOutputs++ if $modes->{current};
  }
  $container->pack(-side => "top", -fill => 'both');

  # Update Off button status
  UpdateOffButtons();

  # Resize window
  $window->update();
  $window->maxsize($window->width(), $window->height());
  $window->minsize($window->width(), $window->height());

  # Center window around current pointer position
  my($mx, $my) = $window->pointerxy();
  if (($mx != -1) && ($my != -1)) {
    $window->geometry("+" . int($mx - $window->width() / 2) .
		      "+" . int($my - $window->width() / 2));
  }
}

###############################################################################
#
# Main program
#
###############################################################################
# Create main window
my $mw = MainWindow->new;
SetupModesUI($mw, $mw->Frame());
MainLoop;

# That's all folks...
exit 0;

__DATA__
# "xrandr -q --verbose" output for parser testing
[
 {
  name   => 'Lenovo T60 - panel only',
  output => <<'END_OF_OUTPUT',
Screen 0: minimum 320 x 200, current 1400 x 1050, maximum 1400 x 1400
VGA_1 disconnected (normal)
        Identifier: 0x43
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     PANEL DVI-D_1
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 1 (0x00000001)
        RANDR_CONNECTOR_NUMBER: 1 (0x00000001)
                RANDR_CONNECTOR_TYPE: VGA
                RANDR_SIGNAL_FORMAT: VGA
PANEL connected 1400x1050+0+0 (0x46) normal (normal) 287mm x 215mm
        Identifier: 0x44
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     VGA_1 DVI-D_1
        CRTC:       0
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 2 (0x00000002)
        RANDR_CONNECTOR_NUMBER: 2 (0x00000002)
                RANDR_CONNECTOR_TYPE: LVDS
                RANDR_SIGNAL_FORMAT: LVDS
  1400x1050 (0x46)  108.0MHz *current +preferred
        h: width  1400 start 1448 end 1560 total 1688 skew    0 clock   64.0KHz
        v: height 1050 start 1053 end 1054 total 1066           clock   60.0Hz
DVI-D_1 disconnected (normal)
        Identifier: 0x45
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     VGA_1 PANEL
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 3 (0x00000003)
        RANDR_CONNECTOR_NUMBER: 3 (0x00000003)
                RANDR_CONNECTOR_TYPE: DVI
                RANDR_SIGNAL_FORMAT: TMDS
END_OF_OUTPUT
  result => [
	     {
	      VGA_1     => undef,
	      PANEL     => {
			    modes     => {
					  '0x46' => '1400x1050 @ 60.0Hz'
					 },
			    current   => '0x46',
			    preferred => '0x46'
			   },
	      'DVI-D_1' => undef
	     }
	    ]
 },
 {
  name   => 'Lenovo T60 - panel & Infocus LP540 projector on VGA',
  output => <<'END_OF_OUTPUT',
Screen 0: minimum 320 x 200, current 1400 x 1050, maximum 1400 x 1400
VGA_1 connected (normal)
        Identifier: 0x43
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     PANEL DVI-D_1
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 1 (0x00000001)
        RANDR_CONNECTOR_NUMBER: 1 (0x00000001)
                RANDR_CONNECTOR_TYPE: VGA
                RANDR_SIGNAL_FORMAT: VGA
  1360x768 (0x50)   84.8MHz -HSync +VSync
        h: width  1360 start 1432 end 1568 total 1776 skew    0 clock   47.7KHz
        v: height  768 start  771 end  781 total  798           clock   59.8Hz
  1360x768 (0x51)   72.0MHz +HSync -VSync
        h: width  1360 start 1408 end 1440 total 1520 skew    0 clock   47.4KHz
        v: height  768 start  771 end  781 total  790           clock   60.0Hz
  1280x800 (0x52)   83.5MHz -HSync +VSync
        h: width  1280 start 1344 end 1480 total 1680 skew    0 clock   49.7KHz
        v: height  800 start  801 end  804 total  828           clock   60.0Hz
  1152x864 (0x53)   81.6MHz -HSync +VSync
        h: width  1152 start 1216 end 1336 total 1520 skew    0 clock   53.7KHz
        v: height  864 start  865 end  868 total  895           clock   60.0Hz
  1280x768 (0x54)   80.1MHz -HSync +VSync
        h: width  1280 start 1344 end 1480 total 1680 skew    0 clock   47.7KHz
        v: height  768 start  769 end  772 total  795           clock   60.0Hz
  1280x720 (0x55)   74.5MHz -HSync +VSync
        h: width  1280 start 1336 end 1472 total 1664 skew    0 clock   44.8KHz
        v: height  720 start  721 end  724 total  746           clock   60.0Hz
  1024x768 (0x56)   65.0MHz -HSync -VSync
        h: width  1024 start 1048 end 1184 total 1344 skew    0 clock   48.4KHz
        v: height  768 start  771 end  777 total  806           clock   60.0Hz
  800x600 (0x57)   40.0MHz +HSync +VSync
        h: width   800 start  840 end  968 total 1056 skew    0 clock   37.9KHz
        v: height  600 start  601 end  605 total  628           clock   60.3Hz
  640x480 (0x58)   25.2MHz -HSync -VSync
        h: width   640 start  656 end  752 total  800 skew    0 clock   31.5KHz
        v: height  480 start  490 end  492 total  525           clock   59.9Hz
PANEL connected 1400x1050+0+0 (0x46) normal (normal) 287mm x 215mm
        Identifier: 0x44
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     VGA_1 DVI-D_1
        CRTC:       0
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 2 (0x00000002)
        RANDR_CONNECTOR_NUMBER: 2 (0x00000002)
                RANDR_CONNECTOR_TYPE: LVDS
                RANDR_SIGNAL_FORMAT: LVDS
  1400x1050 (0x46)  108.0MHz *current +preferred
        h: width  1400 start 1448 end 1560 total 1688 skew    0 clock   64.0KHz
        v: height 1050 start 1053 end 1054 total 1066           clock   60.0Hz
DVI-D_1 disconnected (normal)
        Identifier: 0x45
        Timestamp:  -1899175926
        Subpixel:   unknown
        Clones:     VGA_1 PANEL
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 3 (0x00000003)
        RANDR_CONNECTOR_NUMBER: 3 (0x00000003)
                RANDR_CONNECTOR_TYPE: DVI
                RANDR_SIGNAL_FORMAT: TMDS
END_OF_OUTPUT
  result => [
	     {
	      VGA_1     => {
			    modes     => {
					  '0x50' => "1360x768 @ 59.8Hz",
					  '0x51' => "1360x768 @ 60.0Hz",
					  '0x52' => "1280x800 @ 60.0Hz",
					  '0x53' => "1152x864 @ 60.0Hz",
					  '0x54' => "1280x768 @ 60.0Hz",
					  '0x55' => "1280x720 @ 60.0Hz",
					  '0x56' => "1024x768 @ 60.0Hz",
					  '0x57' => "800x600 @ 60.3Hz",
					  '0x58' => "640x480 @ 59.9Hz"
					 }
			   },
	      PANEL     => {
			    modes     => {
					  '0x46' => '1400x1050 @ 60.0Hz'
					 },
			    current   => '0x46',
			    preferred => '0x46'
			   },
	      'DVI-D_1' => undef
	     }
	    ]
 },
 {
  name   => 'Lenove T60 - panel & Samsung DLP (off) on DVI-I',
  output => <<'END_OF_OUTPUT',
Screen 0: minimum 320 x 200, current 1400 x 1050, maximum 1400 x 1400
VGA_1 disconnected (normal)
        Identifier: 0x43
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     PANEL DVI-D_1
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 1 (0x00000001)
        RANDR_CONNECTOR_NUMBER: 1 (0x00000001)
                RANDR_CONNECTOR_TYPE: VGA
                RANDR_SIGNAL_FORMAT: VGA
PANEL connected 1400x1050+0+0 (0x46) normal (normal) 287mm x 215mm
        Identifier: 0x44
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     VGA_1 DVI-D_1
        CRTC:       0
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 2 (0x00000002)
        RANDR_CONNECTOR_NUMBER: 2 (0x00000002)
                RANDR_CONNECTOR_TYPE: LVDS
                RANDR_SIGNAL_FORMAT: LVDS
  1400x1050 (0x46)  108.0MHz *current +preferred
        h: width  1400 start 1448 end 1560 total 1688 skew    0 clock   64.0KHz
        v: height 1050 start 1053 end 1054 total 1066           clock   60.0Hz
DVI-D_1 connected (normal)
        Identifier: 0x45
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     VGA_1 PANEL
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 3 (0x00000003)
        RANDR_CONNECTOR_NUMBER: 3 (0x00000003)
                RANDR_CONNECTOR_TYPE: TMDS
                RANDR_SIGNAL_FORMAT: TMDS
  1280x720 (0x59)   74.2MHz +HSync +VSync
        h: width  1280 start 1390 end 1430 total 1650 skew    0 clock   45.0KHz
        v: height  720 start  725 end  730 total  750           clock   60.0Hz
  640x480 (0x5a)   25.2MHz -HSync -VSync
        h: width   640 start  656 end  752 total  800 skew    0 clock   31.5KHz
        v: height  480 start  490 end  492 total  525           clock   60.0Hz
END_OF_OUTPUT
  result => [
 	     {
 	      VGA_1     => undef,
	      PANEL     => {
			    modes     => {
					  '0x46' => '1400x1050 @ 60.0Hz'
					 },
			    current   => '0x46',
			    preferred => '0x46'
			   },
 	      'DVI-D_1' => {
			    modes     => {
					  '0x59' => '1280x720 @ 60.0Hz',
					  '0x5a' => '640x480 @ 60.0Hz'
					 }
			   }
 	     }
 	    ]
 },
 {
  name   => 'Lenove T60 - panel & Samsung DLP (active) on DVI-I',
  output => <<'END_OF_OUTPUT',
Screen 0: minimum 320 x 200, current 1400 x 1050, maximum 1400 x 1400
VGA_1 disconnected (normal)
        Identifier: 0x43
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     PANEL DVI-D_1
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 1 (0x00000001)
        RANDR_CONNECTOR_NUMBER: 1 (0x00000001)
                RANDR_CONNECTOR_TYPE: VGA
                RANDR_SIGNAL_FORMAT: VGA
PANEL connected 1400x1050+0+0 (0x46) normal (normal) 287mm x 215mm
        Identifier: 0x44
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     VGA_1 DVI-D_1
        CRTC:       0
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 2 (0x00000002)
        RANDR_CONNECTOR_NUMBER: 2 (0x00000002)
                RANDR_CONNECTOR_TYPE: LVDS
                RANDR_SIGNAL_FORMAT: LVDS
  1400x1050 (0x46)  108.0MHz *current +preferred
        h: width  1400 start 1448 end 1560 total 1688 skew    0 clock   64.0KHz
        v: height 1050 start 1053 end 1054 total 1066           clock   60.0Hz
DVI-D_1 connected 1280x720+0+0 (0x59) normal (normal) 1289mm x 725mm
        Identifier: 0x45
        Timestamp:  -1877708877
        Subpixel:   unknown
        Clones:     VGA_1 PANEL
        CRTC:       1
        CRTCs:      0 1
        RANDR_OUTPUT_NUMBER: 3 (0x00000003)
        RANDR_CONNECTOR_NUMBER: 3 (0x00000003)
                RANDR_CONNECTOR_TYPE: TMDS
                RANDR_SIGNAL_FORMAT: TMDS
  1280x720 (0x59)   74.2MHz +HSync +VSync *current
        h: width  1280 start 1390 end 1430 total 1650 skew    0 clock   45.0KHz
        v: height  720 start  725 end  730 total  750           clock   60.0Hz
  640x480 (0x5a)   25.2MHz -HSync -VSync
        h: width   640 start  656 end  752 total  800 skew    0 clock   31.5KHz
        v: height  480 start  490 end  492 total  525           clock   60.0Hz
END_OF_OUTPUT
  result => [
 	     {
 	      VGA_1     => undef,
	      PANEL     => {
			    modes     => {
					  '0x46' => '1400x1050 @ 60.0Hz'
					 },
			    current   => '0x46',
			    preferred => '0x46'
			   },
 	      'DVI-D_1' => {
			    modes     => {
					  '0x59' => '1280x720 @ 60.0Hz',
					  '0x5a' => '640x480 @ 60.0Hz'
					 },
			    current   => '0x59',
			   }
 	     }
 	    ]
 },
# {
#  name   => 'NAME OF TEST',
#  output => <<'END_OF_OUTPUT',
#END_OF_OUTPUT
#  result => [
#	    ]
# },
];