#!/usr/bin/perl
#
# Create config to enable some popular monitor configurations
#
# Copyright (c) 2017 Eduard Bloch
# License: Simplified BSD License
#
#use Data::Dumper;

use strict;

my $curmon;
my $primary;
my @connected;
my $disabled;
my @active;

my $readedid;
my $curedid;

# monitor name mapping, either from cache or built from EDID info later
my %realname;

# sysfs data lookup disabled for now because of not being reliable.
# With Nouveau, some -A token is added to sysfs names.
# With Radeon, the enumeration is not mapped correctly, like this:
# $ ls /sys/devices/pci0000:00/0000:00:02.0/0000:01:00.0/drm/card0/*-* -d
# /sys/devices/pci0000:00/0000:00:02.0/0000:01:00.0/drm/card0/card0-DP-1     /sys/devices/pci0000:00/0000:00:02.0/0000:01:00.0/drm/card0/card0-HDMI-A-1
# /sys/devices/pci0000:00/0000:00:02.0/0000:01:00.0/drm/card0/card0-DVI-D-1
# $ xrandr | grep conne
# DisplayPort-0 disconnected primary (normal left inverted right x axis y axis)
# HDMI-A-0 disconnected (normal left inverted right x axis y axis)
# DVI-D-0 connected 1280x1024+0+0 (normal left inverted right x axis y axis) 376mm x 301mm
# 
#my $useSysfs=0;

my $xrandr = "xrandr";

sub get_contents {
        my $filename = shift;
        open my $fh, '<', $filename or return "";
        my $data = do { local $/; <$fh> };
        return $data;
}

# content cache
my $cacheFingerprint = "";
my $cacheDir = $ENV{XDG_CACHE_HOME} ? $ENV{XDG_CACHE_HOME} : $ENV{HOME}."/.cache";
mkdir $cacheDir if ! -e $cacheDir;
$cacheDir.="/icewm";
mkdir $cacheDir if ! -e $cacheDir;
my $cachePath = "$cacheDir/xrandrmenu.cache";

# start of the EDID descriptor which contains the display name
my $header = chr(0).chr(0xfc).chr(0);
my $end = chr(0x0a);
my @edids = sort(<"/sys/devices/*/*/*/drm/card*/card*-*/edid">, <"/sys/devices/*/*/drm/card*/card*-*/edid">);

## Unfortunately unreliable!
##
## if($useSysfs)
## {
##         # xrandr --verbose can be slow, grab data from sysfs if possible
##         # Unclear how to map X screens to DRM reliably, use the shortcut only
##         # when just one graphics card is installed.
##         if($#edids == 0)
##         {
##                 foreach(<"$edidGlobPat">)
##                 {
##                         my $data = get_contents($_);
##                         next if !$data;
##                         my $hdump;
##                         /card0.card0-([^\/]+)\/edid/;
##                         my $connector = $1;
##                         #$hdump = unpack("H*", $data);
##                         #$realname{$connector} = pack("H*", $1) if($hdump =~ /00fc00(.*?)0a/)
##                         #
##                         # digging through descriptors, https://en.wikipedia.org/wiki/Extended_Display_Identification_Data
##                         my $pos = index $data, $header, 54;
##                         if($pos>0)
##                         {
##                                 $data = substr $data, $pos+3, 15;
##                                 # sanitize first or further RE fail on binary cruft
##                                 $data =~ s/\W/ /g;
##                                 $data =~ s/ *$|^\W*//g;
##                                 #print "# sysfs name: $data\n";
##                                 $realname{$connector} = $data.'~'.$connector;
##                         }
##                 }
##         }
## }
## else
{
        foreach(@edids)
        {
                my $more = get_contents($_);
                next if ! $more;
                $more =~ s/\W/_/g; # should be sufficient, and faster than hashing
                $cacheFingerprint.= $_.$more
        }
        if($cacheFingerprint)
        {
                my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                        $atime,$mtime,$ctime,$blksize,$blocks) = stat(__FILE__);
                $cacheFingerprint.="$atime$mtime$ctime$size$dev$ino\n";
                my $fd;
                if(open($fd, "<", $cachePath))
                {
                        my $hit = 0;
                        my @temp;
                        while(<$fd>)
                        {
                                if (!$hit)
                                {
                                        $hit = ($_ eq $cacheFingerprint) ;
                                        last if !$hit;
                                        next;
                                }
                                chomp;
                                push @temp, $_;
                        }
                        %realname = @temp;
                }
        }
}

my $fishEdid = !%realname;
$xrandr.=" --verbose" if $fishEdid;

# the disconnected displays might become zombies... make sure to turn them off
my $turnRestOff ="";

for(`$xrandr`)
{
	my $resFound =/(\d+x\d+\++\d)/;
        if(/^(\S+)\s+(connected|disconnected)\s+(primary)?/)
        {
                $curmon = $1;
                $primary = $curmon if $3;
		# print "# heh? $1 - $2 - $3 - $4\n";
		# disconnected and also no active resolution set!
                $disabled = ($2 eq "disconnected") && !$resFound;
                if($disabled)
                {
                        #$turnRestOff.=" --display $curmon --off";
                }
                else
                {
                        push(@connected, $curmon);
                }
        }
        # detect active only when there is a flag in the resolution list...
        push(@active, $curmon) if(/^\s.*\*/ && !$disabled);
        if($fishEdid)
        {
                # another bit of interest is the EDID stuff, while we are at it...
                if(/EDID:/)
                {
                        $readedid = 1;
                        $curedid = "";
                }
                elsif(!/:/)
                {
                        if($readedid)
                        {
                                /(\w+)/;
                                $curedid.=$1;
                        }
                }
                else
                {
                        if($readedid)
                        {
                                $readedid = 0;
                                if($curedid =~ /00fc00(.*?)0a/)
                                {
                                        my $name=pack("H*", $1);
                                        # XXX: not sure about endian, check EDID spec
                                        #print "moo, $curedid is $1 for $curmon aka $name\n";
                                        $realname{$curmon} = $name.'~'.$curmon;
                                }
                        }
                }
        }
}

# has primary become disconnected? Just removed? Let the first one be primary then
$primary=$connected[0] if($primary && !grep(/$primary/, @connected));
print "# Next primary: $primary\n";

#print Dumper(\@active,\@connected,$primary, \%realname);

my $second;
# assuming that the primary is always among the connected screens...
# but prefer those which are already active
foreach(@active, @connected)
{
        next if $_ eq $primary;
        $second = $_;
        last;
}

my @notPrimary = grep {$_ ne $primary} @connected;
my @notPrimOrSec = grep {$_ ne $primary && $_ ne $second} @connected;
my $turnNonPrimSecOff = join(" ", map { "--output '$_' --off" } @notPrimOrSec);

sub getName {
        my $id = shift;
        return $realname{$id} if exists $realname{$id};
        
        # uber-clever xrandr hides the bustype prefix if the name is unambiguous but the kernel doesn't, so try to find the real name there
        foreach("A", "D", "I")
        {
                my $altName = $id;
                return $realname{$altName} if($altName =~ s/-(\d)/-A-$1/ && exists $realname{$altName});
        }
        return $id;
}

# single head activation
my $i=1;
foreach my $mon ($primary, @notPrimary)
{
        my $cmd = "prog '". getName($mon)."' setscreen$i sh -c 'xrandr ".
        join(" ", map { "--output $_ ".($_ eq $mon ? "--auto --primary" : "--off") } @connected)
        ."$turnRestOff'\n";
        print $cmd;

        $i++;
}

exit 0 if 1 == @connected;

# predefined multihead setups
my $cmd = "prog '".getName($primary)." + ".getName($second)."' setscreen12 sh -c 'xrandr --output $primary --auto --output $second --auto --right-of $primary $turnNonPrimSecOff $turnRestOff'\n";
print $cmd;

my $cmd = "prog '".getName($second)." + ".getName($primary)."' setscreen21 sh -c 'xrandr --output $primary --auto --output $second --auto --left-of $primary $turnNonPrimSecOff $turnRestOff'\n";
print $cmd;

my $cmd = "prog '".getName($primary)." + ".getName($second)."*' setscreen12x sh -c 'xrandr --output $primary --auto --output $second --primary --auto --right-of $primary $turnNonPrimSecOff $turnRestOff'\n";
print $cmd;

my $cmd = "prog '".join(" / ", map { getName($_) } @connected)."' setscreen_all sh -c 'xrandr "
.join(" ", map { "--output $_ --auto ".( $_ eq $primary ? "" : "--same-as $primary")} @connected)
."$turnRestOff'\n";
print $cmd;

my $prev="";
my $cmd = "# all monitors connected from left to right\nprog '"
.join(" + ", map { getName($_) } @connected)."' setscreen_chain sh -c 'xrandr";
for(@connected)
{
        $cmd.=" --output $_ --auto";
        $cmd.=" --right-of $prev" if $prev;
        $prev=$_;
}
$cmd.="$turnRestOff'\n";
print $cmd;

#print Dumper(%realname);
my $fd;
if(open($fd, ">", $cachePath))
{
        print $fd $cacheFingerprint;
        print $fd "$_\n$realname{$_}\n" foreach(keys %realname);
        close $fd;
}
