add contrib/expose.pl

1 files changed, 282 insertions, 0 deletions

diff --git a/contrib/expose.pl b/contrib/expose.pl
new file mode 100644
index 0000000..7f0600b
--- /dev/null
+++ b/contrib/expose.pl
@@ -0,0 +1,282 @@
+#!/usr/bin/perl
+# Maintainer: Trent Buck <[EMAIL PROTECTED]>
+# License: Public Domain
+
+# Changelog:
+#  2003-11-16 cantsin	rpshowall.sh
+#  2003-11-19 various	Misc. fixes to rpshowall
+#  2003-11-20 twb	expose.pl
+#  2003-11-20 cantsin	minor changes
+#  2003-11-22 twb	new algorithm, broke script
+#  2004-05-21 bkhl	posted on wiki
+#  2004-06-22 twb	full rewrite, changelog started
+#  2004-06-24 twb	release candidate
+#  2004-07-07 twb	toggle logic for fselect (line 43)
+#  2005-07-05 ivan	updated for the new fdump format (works with 1.4.0-beta4)
+
+# Description:
+#  Duplicates OS-X 10.3's Expose' functionality for ratpoison.
+#  You should apply the TWBPatch or reverse the logic at line 43.
+
+#-- tweaking -------------------------------------------------------------------
+
+require "assert.pl";  #used for validation.
+use strict;
+my $N_LIMIT = 2;
+my $LIMIT = 0.01; #smaller number --> slower, but more accurate
+my $RATPOISON = 'ratpoison';
+
+#-- main -----------------------------------------------------------------------
+
+#&th_ratio (1400, 1050, 23);
+#&th_split (\&split, 5, (0, 0, 1400, 1050));
+
+# my $id = &xid2num(8388638);
+# print "'$id'\n";
+# exit 0;
+
+my @xids = &rp('windows %i'); chomp @xids;
+my $n = @xids; #@ in $ context evals to length of @.
+my $frames_old = &rp('fdump'); chomp $frames_old;
+my @r; # Sub-optimal way of grabbing screen x,y,w,h.
+
+#fixed to use sdump
+($_, $r[0], $r[1], $r[2], $r[3]) = split(/ /,&rp ('sdump'));
+
+my $ret = join(", ", &rp_split(\@xids, \&split, $n, \@r));
+
+&rp("frestore $ret");
+
+$ret = &rpi('fselect');
+
+&rp('only');
+
+#-- subroutines ----------------------------------------------------------------
+
+#-- rp-specific --------------------------------------------
+
+sub rp  { return `$RATPOISON    -c "@_"`; }
+sub rpi { return `$RATPOISON -i -c "@_"`; }
+
+sub rpb {
+    my @accum = ();
+    for (@_)
+    {
+        push @accum, "-c \"$_\"";
+    }
+    return `$RATPOISON @accum`;
+}
+
+sub rp_split
+{
+    # Prints partitions in :fdump format.
+    my ($xids, $alg, $n, $r) = @_;
+    my @ret = ();
+    my $num = 0;
+    my $i;
+
+    foreach $i (&$alg($n, @$r))
+    {
+        my ($x, $y, $w, $h) = @$i;
+        my $xid = pop(@$xids);
+        push @ret, "(frame :number $num :x $x :y $y :width $w :height $h :window $xid)";
+        $num++;
+    }
+    return @ret;
+}
+
+
+# sub frame2xid {
+#     my ($fnum) = @_;
+#     my ($frame, $num, $xid);
+#     foreach $frame ( split(/,/, &rp('sfdump')) )
+#     {
+# 	($num, $_, $_, $_, $_, $xid) = split(/ /, $frame);
+# 	if ($num eq $fnum)
+# 	{
+# 	    chomp $xid;
+# 	    return $xid;
+# 	}
+#     }
+#     return -1;			# canthappen
+# }
+
+# sub xid2num {
+#     my ($xid) = @_;
+#     my @windows = &rp('windows %i %n');
+#     my ($window, $id, $num);
+#     foreach $window ( @windows )
+#     {
+# 	($id, $num) = split(/ /, $window);
+# 	if ($id eq $xid)
+# 	{
+# 	    chomp $num;
+# 	    return $num;
+# 	}
+#     }
+#     return -1;			# canthappen
+# }
+
+
+#-- generic ------------------------------------------------
+
+
+sub isint { #from http://google.com/groups?selm=BECK.95Oct20135611%40visi5.qtp.ufl.edu
+    my $x = shift;
+    return 0 if ($x eq "");
+    my $sign ='^\s* [-+]? \s*';
+    my $int ='\d+ \s* $ ';
+    return ($x =~ /$sign $int/x) ? 1 : 0;
+}
+
+
+sub isnum { #from http://google.com/groups?selm=90ra0g%24u0m%241%40nnrp1.deja.com
+    my $x = shift;
+    return ($x eq $x+0) ? 1:0;
+}
+
+sub ratio {
+    my ($t, $n) = @_;
+    my $ret = 1;
+    my $i;
+    &assert(&isnum($t) and &isint($n) and $n >= 0);
+
+    for $i ( 2 .. $n )
+    {
+        if ( &isint($n / $i) # $j must also be an integer.
+             and abs(($i**2 / $n) - $t) < abs(($ret**2 / $n) - $t) )
+        {
+            $ret = $i;
+        }
+    }
+    #Third return value is `error', used by split().
+    return ( $ret, $n / $ret, abs(($ret**2 / $n) - $t));
+}
+
+sub hsplit ($@) {
+    my ($n, $rx, $ry, $rw, $rh) = @_;
+    my @ret = ();
+    my $i;
+    &assert(isint($n) and $n >= 0);
+    &assert(isint($rx) and isint($ry) and isint($rw) and isint($rh));
+    &assert($rx>=0 and $ry>=0 and $rw>0 and $rh>0);
+    &assert($rw >= $n);
+
+    # remove remainder from rw, add to the last rectangle.
+    my $rem = $rw % $n;
+    $rw -= $rem;
+    &assert(0 == $rw % $n);
+
+    for $i (1 .. $n)
+    {
+        push @ret, [ ($rx + ($i-1)*$rw/$n,
+                      $ry,
+                      $rw/$n + ($i==$n?$rem:0),
+                      $rh) ];
+    }
+    return @ret;
+}
+
+sub vsplit ($@) {
+    my ($n, $rx, $ry, $rw, $rh) = @_;
+    my @ret = ();
+    my $i;
+    &assert(isint($n) and $n >= 0);
+    &assert(isint($rx) and isint($ry) and isint($rw) and isint($rh));
+    &assert($rx>=0 and $ry>=0 and $rw>0 and $rh>0);
+    &assert($rh >= $n);
+
+    # remove remainder from rh, add to the last rectangle.
+    my $rem = $rh % $n;
+    $rh -= $rem;
+    &assert(0 == $rh % $n);
+
+    for $i (1 .. $n)
+    {
+        push @ret, [ ($rx,
+                      $ry + ($i-1)*$rh/$n,
+                      $rw,
+                      $rh/$n + ($i==$n?$rem:0)) ];
+    }
+    return @ret;
+}
+
+sub boxsplit ($@) {
+    my ($n, $rx, $ry, $rw, $rh) = @_;
+    my @ret = ();
+    my ($rows, $cols) = &ratio($rw/$rh, $n);
+    my $i;
+    &assert(isint($n) and $n >= 0);
+    &assert(isint($rx) and isint($ry) and isint($rw) and isint($rh));
+    &assert($rx>=0 and $ry>=0 and $rw>0 and $rh>0);
+    &assert(($rh * $rw) >= $n);
+
+    foreach $i (&vsplit($rows, ($rx, $ry, $rw, $rh)))
+    {
+        @ret = (@ret, &hsplit($cols, @$i));
+    }
+    return @ret;
+}
+
+sub split ($@) {
+    my ($n, $rx, $ry, $rw, $rh) = @_;
+    my ($rows, $cols, $prox) = &ratio($rw/$rh, $n);
+
+    # if base case, palm off to boxsplit()
+    if ($n < $N_LIMIT or $prox < $LIMIT)
+    {
+        return &boxsplit($n, $rx, $ry, $rw, $rh);
+    }
+    else
+    {
+        my @ret = ();
+        my $nA = int($n/2); #fixme: int() is bad.  Use POSIX::floor?
+        my $x = $nA / ($n - $nA);
+        my $i;
+        &assert(isint($n) and $n >= 0);
+        &assert(isint($rx) and isint($ry) and isint($rw) and isint($rh));
+        &assert($rx>=0 and $ry>=0 and $rw>0 and $rh>0);
+        &assert(($rh * $rw) >= $n);
+
+        if ($rw > $rh) # Divide the larger dimension
+        {
+            my $k = int($rw * $x / (1 + $x)); #fixme: bad int().
+            @ret = (@ret, &split($nA,      ($rx,    $ry, $k,     $rh)));
+            @ret = (@ret, &split($n - $nA, ($rx+$k, $ry, $rw-$k, $rh)));
+        }
+        else
+        {
+            my $k = int($rh * $x / (1 + $x)); #fixme: bad int().
+            @ret = (@ret, &split($nA,      ($rx, $ry,    $rw, $k    )));
+            @ret = (@ret, &split($n - $nA, ($rx, $ry+$k, $rw, $rh-$k)));
+        }
+        return @ret;
+    }
+}
+
+#-- test harnesses -------------------------------------------------------------
+
+# Commented out to speed up compilation.
+
+# sub th_ratio
+# {
+#     my ($num, $denom, $n) = @_;
+#     my ($row, $col, $prox) = &ratio ($num / $denom, $n);
+#     print "$n = $row * $col, proximity $prox\n";
+# }
+
+# sub th_split
+# {   # Prints partitions as a SVG.  See inkscape.org for info.
+#     my ($alg, $n, @r) = @_;
+#     my $i;
+
+#     print "<svg width=\"$r[2]\" height=\"$r[3]\">\n";
+#     foreach $i (&$alg($n, @r))
+#     {
+#       my ($x, $y, $w, $h) = @$i;
+#       print "<rect x=\"$x\"\ty=\"$y\"\twidth=\"$w\"\theight=\"$h\"",
+#             " style=\"fill:white;stroke:black;\"/>\n";
+#     }
+#     print "</svg>\n";
+# }
+