dotfiles/urxvt/.urxvt/ext/resize-font

#!/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;
}