snips/dwltags.pl

#!/usr/bin/env perl

use strict;
use warnings;
use Data::Dumper;
use Term::ANSIColor;
use FileHandle;
use Getopt::Long;

my $info = {};
my $tags_file = $ENV{'DWL_TAGS_FILE'};

my @mons = map { /^([\w-]+)/; $1 } grep { /^([\w-]+)/ } `wlr-randr`;

GetOptions("file=s" => \$tags_file)
    or die("Command line usage error");

# Color scheme is only used in ANSI mode
# <class>_f/_g: class is used in JSON mode to be used in style.css for styling
my $colorscheme = {
    'norm_f' => '#ffffff',
    'norm_b' => '#111111',
    'sel_f' => '#ffffff',
    'sel_b' => '#aa4444',
    'mon_f' => '#000000',
    'mon_b' => '#777777',
    'lay_f' => '#111111',
    'lay_b' => '#77aaaa',
    'title_f' => '#ffcccc',
    'title_b' => '#111111'
    # 'norm_f' => 'white',
    # 'norm_b' => 'black',
    # 'sel_f' => 'black',
    # 'sel_b' => 'red',
    # 'mon_f' => 'black',
    # 'mon_b' => 'grey23',
    # 'lay_f' => 'black',
    # 'lay_b' => 'cyan',
    # 'title_f' => 'red',
    # 'title_b' => 'black'
};

print_log("DWLTAGS: $tags_file");

for my $mon (@mons) {
    print_tags({
            'selmon' => '1',
            'mon' => $mon,
            'tags' => '1 1',
            'title' => '',
            'layout' => '[]='
        }, $tags_file . "." . $mon);
}

while (<>) {
    my $line = $_;
    chomp $line;

    # print_log("DWLTAGS [VV] : $line");

    if (my ($mon, $key, $val) = $line =~ /^(\S+)\s+(\S+)\s(.*)$/) {
        $info->{$key} = $val;
        if ($key eq "layout") {
            # Commit a status
            # Assumption: layout is the last piece of information dumped by DWL
            $info->{'mon'} = $mon;
            print_tags($info, $tags_file.".".$mon);

            $info = {};
        }
    } else {
        print_log("DWL: Printed out of format - $line");
    }
}

sub print_tags {
    my ($info, $tags_file) = @_;
    my $numtags = 10;

    return if ($info->{'selmon'} ne "1");

    if (my ($tuse, $tsel) = $info->{'tags'} =~ /(\d+)\s+(\d+)/) {
        my $tags = "";

        for (my $i = 0; $i < $numtags; $i++) {
            my $sel = "norm";
            if (($tuse & (1 << $i))) {
                if ($tsel & (1 << $i)) {
                    $sel = "sel";
                }
                $tags .= getformatted($sel, " ". ($i+1) . " ");
            }
        }

        if (exists $ENV{'DWLTAGS_SHOW_MON'}) {
            $tags .= getformatted("mon", " $info->{'mon'} ");
        }

        $tags .= getformatted("lay", " $info->{'layout'} ");
        $tags .= getformatted("title", " $info->{'title'} ");

        my $fh = FileHandle->new("> " . $tags_file);
        if (defined $fh) {
            print $fh $tags . "\n";
            $fh->close;
        }
    } else {
        print_log("DWL: Printed out of format - tags");
    }
}

sub getformatted {
    my ($c, $txt) = @_;

    if ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "DZEN")) {
        return dzen_colored($c, $txt);
    } elsif ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "ANSI")) {
        return colored([$colorscheme->{$c . '_f'} . " on_" . $colorscheme->{$c . '_b'}], $txt);
    } elsif ((exists $ENV{'DWLTAGS_FMT'}) && ($ENV{'DWLTAGS_FMT'} eq "JSON")) {
        return '{"text": "' . $txt . '", "class": "dwltags-' . $c . '"}';
    } else {
        if ($c eq "sel") {
            $txt =~ s/\s+//g;
            $txt = "[$txt]";
        }
        return $txt;
    }
}

sub dzen_colored {
    my ($class, $txt) = @_;
    my $fc = $colorscheme->{$class . '_f'};
    my $bc = $colorscheme->{$class . '_b'};
    # return colored([$colorscheme->{$c . '_f'} . " on_" . $colorscheme->{$c . '_b'}], $txt);
    return "^fg(" . $fc . ")^bg(" . $bc . ")" . $txt . "^fg()^bg()";
}

sub print_log {
    my ($line) = @_;
    my $fh = FileHandle->new(">> " . $ENV{'DWL_LOG_FILE'});
    if (defined $fh) {
        print $fh $line . "\n";
        $fh->close;
    }
}