mirror of https://gitlab.com/meliurwen/dotfiles
parent
a95daa2e7d
commit
7bf1441867
@ -0,0 +1,192 @@ |
||||
#!/usr/bin/perl |
||||
# vim:ft=perl:fenc=utf-8:tw=80 |
||||
# Copyright (c) 2009-, Simon Lundström <simmel@soy.se> |
||||
# Copyright (c) 2014 Maarten de Vries <maarten@de-vri.es> |
||||
# |
||||
# Permission to use, copy, modify, and/or distribute this software for any |
||||
# purpose with or without fee is hereby granted, provided that the above |
||||
# copyright notice and this permission notice appear in all copies. |
||||
# |
||||
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES |
||||
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF |
||||
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR |
||||
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES |
||||
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN |
||||
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
||||
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
||||
|
||||
|
||||
my @fonts = ( |
||||
{'name' => 'font', 'code' => 710}, |
||||
{'name' => 'boldFont', 'code' => 711}, |
||||
{'name' => 'italicFont', 'code' => 712}, |
||||
{'name' => 'boldItalicFont', 'code' => 713}, |
||||
); |
||||
|
||||
my @fixed = qw(4x6 5x7 5x8 6x9 6x10 6x12 6x13 7x13 7x14 8x13 8x16 9x15 9x18 |
||||
10x20 12x24); |
||||
my $step; |
||||
|
||||
sub on_start { |
||||
my ($self) = @_; |
||||
|
||||
foreach (@fonts) { |
||||
$_->{'default'} = $self->resource($_->{'name'}); |
||||
} |
||||
|
||||
$step = $self->x_resource("%.step") || 2; |
||||
} |
||||
|
||||
sub on_init { |
||||
my ($self) = @_; |
||||
my $commands = { |
||||
"smaller" => "C-minus", |
||||
"bigger" => "C-plus", |
||||
"reset" => "C-equal", |
||||
"show" => "C-question", |
||||
}; |
||||
bind_hotkeys($self, $commands); |
||||
|
||||
() |
||||
} |
||||
|
||||
sub bind_hotkeys { |
||||
my ($self, $commands) = @_; |
||||
|
||||
for (keys %$commands) { |
||||
my $hotkey = $$commands{$_}; |
||||
my $hotkey_bound = $self->{'term'}->x_resource("keysym.$hotkey"); |
||||
if (!defined($hotkey_bound) ) { |
||||
# Support old-style key bindings |
||||
if ($self->x_resource("%.$_")) { |
||||
$hotkey = $self->x_resource("%.$_"); |
||||
} |
||||
|
||||
# FIXME If we're bound to a keysym, don't bind the default. |
||||
$self->bind_action($hotkey, "%:$_") or |
||||
warn "unable to register '$hotkey' as hotkey for $_"; |
||||
} |
||||
else { |
||||
if ($hotkey_bound !~ /^resize-font:/) { |
||||
warn "Hotkey $$commands{$_} already bound to $hotkey_bound, not ". |
||||
"binding to resize-font:$_ by default."; |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
sub on_action { |
||||
my ($self, $string) = @_; |
||||
|
||||
if ($string eq "bigger") { |
||||
foreach (@fonts) { |
||||
next if not defined($_->{'default'}); |
||||
update_font_size($self, $_, +$step); |
||||
} |
||||
} |
||||
elsif ($string eq "smaller") { |
||||
foreach (@fonts) { |
||||
next if not defined($_->{'default'}); |
||||
update_font_size($self, $_, -$step); |
||||
} |
||||
} |
||||
elsif ($string eq "reset") { |
||||
foreach (@fonts) { |
||||
next if not defined($_->{'default'}); |
||||
set_font($self, $_, $_->{'default'}); |
||||
} |
||||
} |
||||
elsif ($string eq "show") { |
||||
|
||||
my $term = $self->{'term'}; |
||||
$term->{'resize-font'}{'overlay'} = { |
||||
ov => $term->overlay_simple(0, -1, format_font_info($self)), |
||||
to => urxvt::timer |
||||
->new |
||||
->start(urxvt::NOW + 1) |
||||
->cb(sub { |
||||
delete $term->{'resize-font'}{'overlay'}; |
||||
}), |
||||
}; |
||||
} |
||||
|
||||
() |
||||
} |
||||
|
||||
sub get_font { |
||||
my ($self, $name) = @_; |
||||
return $self->resource($name); |
||||
} |
||||
|
||||
sub set_font { |
||||
my ($self, $font, $new) = @_; |
||||
$self->cmd_parse(sprintf("\33]%d;%s\007", $font->{'code'}, $new)); |
||||
} |
||||
|
||||
sub round { |
||||
return sprintf("%.0f", @_); |
||||
} |
||||
|
||||
sub atleast { |
||||
my ($min, $val) = @_; |
||||
if (0 < abs $val && abs $val < $min){ |
||||
return $val / abs($val) |
||||
} |
||||
return $val; |
||||
} |
||||
|
||||
sub update_font_size { |
||||
my ($self, $font, $delta) = @_; |
||||
my $regex = qr"(?<=size=)(\d+(?:\.\d+)?)"; |
||||
my $current = get_font($self, $font->{'name'}); |
||||
|
||||
my ($index) = grep { $fixed[$_] eq $current } 0..$#fixed; |
||||
if ($index or $index eq 0) { |
||||
my $inc = $delta / abs($delta); |
||||
$index += $inc; |
||||
if ($index < 0) { $index = 0; } |
||||
if ($index > $#fixed) { $index = $#fixed; } |
||||
$current = $fixed[$index]; |
||||
} |
||||
elsif ($current =~ /^-/) { |
||||
my @font = split(/-/, $current); |
||||
# https://en.wikipedia.org/wiki/X_logical_font_description |
||||
#Pixel size |
||||
if ($font[7] gt 0) { |
||||
$delta = atleast(1, $delta); |
||||
my $newsize = round($font[7]+$delta); |
||||
$font[7] = $newsize if ($newsize > 0) |
||||
} |
||||
#Point size |
||||
elsif ($font[8] gt 0) { |
||||
$delta = atleast(1, $delta*10); |
||||
my $newsize = round($font[8]+$delta); |
||||
$font[8] = $newsize if ($newsize > 0) |
||||
} |
||||
$current = join('-', @font); |
||||
} |
||||
else { |
||||
my $newsize = $1+$delta if ($current =~ /$regex/); |
||||
$current =~ s/$regex/$newsize/ge if ($newsize > 0); |
||||
} |
||||
set_font($self, $font, $current); |
||||
} |
||||
|
||||
sub format_font_info { |
||||
my ($self) = @_; |
||||
|
||||
my $width = 0; |
||||
foreach (@fonts) { |
||||
my $length = length($_->{'name'}); |
||||
$width = $length > $width ? $length : $width; |
||||
} |
||||
++$width; |
||||
|
||||
my $info = ''; |
||||
foreach (@fonts) { |
||||
$info .= sprintf("%-${width}s %s\n", $_->{'name'} . ':', |
||||
get_font($self, $_->{'name'})); |
||||
} |
||||
|
||||
return $info; |
||||
} |
Loading…
Reference in new issue