All pastes #1760716 Raw Edit

Miscellany

public text v1 · immutable
#1760716 ·published 2010-01-21 21:25 UTC
rendered paste body
#!/usr/bin/perl

# Load pragmas
use strict;
use warnings;

# Load modules
use Data::Dump qw ( pp );
use X11::Protocol;

# Autoflush STDOUT
$|++;

# Avoid globals
__PACKAGE__ -> new -> main;

sub new
	{
	my $Class = shift;
	
	my $Self = bless {}, $Class;
	$Self -> init;
	
	return $Self;
	}

sub init
	{
	print 'Initialising', "\n";
	my $Self = shift;
	
	my $X = X11::Protocol -> new or die;
	$Self->{X} = $X;
	
	$X -> event_handler ( 'queue' );
	
	my $Root = $X -> root;
	my $Mask = $X -> pack_event_mask ( 'SubstructureRedirect' );
	$X -> ChangeWindowAttributes	(	$Root,
										event_mask	=> $Mask
									);
	
	$Self->{Handlers} =	{	MapRequest	=> \&handler_maprequest,
							UnmapNotify	=> \&handler_unmapnotify,
						};
	
	#~ my $GC = $X -> new_rsrc;
	#~ $X -> CreateGC ( $GC, $Root, foreground => $X -> white_pixel );
	#~ $X -> PolyLine ( $Root, $GC, 'Origin', 0, 0, 300, 300 );
	
	return $Self;
	}

sub main
	{
	print 'Entering main loop', "\n";
	my $Self = shift;
	
	my $X = $Self->{X};
	my $Handlers = $Self->{Handlers};
	
	while ( 1 )
		{
		my %Event = $X -> next_event;
		
		my $Name = $Event{name};
		if ( exists $Handlers->{ $Name } )
			{
			print 'Running handler for event: ', $Name, "\n";
			
			my $Handler = $Handlers->{ $Name };
			$Handler -> ( $Self, \%Event );
			}
		else
			{ print '[ERROR] Unhandled event: ', $Name, "\n"; }	
		}
	
	return $Self;
	}

###########
# HANDLER #
###########

sub handler_maprequest
	{
	my $Self = shift;
	my $Event = shift;
	
	my $X = $Self->{X};
	my $Window = $Event->{window};
	
	my $Mask = $X -> pack_event_mask ( 'StructureNotify' );
	$X -> ChangeWindowAttributes	(	$Window,
										event_mask	=> $Mask
									);
	
	my $Root = $X -> root;
	my %Geometry = $X -> GetGeometry ( $Root );
	
	$X -> ConfigureWindow	(	$Window,
								width	=> $Geometry{width},
								height	=> $Geometry{height},
								x		=> 0,
								y		=> 0
							);
	$X -> MapWindow ( $Window );
	
	return $Self;
	}

sub handler_unmapnotify
	{
	my $Self = shift;
	my $Event = shift;
	
	my $X = $Self->{X};
	my $Window = $Event->{window};
	
	eval	{
			# There must be a better way to avoid this dying when an
			# UnmapNotify event is generated on an already destroyed
			# window :-\
			
			$X -> UnmapWindow ( $Window );
			} or warn 'Unmapping caused error ( window already destroyed? )';
	
	return $Self;
	}