#!/usr/bin/env perl

use strict;

# On-the-fly urxvt font resizing.  Like ⌘{+,-}, on mac computers, just
# way more complicated.
#
# Noah K. Tilton <noahktilton@gmail.com>
#
# What it does:
#
# 1) Emits escape sequences to change the font size in the running console;
# 2) Persists the changed font size to xresources file.
#
# Note: the regexes will only work on xft xrdb entries
#   For this script to work, ~/.Xdefauls should probably contain at
#   least the following:
#
#       urxvt*font
#       urxvt*boldFont
#       urxvt*boldColors: on
#
# References: man 3 urxvtperl
#
#  Debugging:   urxvt --perl-lib ${HOME}/.urxvt -pe font 


use constant X_RESOURCES => "~/.Xresources";

sub _resize_xft_string
{
  my ($self, $key, $delta)  = @_;
  my (@pieces)              = split /:/, $self->{term}->resource($key);
  my (@resized)             = ();
  foreach my $piece (@pieces)
  { 
    if ($piece =~ /pixelsize=(\d*)/)
    {
      my ($size)        =  $1;
      my ($new_size)    =  $size + $delta;
      if ($new_size < 1)
      {
        $new_size = 1;
      }
      $piece            =~ s/pixelsize=$size/pixelsize=$new_size/;
    }
    push @resized, $piece;
  } 
  join (":", @resized);
}

sub change_size
{
  my ($self, $delta) = @_;

  # Get xft strings with font size {+/-}1
  my ($font_resized)        = $self->_resize_xft_string(     "font", $delta);
  my ($font_resized_bold)   = $self->_resize_xft_string( "boldFont", $delta);

  # Update internal urxvt resource hash
  #     This is necessary or else the next resize won't have an updated
  #     value. "font" key is updated by urxvt when cmd_parse is called,
  #     but boldFont is *not*, at least with the escape sequences I'm
  #     emitting.
  $self->{term}->resource("font",       $font_resized);
  $self->{term}->resource("boldFont",   $font_resized_bold);

  # Emit escape sequence to change fonts in rxvt runtime
  $self->{term}->cmd_parse("\033]50;" . $font_resized . "\007");

  # Persist the changes to xrdb
  system("xrdb -load " . X_RESOURCES);
  open(XRDB_MERGE, "| xrdb -merge") || die "can't fork: $!";
  local $SIG{PIPE} = sub { die "xrdb pipe broke" };
  print XRDB_MERGE "urxvt\*font:        $font_resized\n"
                 . "urxvt\*boldFont:    $font_resized_bold\n";
  close XRDB_MERGE || die "bad xrdb: $! $?";
  system("xrdb -edit " . X_RESOURCES);
}

sub on_user_command
{
  # This function is called whenever some urxvt.keysym.*: perl:x:y
  # mapped in X_RESOURCES is called; where x is this "module" (file,
  # translation unit...), y is some function in this file (and this
  # function, if defined), and $cmd is the argument z.
  #
  my ($self, $cmd) = @_;

  if ($cmd =~ /font:(..crement)/)   # {in, de, ex}
  {
    $self->change_size(($1 eq "increment") ? +1 : -1);
  }
}