summaryrefslogtreecommitdiff
path: root/util/skingen.pl
blob: 8d9f3b4e49303b43dba3aad831eab307d05e63f8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
#!/usr/bin/perl

use v5.12;
use warnings;
use Cwd 'abs_path';

our($ROOT, %S);
BEGIN { ($ROOT = abs_path $0) =~ s{/util/skingen\.pl$}{}; }

use lib "$ROOT/lib";
use SkinFile;


my $iconcss = do {
  open my $F, '<', "$ROOT/data/icons/icons.css" or die $!;
  local $/=undef;
  <$F>;
};


sub imgsize {
  open my $IMG, '<', $_[0] or die $!;
  sysread $IMG, my $buf, 1024 or die $!;
  $buf =~ /\xFF\xC0...(....)/s ? unpack('nn', $1) : $buf =~ /IHDR(.{8})/s ? unpack('NN', $1) : die;
}


sub rdcolor {
  length $_[0] == 4 ? map hex($_)/15,  $_[0] =~ /#(.)(.)(.)/ : #RGB
  length $_[0] == 7 ? map hex($_)/255, $_[0] =~ /#(..)(..)(..)/ : #RRGGBB
  length $_[0] == 9 ? map hex($_)/255, $_[0] =~ /#(..)(..)(..)(..)/ : #RRGGBBAA
  die;
}


sub blend {
  my($f, $b) = @_;
  my @f = rdcolor $f;
  my @b = rdcolor $b;
  $f[3] //= 1;
  sprintf '#%02x%02x%02x',
    ($f[0] * $f[3] + $b[0] * (1 - $f[3]))*255,
    ($f[1] * $f[3] + $b[1] * (1 - $f[3]))*255,
    ($f[2] * $f[3] + $b[2] * (1 - $f[3]))*255;
}

sub mtime($) { [stat("$ROOT/static$_[0]")]->[9] }


sub writeskin { # $name
  my $name = shift;
  my $skin = SkinFile->new("$ROOT/static/s", $name);
  my %o = map +($_ => $skin->get($_)), $skin->get;
  $o{iconcss} = $iconcss;

  # get the right top image
  if($o{imgrighttop}) {
    my $path = "/s/$name/$o{imgrighttop}";
    my($h, $w) = imgsize "$ROOT/static$path";
    $o{_bgright} = sprintf 'background: url(%s?%s) no-repeat; width: %dpx; height: %dpx', $path, mtime $path, $w, $h;
  } else {
    $o{_bgright} = 'display: none';
  }

  # body background
  if($o{imglefttop}) {
    my $path = "/s/$name/$o{imglefttop}";
    $o{_bodybg} = sprintf 'background: %s url(%s?%s) no-repeat', $o{bodybg}, $path, mtime $path;
  } else {
    $o{_bodybg} = sprintf 'background-color: %s', $o{bodybg};
  }

  # boxbg blended with bodybg
  $o{_blendbg} = blend $o{boxbg}, $o{bodybg};

  # version
  $o{icons_version} = mtime '/f/icons.png';

  # write the CSS
  open my $CSS, '<', "$ROOT/data/style.css" or die $!;
  local $/=undef;
  my $css = <$CSS>;
  close $CSS;

  my $f = "$ROOT/static/s/$name/style.css";
  open my $SKIN, '>', "$f~" or die $!;
  print $SKIN $css =~ s{\$([a-z_]+)\$}{$o{$1} // die "Unknown variable $1"}egr;
  close $SKIN;

  rename "$f~", $f;
}


if(@ARGV) {
  writeskin($_) for (@ARGV);
} else {
  writeskin($_) for (SkinFile->new("$ROOT/static/s")->list);
}