citadel

My dotfiles, scripts and nix configs
git clone git://jb55.com/citadel
Log | Files | Refs | README | LICENSE

resize-font (4527B)

      1 # #!/usr/bin/env perl
      2 # vim:ft=perl:fenc=utf-8:tw=80
      3 # Copyright (c) 2009-, Simon Lundström <simmel@soy.se>
      4 # Copyright (c) 2014 Maarten de Vries <maarten@de-vri.es>
      5 #
      6 # Permission to use, copy, modify, and/or distribute this software for any
      7 # purpose with or without fee is hereby granted, provided that the above
      8 # copyright notice and this permission notice appear in all copies.
      9 #
     10 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
     11 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
     12 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
     13 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
     14 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
     15 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
     16 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
     17 
     18 
     19 my @fonts = (
     20   {'name' => 'font',           'code' => 710},
     21   {'name' => 'boldFont',       'code' => 711},
     22   {'name' => 'italicFont',     'code' => 712},
     23   {'name' => 'boldItalicFont', 'code' => 713},
     24 );
     25 
     26 my @fixed = qw(4x6 5x7 5x8 6x9 6x10 6x12 6x13 7x13 7x14 8x13 8x16 9x15 9x18
     27                10x20 12x24);
     28 my $step;
     29 
     30 sub on_start {
     31   my ($self) = @_;
     32 
     33   foreach (@fonts) {
     34     $_->{'default'} = $self->resource($_->{'name'});
     35   }
     36 
     37   $step = $self->x_resource("%.step") || 2;
     38 }
     39 
     40 sub on_init {
     41    my ($self) = @_;
     42    my $commands = {
     43      "smaller" => "C-minus",
     44      "bigger"  => "C-plus",
     45      "reset"   => "C-equal",
     46      "show"    => "C-question",
     47    };
     48    bind_hotkeys($self, $commands);
     49 
     50    ()
     51 }
     52 
     53 sub bind_hotkeys {
     54   my ($self, $commands) = @_;
     55 
     56   for (keys %$commands) {
     57     my $hotkey = $$commands{$_};
     58     my $hotkey_bound = $self->{'term'}->x_resource("keysym.$hotkey");
     59     if (!defined($hotkey_bound) ) {
     60       # Support old-style key bindings
     61       if ($self->x_resource("%.$_")) {
     62         $hotkey = $self->x_resource("%.$_");
     63       }
     64 
     65       # FIXME If we're bound to a keysym, don't bind the default.
     66       $self->bind_action($hotkey, "%:$_") or
     67       warn "unable to register '$hotkey' as hotkey for $_";
     68     }
     69     else {
     70       if ($hotkey_bound !~ /^resize-font:/) {
     71         warn "Hotkey $$commands{$_} already bound to $hotkey_bound, not ".
     72              "binding to resize-font:$_ by default.";
     73       }
     74     }
     75   }
     76 }
     77 
     78 sub on_action {
     79   my ($self, $string) = @_;
     80 
     81   if ($string eq "bigger") {
     82     foreach (@fonts) {
     83       next if not defined($_->{'default'});
     84       update_font_size($self, $_, +$step);
     85     }
     86   }
     87   elsif ($string eq "smaller") {
     88     foreach (@fonts) {
     89       next if not defined($_->{'default'});
     90       update_font_size($self, $_, -$step);
     91     }
     92   }
     93   elsif ($string eq "reset") {
     94     foreach (@fonts) {
     95       next if not defined($_->{'default'});
     96       set_font($self, $_, $_->{'default'});
     97     }
     98   }
     99   elsif ($string eq "show") {
    100 
    101     my $term = $self->{'term'};
    102     $term->{'resize-font'}{'overlay'} = {
    103       ov => $term->overlay_simple(0, -1, format_font_info($self)),
    104       to => urxvt::timer
    105       ->new
    106       ->start(urxvt::NOW + 1)
    107       ->cb(sub {
    108         delete $term->{'resize-font'}{'overlay'};
    109       }),
    110     };
    111   }
    112 
    113   ()
    114 }
    115 
    116 sub get_font {
    117   my ($self, $name) = @_;
    118   return $self->resource($name);
    119 }
    120 
    121 sub set_font {
    122   my ($self, $font, $new) = @_;
    123   $self->cmd_parse(sprintf("\33]%d;%s\007", $font->{'code'}, $new));
    124 }
    125 
    126 sub update_font_size {
    127   my ($self, $font, $delta) = @_;
    128   my $regex = qr"(?<=size=)(\d+)";
    129   my $current = get_font($self, $font->{'name'});
    130 
    131   my ($index) = grep { $fixed[$_] eq $current } 0..$#fixed;
    132   if ($index or $index eq 0) {
    133     my $inc = $delta / abs($delta);
    134     $index += $inc;
    135     if ($index < 0) { $index = 0; }
    136     if ($index > $#fixed) { $index = $#fixed; }
    137     $current = $fixed[$index];
    138   }
    139   elsif ($current =~ /^-/) {
    140     my @font = split(/-/, $current);
    141     # https://en.wikipedia.org/wiki/X_logical_font_description
    142     my $newsize = $font[7]+$delta;
    143     $font[7] = $newsize if ($newsize > 0);
    144     $current = join('-', @font);
    145   }
    146   else {
    147     my $newsize = $1+$delta if ($current =~ /$regex/);
    148     $current =~ s/$regex/$newsize/ge if ($newsize > 0);
    149   }
    150   set_font($self, $font, $current);
    151 }
    152 
    153 sub format_font_info {
    154   my ($self) = @_;
    155 
    156   my $width = 0;
    157   foreach (@fonts) {
    158     my $length = length($_->{'name'});
    159     $width = $length > $width ? $length : $width;
    160   }
    161   ++$width;
    162 
    163   my $info = '';
    164   foreach (@fonts) {
    165     $info .= sprintf("%-${width}s %s\n", $_->{'name'} . ':',
    166              get_font($self, $_->{'name'}));
    167   }
    168 
    169   return $info;
    170 }