diff options
Diffstat (limited to 'contrib')
| -rw-r--r-- | contrib/expose.pl | 282 |
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"; +# } + |