ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/doomfrontend/doomfrontend
Revision: 1.3
Committed: Mon Apr 17 12:32:17 2023 UTC (13 months, 3 weeks ago) by root
Branch: MAIN
Changes since 1.2: +4 -3 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 # todo hi cpu tie on fuji due to mpv runtime config
4
5 # mpv over ass-events
6 # {\blur0\bord0\1c&H000000\iclip(4, m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072)}{\alpha&H62&}{\pos(0.000000,0.000000)}{\p4} m 30000 6720 l 30480 6720 l 30480 7412 l 30396 7496 l 30480 7580 l 30480 10080 l 30000 10080 l 30000 7580 l 30084 7496 l 30000 7412 l 30000 6720{\p0}
7 # {\blur0\bord0\1c&Hffffff}{\alpha&H4C&}{\pos(0.000000,0.000000)}{\p4} m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072{\p0}
8 # {\blur0\bord0\shad0\1c&H000000\fnDroid Sans\fs27\clip(4, m 30472 10072 l 30008 10072 l 30008 7584 l 30093 7500 l 30388 7500 l 30472 7584 l 30472 10072)}{\alpha&H36&}{\pos(3780.000000,1248.000000)}{\an2}100
9 # {\blur0\bord1\shad0\1c&Hffffff\3c&H000000}{\alpha&H4C&}{\pos(0.000000,0.000000)}{\p4} m 30098 10262 l 30156 10262 l 30232 10194 l 30232 10446 l 30156 10379 l 30098 10379 m 30274 10270 l 30274 10371 l 30299 10371 l 30299 10270 m 30333 10220 l 30333 10421 l 30358 10421 l 30358 10220{\p0}
10
11
12 BEGIN {
13 if ($ARGV[0] eq "-=reloaded=-") {
14 shift;
15 } elsif (-e "/root/mlockall.so") {
16 $ENV{LD_PRELOAD} = "/root/mlockall.so:/root/libmimalloc.so.1.7";
17 $ENV{MIMALLOC_LARGE_OS_PAGES} = 1;
18 system "echo always >/sys/kernel/mm/transparent_hugepage/defrag";
19 system "echo 3 > /proc/sys/vm/drop_caches";
20 system "echo 1 > /proc/sys/vm/compact_memory";
21 exec "taskset", "-c", "12-15", "nice", "-n-20", "ionice", "-c1", $0, "-=reloaded=-", @ARGV;
22 exit 255;
23 }
24 }
25
26 use common::sense;
27
28 use EV;
29
30 use Fcntl ();
31 use Socket ();
32 use POSIX ();
33 use Cwd ();
34 use File::Glob ();
35 use Coro;
36 use File::Basename;
37 use AE ();
38 use CBOR::XS ();
39 use Compress::Zstd ();
40 use AnyEvent::AIO ();
41 use Coro::AIO;
42 use Coro::AnyEvent;
43 use JSON::XS ();
44 use AnyEvent::Handle ();
45 use AnyEvent::Socket ();
46 use Proc::FastSpawn ();
47 use PApp::SQL ();
48 use List::MoreUtils ();
49 use List::Util qw(min max);
50 use Text::Wrap ();
51 use Format::Human::Bytes ();
52 use AnyEvent::MPV ();
53
54 IO::AIO::min_parallel 16;
55
56 sub MAX_ISLANDS () { 5 }
57
58 sub enc($) {
59 my $s = shift;
60 utf8::encode $s;
61 $s
62 }
63
64 sub dec($) {
65 my $s = shift;
66 utf8::decode $s;
67 $s
68 }
69
70 our $NODENAME = (POSIX::uname)[1];
71 our $DOOM = $NODENAME eq "doom";
72
73 our $TESTING = $ARGV[0] eq "--testing";
74 #our $DPMS_DISABLE = $DOOM;
75
76 our ($SW, $SH) = (3840, 2160);
77 our $FONTSIZE = $NODENAME eq "doom" ? 32 : 18;
78 our $FONT = "xft:inputmonocondensed:minspace:medium:hintstyle=hintfull:matrix=1 0 0 0.95:size=$FONTSIZE";
79
80 # MUST be canonical, same as dfe
81 our $STATE_FILE = "/fs/doom/db/doomfrontend.state";
82 our $STATE_SHM = "/dev/shm/doomfrontend.state";
83 our @LIRC = ("unix/", "/run/lirc/lircd");
84 our $CONF_FILE = "/fs/doom/root/dfe.conf";
85 our $VIDEO_DIR = "/fs/doom/root/00_distant_worlds";
86 our $ARCHIVE_DIR = "/fs/doom/root/00_distant_worlds/00_archive"; # was /fs/doom/var/lib/mythvideo/02_ytd/00_distant_worlds/00_archive
87 our $MYTHTV_DIR = "/fs/doom/var/lib/mythtv";
88 our $MEDIAINFO = "/usr/bin/mediainfo";
89 our $MPV = "mpv";
90 our @MPV_ARGS = qw(
91 --audio-client-name=doomfrontend
92 --osd-on-seek=msg-bar --osd-bar-align-y=-0.85 --osd-bar-w=95
93 --screenshot-directory=/fs/doom/root --screenshot-template=screenshot-%F-%P
94 --sub-auto=exact --audio-file-auto=exact
95 );
96 our %SPONSOR_SKIP = (
97 "Sponsor" => 1,
98 "Intermission/Intro Animation" => 1,
99 "Interaction Reminder" => 1,
100 "Endcards/Credits" => 1,
101 "Unpaid/Self Promotion" => 1,
102 "Highlight" => 0,
103 "Preview/Recap" => 0,
104 "Non-Music Section" => 0,
105 "Filler Tangent" => 0,
106 "UNKNOWN<filler>" => 0,
107 );
108
109 our $KODIPATH = "/fs/doom/var/www/html/doomfrontend";
110 our $KODIURL = "http://10.0.0.5/doomfrontend/";
111
112 our $XRANDR_OUTPUT = "HDMI-0";
113 our $XRANDR_MODE = "3840x2160";
114 our $XRANDR_FPS = 60;
115 #our @XRANDR_RATES = ([60, 60], [59.94, 59.94], [50, 50], [29.97, 29.97], [25, 25], [23.98, 23.98]); # philips tv can't do 23.98fps
116 our @XRANDR_RATES = ([60, 60], [59.94, 59.94], [50, 50]);
117
118 our @EXTERNAL; # current external events, if any
119
120 our %STATE;
121
122 our $SS_LENGTH = 300;
123
124 #############################################################################
125
126 # prevent xscreensaver from doing something stupid, such as starting dbus
127 $ENV{DBUS_SESSION_BUS_ADDRESS} = "/"; # prevent dbus autostart for sure
128 $ENV{XDG_CURRENT_DESKTOP} = "generic";
129
130 if ($DOOM) {
131 unless (exists $ENV{XDG_RUNTIME_DIR}) {
132 $ENV{XDG_RUNTIME_DIR} = "/run/user/0";
133 mkdir $ENV{XDG_RUNTIME_DIR}, 0700;
134 }
135 }
136
137 #############################################################################
138
139 our $STATE_MTIME_TIMER;
140 our $STATE_MTIME;
141
142 our $STATE_FILE_TIMER;
143 our $STATE_SHM_TIMER;
144 our $STATE_DIRTY;
145 our $STATE_SAVER;
146
147 sub state_file_check;
148
149 sub state_init {
150 my $state_load = sub {
151 open my $fh, "<", $_[0]
152 or die "$_[0]: $@\n";
153
154 sysread $fh, my $buf, -s $fh;
155 *STATE = CBOR::XS::decode_cbor Compress::Zstd::decompress $buf;
156 };
157
158 eval { $state_load->($STATE_SHM); 1 }
159 or eval { $state_load->($STATE_FILE); 1}
160 or %STATE = ();
161
162 $STATE_MTIME = (stat $STATE_FILE)[9];
163
164 $STATE_MTIME_TIMER = AE::timer 15, 15, sub {
165 async {
166 state_file_check;
167 };
168 };
169 }
170
171 sub _state_save_shm {
172 undef $STATE_SHM_TIMER;
173
174 return; #d# must check which file is newer
175 return unless $DOOM;
176
177 if (open my $fh, ">", $STATE_SHM) {
178 syswrite $fh, $_[0];
179 }
180 }
181
182 sub _state_save {
183 return if $TESTING;
184
185 while ($STATE_DIRTY) {
186 undef $STATE_SHM_TIMER;
187
188 my $fh = aio_open "$STATE_FILE~", IO::AIO::O_CREAT | IO::AIO::O_WRONLY, 0600
189 or last;
190
191 undef $STATE_DIRTY;
192 last unless %STATE; # state not loaded - do not save
193
194 $STATE{last_save} = time;
195 my $data = Compress::Zstd::compress +(CBOR::XS::encode_cbor \%STATE), 3;
196 _state_save_shm $data;
197
198 aio_write $fh, undef, undef, $data, 0;
199 aio_fsync $fh;
200 my $new_mtime = (stat $fh)[9];
201 aio_close $fh;
202
203 state_file_check;
204
205 aio_rename "$STATE_FILE~", $STATE_FILE;
206 $STATE_MTIME = $new_mtime;
207 }
208 }
209
210 sub _state_saver {
211 $STATE_SAVER ||= async {
212 _state_save;
213 undef $STATE_SAVER;
214 undef $STATE_FILE_TIMER;
215 };
216 }
217
218 sub state_save {
219 $STATE_DIRTY = 1;
220 $STATE_FILE_TIMER ||= AE::timer 15, 0, sub {
221 _state_saver;
222 };
223 $STATE_SHM_TIMER ||= AE::timer 0.5, 0, sub {
224 _state_save_shm CBOR::XS::encode_cbor \%STATE;
225 };
226 }
227
228 sub state_cleanup {
229 _state_saver;
230 $STATE_SAVER->join;
231 }
232
233 our $SIGINT = AE::signal INT => sub { EV::unloop };
234 our $SIGTERM = AE::signal TERM => sub { EV::unloop };
235
236 #############################################################################
237 # screensaver reset management
238
239 system "xset", "s", $SS_LENGTH if $DOOM;
240
241 our $WAKEUP_TIMER;
242 our $WAKEUP_WANT;
243
244 sub wakeup {
245 if ($WAKEUP_TIMER) {
246 $WAKEUP_WANT = 1;
247 } else {
248 $WAKEUP_WANT = 0;
249 Proc::FastSpawn::spawn "/usr/bin/xset", ["xset", "s", "reset"];
250 $WAKEUP_TIMER = AE::timer $SS_LENGTH - 5, 0, sub {
251 undef $WAKEUP_TIMER;
252 wakeup () if $WAKEUP_WANT;
253 };
254 }
255 }
256
257
258 #############################################################################
259 # input queue
260
261 my $input_queue = new Coro::Channel;
262 our ($INPUT, $INPUTS, $INPUT_DATA);
263
264 sub input_context($) {
265 $INPUT = undef;
266
267 for (split /,/, $INPUTS) {
268 if (/(.*):(.*)/) {
269 $INPUT = $2 if $1 eq $_[0];
270 } else {
271 $INPUT = $_;
272 }
273 }
274
275 #warn "interpret<$INPUTS> as $_[0] gives <$INPUT>\n";
276 }
277
278 sub input_set($$) {
279 $INPUT = undef;
280 $INPUTS = $_[0];
281 $INPUT_DATA = $_[1];
282
283 input_context undef;
284 }
285
286 sub input_next(;$) {
287 _win_refresh ();
288 &input_set (@{ $input_queue->get });
289 input_context $_[0] if @_;
290 }
291
292 sub input_feed($;$) {
293 #use Data::Dump; ddx [input_feed => @_];#d#
294 $input_queue->put ([@_])
295 if defined $_[0];
296 }
297
298 my %input_feed_key_map = (
299 "\e" => "esc",
300
301 "\e[A" => "up",
302 "\e[B" => "down",
303 "\e[C" => "right",
304 "\e[D" => "left",
305 "\e[5~" => "pgup",
306 "\e[6~" => "pgdown",
307 "\r" => "enter",
308 "<" => "prev",
309 ">" => "next",
310 "d" => "red",
311 "i" => "green",
312 "r" => "return",
313 "m" => "popup",
314 (map { ($_, $_) } 0..9),
315 "." => "clear",
316 "]" => "stepfwd",
317 "[" => "steprev",
318 "p" => "play",
319 " " => "pause",
320 );
321
322 sub input_feed_key($) {
323 input_feed $input_feed_key_map{$_[0]};
324 }
325
326 sub external(@) {
327 push @EXTERNAL, [@_];
328 input_feed "external"; # sucks
329 }
330
331 #############################################################################
332 # lirc
333
334 async {
335 while () {
336 my $hdl = new AnyEvent::Handle
337 connect => \@LIRC,
338 on_error => Coro::rouse_cb,
339 on_read => sub {
340 $_[0]->push_read (line => sub {
341 $_[1] =~ /\S+ \S+ (\S+) \S+/
342 or return;
343 ::input_feed $1;
344 wakeup;
345 });
346 },
347 ;
348
349 my (undef, $fatal, $msg) = Coro::rouse_wait;
350
351 $hdl->destroy;
352
353 #warn $msg;
354 } continue {
355 Coro::AnyEvent::sleep 10;
356 }
357 };
358
359 #############################################################################
360 # mythmote
361
362 our %MYTHREMOTE = (
363 "play speed pause" => "pause",
364 "play speed normal" => "pause",
365 "play stop" => "stop",
366 "key i" => "green",
367 "key up" => "up",
368 "key down" => "down",
369 "key left" => "left",
370 "key right" => "right",
371 "key enter" => "enter",
372 "key escape" => "return",
373 "key m" => "popup",
374 "key r" => "red",
375
376 "key home" => "down",
377 "play seek backward" => "steprev",
378 "play seek forward" => "stepfwd",
379 "key end" => "up",
380
381 "key f2" => "red",
382 "key f3" => "green",
383 "key f4" => "yellow",
384 "key f5" => "blue",
385
386 #"key s" => up right
387 "play channel up" => "next",
388 "play channel down" => "prev",
389 "key h" => "play", # circle clock
390
391 "key ]" => "vol+",
392 "key |" => "mute",
393 "key [" => "vol-",
394
395 "key backspace" => "red",
396 (map { ("key $_" => "num$_") } 0..9),
397 );
398
399 our $mythremote = AnyEvent::Socket::tcp_server undef, 6546, sub {
400 my ($fh) = @_;
401
402 my $hdl; $hdl = new AnyEvent::Handle
403 fh => $fh,
404 on_error => sub {
405 #warn "mythremote error: $_[2]\n";
406 undef $hdl;
407 },
408 on_read => sub {
409 $_[0]->push_read (line => sub {
410 if (my $input = $MYTHREMOTE{$_[1]}) {
411 if ($input eq "vol+") {
412 Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1+"];
413 } elsif ($input eq "vol-") {
414 Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "1-"];
415 } elsif ($input eq "mute") {
416 Proc::FastSpawn::spawnp "/usr/bin/amixer", ["amixer", "sset", "Master", "toggle"];
417 }
418 ::input_feed $input;
419 } elsif ($_[1] =~ /external/) {
420 if (open my $fh, "<", "/root/doomfrontend.external") {
421 unlink "/root/doomfrontend.external";
422 sysread $fh, my $buf, -s $fh;
423 external @{ JSON::XS::decode_json $buf };
424 }
425 } else {
426 warn "unknown mythremote command: <$_[1]>\n";
427 }
428 ::wakeup;
429 });
430 },
431 ;
432 };
433
434 #############################################################################
435
436 my $mpv = AnyEvent::MPV->new (
437 mpv => $MPV,
438 args => \@MPV_ARGS,
439 trace => 1,
440 on_event => sub {
441 input_feed "mpv/$_[1]", $_[2];
442 },
443 on_key => sub {
444 input_feed $_[1];
445 },
446 on_eof => sub {
447 input_feed "mpv/quit";
448 },
449 );
450
451 #############################################################################
452 # rxvt
453
454 qx<xrandr --current> =~ / connected primary (\d+)x(\d+)\+/a
455 or qx<xrandr --current> =~ / connected (\d+)x(\d+)\+/a
456 or "3840x2160" =~ /^(\d+)x(\d+)\z/a; # rather than crash
457
458 ($SW, $SH) = ($1, $2);
459
460 our $WIN_BORDER = 0; # > 0 not works
461 our ($WIN_FW, $WIN_FH) = (60, 60);
462
463 our ($WIN, $WIN_SHOW, $WIN_W, $WIN_H, $WIN_TEXT);
464 our $WIN_TOW;
465
466 our $WIN_RW;
467
468 {
469 if (0) {
470 my $prop = qx<xprop -font \Q$FONT>;
471 $WIN_FW = $prop =~ /^AVERAGE_WIDTH = (\d+)0$/am ? $1 : die;
472 $WIN_FH = $prop =~ /^PIXEL_SIZE = (\d+)$/am ? $1 : die;
473 }
474 }
475
476 our @DISPLAY;
477 our @DISPLAYED;
478
479 our $WIN_DISPLAY_PREFIX;
480
481 our $WIN_READY = AE::cv;
482
483 sub __win_reset {
484 undef $WIN;
485 undef $WIN_RW;
486 @DISPLAYED = ();
487 undef $WIN_DISPLAY_PREFIX;
488 }
489
490 sub _win_refresh {
491 undef $WIN_TOW;
492
493 my $msg;
494
495 unless ($WIN) {
496 socketpair $WIN, my $slave, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC;
497 fcntl $slave, Fcntl::F_SETFD, 0;
498 system "exec rxvt -bg black -fg gray -perl-ext '' -perl-ext-common '' -sl 0 +sb"
499 . " -fn \Q$FONT\E -b $WIN_BORDER -name doomfrontend"
500 . " --pointerBlank --pointerBlankDelay 1"
501 . " -geometry 1x1-0-0 -bl -pty-fd " . (fileno $slave) . " &";
502 close $slave;
503
504 binmode $WIN, ":utf8";
505 $WIN->autoflush;
506
507 $WIN_RW = AE::io $WIN, 0, sub {
508 sysread $WIN, my $buf, 64
509 or exit 1;
510
511 # hacky parsing, but we expect only one reply
512 if ($buf =~ /^\x1b]776;([^\007]+)\007/) {
513 my @info = split /;/, $1;
514
515 $WIN_FW = $info[0];
516 $WIN_FH = $info[1];
517 $WIN_W = int $SW / $WIN_FW;
518 $WIN_H = int $SH / $WIN_FH;
519
520 my ($x, $y) = $WIN_SHOW
521 ? (($SW - $WIN_FW * $WIN_W) * 0.5, $WIN_BORDER * 2) # top
522 : ($SW + $WIN_BORDER, $SH - $WIN_BORDER);
523
524 # do resize first, to avoid resize followed by Xserver moving, and another resize
525 my $init = sprintf "\e[8;%d;%dt", $WIN_H, $WIN_W;
526 #$init .= sprintf "\e[3;%d;%dt", $x - $WIN_BORDER, $y - $WIN_BORDER * 2;
527 $init .= sprintf "\e[3;%d;%dt", 0, 0;
528
529 syswrite $WIN, $init;
530 select undef, undef, undef, 0.1;
531
532 @DISPLAYED = ();
533 goto &_win_refresh;
534 }
535
536 input_feed_key $buf;
537 };
538
539 undef $WIN_FH;
540
541 $msg = "\e]776;?\007" # cellinfo request
542 . "\e[?25l" # hide cursor
543 . "\e[?7l" # no wraparound
544 . "\e[H"; # clreos
545 }
546
547 $msg .= $WIN_DISPLAY_PREFIX;
548 undef $WIN_DISPLAY_PREFIX;
549
550 for my $y (0 .. $WIN_H - 1) {
551 if ($DISPLAY[$y] ne $DISPLAYED[$y]) {
552 $msg .= "\e[" . ($y + 1) . "H$DISPLAY[$y]\e[3K\e[m";
553 $DISPLAYED[$y] = $DISPLAY[$y];
554 }
555 }
556
557 # my $txt = substr $WIN_TEXT, 0, $WIN_W;
558 # $msg .= " " x ($WIN_W - 1 - length $txt);
559 # $msg .= $txt;
560 # $msg .= "\e[J"; # clreos
561 $msg .= $WIN_TEXT;
562
563 #utf8::encode $msg;
564
565 print $WIN $msg;
566
567 if (0) {#d#
568 for (my $ofs = 0; $ofs < length $msg; ) {
569 my $len = syswrite $WIN, $msg, (length $msg) - $ofs, $ofs;
570
571 if ($len > 0) {
572 $ofs += $len;
573 } else {
574 __win_reset;
575 sleep 1;
576 goto &__win;
577 }
578 }
579 }
580
581 $WIN_READY->() if $WIN_H;
582 }
583
584 sub win_refresh {
585 $WIN_TOW ||= AE::timer 1/60, 0, \&_win_refresh;
586 }
587
588 sub win_show {
589 return if $WIN_SHOW;
590 $WIN_SHOW = 1;
591 win_refresh;
592 }
593
594 sub win_hide {
595 return unless $WIN_SHOW;
596 $WIN_SHOW = 0;
597 win_refresh;
598 }
599
600 sub win_scroll($$;$) {
601 my ($y0, $y1, $up) = @_;
602
603 $WIN_DISPLAY_PREFIX = sprintf "\e[%d;%dr\e[%dH", $y0 + 1, $y1 + 1, $y0 + 1;
604 $WIN_DISPLAY_PREFIX .= $up ? "\e[M" : "\e[L";
605 $WIN_DISPLAY_PREFIX .= "\e[r";
606
607 for (\@DISPLAY, \@DISPLAYED) {
608 if ($up) {
609 splice @$_, $y1, 0, "";
610 splice @$_, $y0, 1;
611 } else {
612 splice @$_, $y1, 1;
613 splice @$_, $y0, 0, "";
614 }
615 }
616 }
617
618 # expects unicode
619 sub win_set($$) {
620 $DISPLAY[$_[0]] = $_[1];
621 }
622
623 sub win_clear {
624 @DISPLAY = ();
625
626 # immediatelly clear, if possible
627 if ($WIN) {
628 syswrite $WIN, "\e[H\e[2J";
629 @DISPLAYED = ();
630 }
631
632 win_show;
633 }
634
635 sub win_nest(&) {
636 my @old_display = @DISPLAY;
637
638 win_clear;
639 win_refresh;
640 $_[0]();
641
642 @DISPLAY = @old_display;
643 win_refresh;
644 }
645
646 __win_reset;
647 _win_refresh;
648 win_show;
649
650 sub win_progress($) {
651 win_clear;
652 win_set 10, " $_[0]";
653 _win_refresh;
654 }
655
656 sub win_progress_init {
657 my (@lines) = @_;
658
659 my $msg;
660
661 for my $y (0 .. $#lines) {
662 $msg .= "\e[" . ($y + 1) . "H$lines[$y]\e[3K\e[m";
663 }
664
665 $msg .= "\e[J";
666
667 print $WIN $msg;
668 }
669
670 sub win_progress_update {
671 my ($y, $text) = @_;
672
673 print $WIN "\e[" . ($y + 1) . "H$text\e[3K";
674 }
675
676 sub win_progress_done {
677 win_refresh;
678 }
679
680 #############################################################################
681
682 package list {
683
684 sub new {
685 my $class = shift;
686
687 my $self = bless {
688 list => [], # format: [display-string, id, extra-unused]
689 state => {},
690 y0 => 0,
691 y1 => $WIN_H - 1,
692 ref => -2,
693 return => undef,
694 left => undef,
695 display_cb => sub { },
696 @_,
697 cur => 0,
698 }, $class;
699
700 $self->{cur} = $self->{state}{curidx}*1;
701
702 if (defined (my $curname = $self->{state}{curname})) {
703 my $list = $self->{list};
704 for (0 .. $#$list) {
705 if ($list->[$_][1] eq $curname) {
706 $self->{cur} = $_;
707 last;
708 }
709 }
710 }
711
712 $self->reify;
713
714 $self
715 }
716
717 sub set {
718 $_[0]{list} = $_[1];
719 }
720
721 sub reify {
722 my ($self) = @_;
723
724 my $list = $self->{list};
725 my $cur = $self->{cur};
726
727 $cur = List::Util::max $cur, 0;
728 $cur = List::Util::min $cur, $#$list;
729
730 $self->{cur} = $cur;
731 }
732
733
734 sub draw {
735 my ($self) = @_;
736
737 $self->reify;
738
739 my $list = $self->{list};
740 my $cur = $self->{cur};
741 my $lines = $self->{y1} - $self->{y0} + 1;
742
743 my $beg = List::Util::max 0, List::Util::min $cur - int $lines / 2, @$list - $lines;
744
745 # scroll optimization
746 if ($self->{ref} + 1 == $beg) {
747 ::win_scroll $self->{y0}, $self->{y1}, 1;
748 } elsif ($self->{ref} - 1 == $beg) {
749 ::win_scroll $self->{y0}, $self->{y1}, 0;
750 }
751
752 {
753 my $cb = $self->{display_cb};
754 my ($entry, $line); # speed
755 my $y0 = $self->{y0};
756 my $yb = List::Util::min @$list - $beg, $lines;
757 for (0 .. $yb - 1) {
758 $entry = $list->[$beg + $_];
759 $line = $entry->[0];
760 $line = "\e[30;43m$line" if $_ == $cur - $beg; # hilight selection
761 $line = $cb->($entry, $line) // $line;
762 $DISPLAY[$_ + $y0] = $line;
763 }
764
765 if (0) { # random pattern
766 for my $line (@DISPLAY[$y0 + $yb .. $y0 + $lines - 1]) {
767 $line = " " x $WIN_W;
768 substr $line, (rand $WIN_W - 1), 1, "."
769 for 1 .. rand $WIN_W / $WIN_H;
770 $line =~ s/ +$//;
771 }
772 }
773
774 $DISPLAY[$y0] = sprintf "%d more", $beg + 1
775 if $cur > $beg && $beg;
776
777 if ($cur < $beg + $lines && @$list - $beg - $lines > 0) {
778 $DISPLAY[$y0 + $yb - 1] = sprintf "%d more", @$list - $beg - $lines + 1;
779 }
780 }
781
782 $self->{cur} = $cur;
783 $self->{ref} = $beg;
784 }
785
786 sub changed {
787 my ($self) = @_;
788
789 $self->reify;
790
791 $self->{state}{curidx} = $self->{cur};
792 $self->{state}{curname} = $self->{list}[$self->{cur}][1];
793 ::state_save;
794 }
795
796 sub handle_event {
797 my ($self) = @_;
798
799 return unless @{ $self->{list} };
800
801 if ($::INPUT eq "up") {
802 $self->{cur} = ($self->{cur} - 1) % @{ $self->{list} }; $self->changed;
803 } elsif ($::INPUT eq "down") {
804 $self->{cur} = ($self->{cur} + 1) % @{ $self->{list} }; $self->changed;
805 } elsif ($::INPUT eq "pgup" or $::INPUT eq "num2") {
806 $self->{cur} -= ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed;
807 } elsif ($::INPUT eq "pgdown" or $::INPUT eq "num8") {
808 $self->{cur} += ($self->{y1} - $self-> {y0} + 1) >> 1; $self->changed;
809 } elsif ($::INPUT eq "num1") {
810 $self->{cur} = 0; $self->changed;
811 } elsif ($::INPUT eq "num9") {
812 $self->{cur} = $#{ $self->{list} }; $self->changed;
813 } else {
814 return;
815 }
816
817 1 # event consumed
818 }
819
820 # handle events until selection was made (return it)
821 # or an unknown input was received (return nothing)
822 sub handle_events {
823 my ($self) = @_;
824
825 while () {
826 $self->draw;
827 ::input_next "list";
828 $self->handle_event
829 and return 1;
830
831 my $nonempty = @{ $self->{list} };
832
833 if ($::INPUT eq "enter") {
834 ::input_set "list/select", $self->{cur};
835 return if $nonempty;
836
837 } elsif (($::INPUT eq "return" || $::INPUT eq "esc") && defined $self->{return}) {
838 $self->{cur} = $self->{return};
839 ::input_set "list/select", $self->{cur};
840 return if $nonempty;
841
842 } elsif ($::INPUT eq "left" && defined $self->{left}) {
843 $self->{cur} = $self->{left};
844 ::input_set "list/select", $self->{cur};
845 return if $nonempty;
846
847 } else {
848 return;
849 }
850 }
851 }
852
853 sub selection {
854 $_[0]{list}[$_[0]{cur}]
855 }
856 }
857
858 #############################################################################
859
860 sub prepare_exit() {
861 state_cleanup;
862 $mpv->stop;
863 }
864
865 #############################################################################
866
867 sub menu_choice($%) {
868 my (%arg) = @_;
869
870 my $list = new list
871 cur => 0,
872 y0 => 5,
873 %arg,
874 ;
875
876 while () {
877 $list->handle_events and next;
878
879 if ($INPUT eq "list/select") {
880 return $list->selection;
881 }
882 #TODO: return more?
883 }
884 }
885
886 #############################################################################
887
888 sub _canonpath {
889 my $path = $_[0];
890
891 my $file;
892
893 unless (-d $path) {
894 $path =~ s/((?:^|\/)[^\/]+\z)//;
895 $file = $1;
896 }
897
898 $path = Cwd::realpath $path;
899 $path = "/fs/$NODENAME$path" unless $path =~ /^\/fs\//;
900
901 "$path$file"
902 }
903
904 our $VIDEO_DIR_CANON = _canonpath $VIDEO_DIR;
905
906 sub canonpath {
907 my $path = _canonpath $_[0];
908 $path =~ s/^\Q$VIDEO_DIR_CANON\E(\z|\/)/$VIDEO_DIR$1/;
909 $path
910 }
911
912 # check path for mythtv
913 sub is_myth($) {
914 my $a = canonpath $_[0];
915 my $b = canonpath $MYTHTV_DIR;
916 $a =~ /^\Q$b\E/
917 }
918
919 our $CONF_MTIME;
920 our $CONF;
921 our %CONF_PLAYLIST;
922 our @CONF_PLAYLIST_ORDER;
923
924 sub conf_postload {
925 %CONF_PLAYLIST = ();
926 @CONF_PLAYLIST_ORDER = ();
927
928 my @pl = @{ $CONF->{playlists} };
929 while (@pl) {
930 my ($k, $v) = splice @pl, 0, 2;
931
932 $k = "/$k";
933
934 push @CONF_PLAYLIST_ORDER, $k
935 unless $v->{hide};
936
937 $v->{cwd} = $v->{cwd} ? canonpath $v->{cwd} : $VIDEO_DIR;
938
939 my $state = $STATE{$k} //= {};
940 $CONF_PLAYLIST{$k} = $v;
941 $state->{from_conf} = 1;
942 }
943 }
944
945 sub conf_check {
946 if ((stat $CONF_FILE)[9] != $CONF_MTIME) {
947 warn "reloading $CONF_FILE...\n";
948
949 $CONF_MTIME = (stat _)[9];
950 $CONF = do $CONF_FILE;
951
952 warn $@ if $@;
953
954 conf_postload;
955 }
956 }
957
958 #############################################################################
959
960 sub playlist_names {
961 (
962 @CONF_PLAYLIST_ORDER,
963 grep
964 /^\//
965 && !exists $CONF_PLAYLIST{$_},
966 sort keys %STATE
967 )
968 }
969
970 sub stat_video($;$) {
971 my ($path, $prefix) = @_;
972
973 my $display = $path =~ s%^.*/%%r;
974
975 $display =~ /^\./ and return;
976 $display =~ /\..{2,5}$/ or return;
977
978 #next unless $name =~ /\.(mp4|mkv|webm|flv|ogg|mp3|m4a|mov|mpg|avi|ogv)$/i;
979
980 utf8::downgrade $path;
981
982 stat "$prefix$path" or return;
983 -f _ or return;
984
985 utf8::decode $display;
986
987 for ($display) {
988
989 #s%\.[A-Za-z0-9]{3,4}$%%; # .mp4
990 #s%-[A-Za-z0-9\-_]{11}$%%; # youtube-id
991 s%-[A-Za-z0-9\-_]{11}.(mkv|webm|mp4|mov)$%.$1%; # youtube-id
992
993 sub dfe::mangle_name ();
994 dfe::mangle_name;
995
996 # "improve" some filenames/episode numbers, mostly for sorting
997 s{(?:\bpart|\bep\.?|episode|Ch\.|Chapter|\bE)\s*#?(\d+)\b}{sprintf "Ep.%03d", $1}geia;
998 #s{(-\s*)(\d{1,4})(\s*-)}{sprintf "%s#%03d%s", $1, $2, $3}geia;
999 s{\s+#(\d+)}{sprintf " #%03d", $1}geia;
1000 s{\[#?(\d+)\]}{sprintf "#%03d", $1}geia;
1001 s{\bs(\d+)e(\d+)\b}{sprintf "S%02dE%02d", $1, $2}geia;
1002
1003 s{-20(\d\d)(\d\d)(\d\d)\.([^.]+)\z}{-20$1.$2.$3.$4}a;
1004
1005 s/\s+/ /g;
1006 }
1007
1008 $display = sprintf "%s [%dMB]", $display, (-s _) * 1e-6;
1009
1010 [$display, $path]
1011 }
1012
1013 sub video_sort {
1014 # schwartzian version sort on filename
1015 map $_->[0],
1016 sort { $a->[1] cmp $b->[1] }
1017 map [$_, lc $_->[0] =~ s/([0-9]+)/sprintf "%19d", $1/ger],
1018 @_
1019 }
1020
1021 my $video_dir_cache;
1022
1023 sub scan_video_dir($) {
1024 my ($path) = @_;
1025
1026 my $cache = $video_dir_cache->{$path};
1027
1028 opendir my $dir, $path
1029 or return []; #die "$path: $!\n";
1030 my $mtime = (stat $dir)[9];
1031
1032 if ($mtime != $cache->[0]) {
1033 # hack to preload cache a bit
1034
1035 $cache = $cache->[1];
1036
1037 my @files =
1038 grep !/(?:\.(?:json|srt|vtt|part|ytdl|chapters|f\d\d\d\.[^.]+)$)/a,
1039 readdir $dir;
1040
1041 win_progress_init "scan_video_dir", $path;
1042
1043 # pre-cache files
1044 for my $file (@files) {
1045 IO::AIO::aio_stat "$path/$file"
1046 unless exists $cache->{$file};
1047 }
1048
1049 my %new_cache;
1050 my $progress = 0;
1051 for my $file (@files) {
1052 $new_cache{$file} = (delete $cache->{$file}) || (stat_video "$path/$file") || next;
1053
1054 win_progress_update 2, "$progress/" . @files
1055 unless ++$progress & 15;
1056 }
1057
1058 $cache = $video_dir_cache->{$path} = [$mtime, \%new_cache];
1059
1060 win_progress_done;
1061 }
1062
1063 [ video_sort values %{$cache->[1]} ]
1064 }
1065
1066 sub scan_video_dir_clear_cache() {
1067 $video_dir_cache = undef;
1068 }
1069
1070 sub scan_00_distant_worlds {
1071 (
1072 "",
1073 [
1074 video_sort #d#
1075 @{ scan_video_dir $VIDEO_DIR },
1076 @{ scan_video_dir "/fs/doom/root/ytnew" },
1077 @{ scan_video_dir "/seagate2tb/sinatar" },
1078 ]
1079 )
1080 }
1081
1082 sub scan_islands($) {
1083 my ($path) = @_;
1084
1085 my $list = scan_video_dir $path;
1086
1087 my %byuploader;
1088 for (@$list) {
1089 push @{ $byuploader{$1} }, $_
1090 if $_->[1] =~ /^([^-]+)-/;
1091 }
1092
1093 (
1094 "",
1095 [
1096 sort { "\L$a->[0]" cmp "\L$b->[0]" }
1097 map @$_,
1098 grep @$_ <= MAX_ISLANDS,
1099 values %byuploader
1100 ]
1101 )
1102 }
1103
1104 sub state_scan_recursive($) {
1105 my ($path) = @_;
1106
1107 my @list;
1108
1109 my $scan = sub {
1110 my ($path, $display) = @_;
1111
1112 my @dirs;
1113
1114 $path = canonpath $path;
1115
1116 opendir my $fh, $path
1117 or return;
1118 for (sort readdir $fh) {
1119 next if /^\.\.?$/;
1120 stat "$path/$_" or next;
1121
1122 if (-d _) {
1123 my $dis = dec $_;
1124 $dis = length $dis > 25 ? (substr $dis, 0, 24) . "…" : $dis;
1125
1126 push @dirs, ["$path/$_", "$display/$dis"];
1127
1128 } elsif (-f _) {
1129 my $dis = dec $_;
1130 push @list, [(substr "$display/$dis", 1), "$path/$_"];
1131 }
1132 }
1133
1134 __SUB__->(@$_)
1135 for @dirs;
1136 };
1137
1138 $scan->($path, "");
1139
1140 utf8::decode $_->[0] for @list;
1141
1142 \@list
1143 }
1144
1145 sub mythtv_dbh() {
1146 DBI->connect ("DBI:mysql:database=mythconverg;mysql_read_default_file=/root/.my.cnf;host=doom;user=root")
1147 or die "unable to connect to mythtv database"
1148 }
1149
1150 sub scan_mythtv($) {
1151 my $dbh = mythtv_dbh;
1152
1153 my $rv = $dbh->selectall_arrayref (
1154 "select basename, convert_tz(starttime, 'UTC', 'Europe/Berlin'), title, subtitle
1155 from recorded
1156 where recgroup not in ('Deleted', 'LiveTV')
1157 order by starttime asc
1158 ");
1159
1160 for (@$rv) {
1161 utf8::decode $_->[2];
1162 utf8::decode $_->[3];
1163 }
1164
1165 (
1166 "$MYTHTV_DIR/",
1167 [
1168 map ["$_->[1] " . (dec $_->[2]) . " (" . (dec $_->[3]) . ")", $_->[0]], @$rv
1169 ]
1170 )
1171 }
1172
1173 # delete /playlist, maybe switch away if current playlist
1174 sub playlist_delete {
1175 my ($playlist) = @_;
1176
1177 delete $STATE{$playlist};
1178
1179 if ($STATE{curdir} eq $playlist) {
1180 $STATE{curdir} = "/playlist";
1181 ::state_save;
1182 external "--playlist=playlist";
1183 }
1184 }
1185
1186 our ($PLAYING_STATE, $PLAYING_PATH);
1187
1188 sub play_video_speed_mult {
1189 sprintf "%.2f", 1.032 ** $PLAYING_STATE->{speed}
1190 }
1191
1192 sub play_video_set_speed {
1193 my $speed = play_video_speed_mult;
1194 delete $PLAYING_STATE->{speed} unless $PLAYING_STATE->{speed};
1195
1196 $mpv->cmd ("set", "speed", "$speed");
1197 $mpv->cmd ("show-text", "playback speed $speed");
1198 }
1199
1200 our $OSD_LEVEL = $DOOM ? 3 : 3; # was 1 on doom
1201
1202 sub sprintf_time($$) {
1203 sprintf $_[0],
1204 sprintf "%02d:%02d:%02d.%03d",
1205 $_[1] / 60 / 60 % 60,
1206 $_[1] / 60 % 60,
1207 $_[1] % 60,
1208 $_[1] * 1000 % 1000;
1209 }
1210
1211 my $curfps;
1212
1213 sub set_fps {
1214 return unless $DOOM;
1215
1216 my ($target) = @_;
1217
1218 my $new = $XRANDR_FPS;
1219
1220 if (defined $target) {
1221 my $maxerr = 0.02; # max. 2% off allowed
1222 for (@XRANDR_RATES) {
1223 for my $div (1..10) {
1224 my $err = abs ($target * $div / $_->[0] - 1);
1225 if ($err < $maxerr) {
1226 $maxerr = $err;
1227 $new = $_->[0];
1228 }
1229 }
1230 }
1231 }
1232
1233 if ($curfps != $new && defined $new) {
1234 warn "REFRESHRATE CHANGE current=$curfps, target=$target, selected=$new\n";
1235 system "xrandr", "--output", $XRANDR_OUTPUT, "--mode", $XRANDR_MODE, "--rate", $new;
1236 $curfps = $new;
1237 }
1238 }
1239
1240 # does not work: deinterlace, because it returns a boolean and expects i have no clue
1241 our %SAVE_PROPERTY = (aid => 1, sid => 1, "audio-delay" => 1);
1242
1243 sub mpv_init {
1244 $mpv->start ("--idle=yes", "--pause", "--force-window=no"); # "--start=$playback_start", "--", $mpv_path;
1245
1246 for (
1247 List::Util::pairs qw(
1248 ESC return
1249 q return
1250 ENTER enter
1251 SPACE pause
1252 [ steprev
1253 ] stepfwd
1254 j subtitle
1255 BS red
1256 i green
1257 o yellow
1258 b blue
1259 D triangle
1260 UP up
1261 DOWN down
1262 RIGHT right
1263 LEFT left
1264 ),
1265 (map { ("KP$_" => "num$_") } 0..9),
1266 KP_INS => 0, # KP0, but different
1267 ) {
1268 $mpv->bind_key ($_->[0] => $_->[1]);
1269 }
1270
1271 $mpv->cmd (observe_property => 1, "chapter-metadata");
1272
1273 eval {
1274 # the profile is optional
1275 $mpv->cmd ("apply-profile" => "doomfrontend");
1276 };
1277 }
1278
1279 sub play_video {
1280 ($PLAYING_STATE, $PLAYING_PATH, my $continue) = @_;
1281
1282 my $playback_start = 0;
1283
1284 if ($continue) {
1285 $playback_start = $PLAYING_STATE->{curpos} // 0;
1286 } else {
1287 my @menu = ([beginning => 0], [cancel => undef]);
1288
1289 for my $idx (reverse 0..9) {
1290 if (my $pos = $PLAYING_STATE->{"bookmark$idx"}) {
1291 unshift @menu, [(sprintf_time "bookmark $idx (%s)", $pos) => $pos];
1292 }
1293 }
1294
1295 if (my $pos = $PLAYING_STATE->{curpos}) {
1296 unshift @menu, [(sprintf_time "current (%s)", $pos) => $pos];
1297 }
1298
1299 if (@menu > 2) {
1300 win_clear;
1301 win_set 3, "\e[33mmultiple start locations available:";
1302
1303 my $selection = menu_choice
1304 list => \@menu,
1305 y0 => 5,
1306 return => $#menu,
1307 left => $#menu,
1308 ;
1309
1310 $playback_start = $selection->[1];
1311
1312 defined $playback_start
1313 or return;
1314
1315 } else {
1316 $playback_start = 0;
1317 }
1318 }
1319
1320 win_clear;
1321 win_set 0, "starting video...";
1322 _win_refresh;
1323
1324 my $mpv_path = $PLAYING_PATH;
1325 my $initial_deinterlace;
1326
1327 if (is_myth $mpv_path) {
1328 $mpv_path = "appending://$mpv_path";
1329 $initial_deinterlace = 1;
1330 }
1331
1332 $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
1333 $mpv->cmd ("set", "vid", "auto");
1334 $mpv->cmd ("set", "aid", "auto");
1335 $mpv->cmd ("set", "sid", "no");
1336 #$mpv->cmd ("set", "sub-delay", "-19.100");
1337 #$mpv->cmd ("set", "sub-codepage", "UTF-8-BROKEN");
1338 $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters"));
1339 $mpv->cmd ("set", "options/start" => "$playback_start"); # file-local-options, or just start do not work
1340 $mpv->cmd ("loadfile", $mpv->escape_binary ($mpv_path));
1341 $mpv->cmd ("script-message", "osc-visibility", "auto", "dummy");
1342 #$mpv->cmd ("playlist-clear");
1343
1344 my $oid = 100;
1345
1346 #$mpv->cmd ("observe_property", ++$oid, "shared-script-properties");
1347
1348 #$mpv->cmd ("get_property", "playback-time");
1349 #$mpv->cmd ("get_time_us");
1350
1351 my $playback_time;
1352
1353 my $status = 0;
1354 my $arg;
1355
1356 my $fps;
1357
1358 my $skip_delay;
1359
1360 while () {
1361 input_next "play";
1362
1363 if ($INPUT =~ /^num([0-9])$/ or $INPUT eq "red") {
1364 $INPUT eq "red"
1365 ? substr $arg, -1, 1, ""
1366 : ($arg .= $1);
1367
1368 $mpv->cmd ("osd-msg", "show-text", "argument: ${arg}_", 600000);
1369 $mpv->cmd ("osd-msg", "show-text", "") unless length $arg;
1370 next;
1371 }
1372
1373 if ($INPUT eq "mpv/quit") { # should not happen, but allows user to kill etc. without consequence
1374 $status = 1;
1375 mpv_init; # try reinit
1376 last;
1377
1378 } elsif ($INPUT eq "mpv/idle") { # normal end-of-file
1379 last;
1380
1381 } elsif ($INPUT eq "return") {
1382 $status = 1;
1383 last;
1384
1385 } elsif ($INPUT eq "mpv/file-loaded") { # start playing, configure video
1386 #$mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0;
1387
1388 my $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60;
1389 $target_fps *= play_video_speed_mult;
1390 set_fps $target_fps;
1391
1392 unless (eval { $mpv->cmd_recv ("get_property", "video-format") }) {
1393 # assume audio-only TODO: better test
1394 $mpv->cmd ("set", "file-local-options/lavfi-complex", "[aid1] asplit [ao], showcqt=fps=60:size=hd720:count=1:bar_g=2:sono_g=3:sono_v=9:fontcolor='st(0, (midi(f)-53.5)/12); st(1, 0.5 - 0.5 * cos(PI*ld(0))); r(1-ld(1)) + b(ld(1))':tc=0.33:tlength='st(0,0.17); 384*tc / (384 / ld(0) + tc*f /(1-ld(0))) + 384*tc / (tc*f / ld(0) + 384 /(1-ld(0)))', format=yuv420p [vo]");
1395 };
1396
1397 for my $prop (keys %SAVE_PROPERTY) {
1398 if (exists $PLAYING_STATE->{"mpv_$prop"}) {
1399 $mpv->cmd ("set", "$prop", $PLAYING_STATE->{"mpv_$prop"} . "");
1400 }
1401
1402 $mpv->cmd ("observe_property", ++$oid, $prop);
1403 }
1404
1405 play_video_set_speed;
1406 $mpv->cmd ("set", "osd-level", "$OSD_LEVEL");
1407 $mpv->cmd ("observe_property", ++$oid, "osd-level");
1408 $mpv->cmd ("set", "pause", "no");
1409
1410 $mpv->cmd ("set_property", "deinterlace", "yes")
1411 if $initial_deinterlace;
1412
1413 $mpv->cmd ("show-text", "FPS: target $target_fps, current $curfps", 2000)
1414 if $curfps != $fps;#d#
1415
1416 win_clear;
1417
1418 } elsif ($INPUT eq "stepfwd") {
1419 ++$PLAYING_STATE->{speed};
1420 play_video_set_speed;
1421 ::state_save;
1422 } elsif ($INPUT eq "steprev") {
1423 --$PLAYING_STATE->{speed};
1424 play_video_set_speed;
1425 ::state_save;
1426
1427 } elsif ($INPUT eq "pause") {
1428 $mpv->cmd ("cycle", "pause");
1429 $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1430 ::state_save;
1431
1432 } elsif ($INPUT eq "green") {
1433 if (length $arg) { # seek-to
1434 if ($arg <= 99) { # MM
1435 $arg = sprintf "%02d:00", $arg;
1436 } elsif ($arg <= 9999) { # HHMM
1437 $arg = sprintf "%02d:%02d:00", $arg / 100, $arg % 100;
1438 } else { # HHMMSS
1439 $arg = sprintf "%02d:%02d:%02d", $arg / 100 / 100, $arg / 100 % 100, $arg % 100;
1440 }
1441 $mpv->cmd ("osd-msg", "seek", $arg, "absolute+exact");
1442 } else {
1443 #$mpv->cmd ("osd-msg-bar", "show-progress");
1444 $mpv->cmd ("script-binding", "stats/display-stats-toggle");
1445 }
1446
1447 } elsif ($INPUT eq "yellow") {
1448 $mpv->cmd ("osd-auto", "cycle-values", "osd-level", "2", "3", "0", "1");
1449
1450 } elsif ($INPUT eq "right") {
1451 $mpv->cmd ("osd-msg-bar", "seek", $arg * 60 || 30, "relative+exact");
1452 } elsif ($INPUT eq "left") {
1453 $mpv->cmd ("osd-msg-bar", "seek", -$arg * 60 || -5, "relative+exact");
1454 } elsif ($INPUT eq "up") {
1455 $mpv->cmd ("osd-msg-bar", "seek", +600, "relative+exact");
1456 } elsif ($INPUT eq "down") {
1457 $mpv->cmd ("osd-msg-bar", "seek", -600, "relative+exact");
1458 } elsif ($INPUT eq "select") {
1459 $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "-0.100");
1460 } elsif ($INPUT eq "start") {
1461 $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "0.100");
1462 } elsif ($INPUT eq "intfwd") {
1463 $mpv->cmd ("no-osd", "frame-step");
1464 } elsif ($INPUT eq "intrev") {
1465 $mpv->cmd ("no-osd", "frame-back-step");
1466
1467 } elsif ($INPUT eq "enter") {
1468 eval {
1469 my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1470 $mpv->cmd ("show-text", "saving bookmark $arg position at $pos");
1471 $PLAYING_STATE->{"bookmark$arg"} = $pos;
1472 ::state_save;
1473 };
1474
1475 } elsif ($INPUT eq "blue") { # recall bookmark
1476 my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1477 $mpv->cmd ("no-osd", "seek", $PLAYING_STATE->{"bookmark$arg"}, "absolute+exact");
1478 $PLAYING_STATE->{"bookmark9"} = $pos;
1479 $mpv->cmd ("expand-properties", "show-text", "recalling bookmark $arg position \${playback-time}, recall bookmark 9 to return", 5000);
1480 ::state_save;
1481
1482 } elsif ($INPUT eq "square") {
1483 $mpv->cmd ("osd-auto", "screenshot", "video");
1484
1485 } elsif ($INPUT eq "audio") {
1486 $mpv->cmd ("osd-auto", "cycle", "audio");
1487
1488 } elsif ($INPUT eq "subtitle") {
1489 $mpv->cmd ("osd-auto", "cycle", "sub");
1490
1491 } elsif ($INPUT eq "triangle") {
1492 $mpv->cmd ("osd-auto", "cycle", "deinterlace");
1493
1494 } elsif ($INPUT eq "mpv/property-change") {
1495 my $prop = $INPUT_DATA->{name};
1496
1497 if ($prop eq "osd-level") {
1498 $OSD_LEVEL = $INPUT_DATA->{data};
1499 #win_set 0, "playback position $playback_time";
1500 #warn "$playback_time\n";#d#
1501 #$mpv->cmd ("expand-properties", "show-text", '${time-pos}', "1500");
1502 } elsif ($prop eq "chapter-metadata") {
1503 if ($INPUT_DATA->{data}{TITLE} =~ /^\[SponsorBlock\]: (.*)/) {
1504 my $section = $1;
1505 my $skip;
1506
1507 $skip ||= $SPONSOR_SKIP{$_}
1508 for split /\s*,\s*/, $section;
1509
1510 if (defined $skip) {
1511 if ($skip) {
1512 # delay a bit, in case we get two metadata changes in quick succession, e.g.
1513 # because we have a skip at file load time.
1514 $skip_delay = AE::timer 2/50, 0, sub {
1515 $mpv->cmd ("no-osd", "add", "chapter", 1);
1516 $mpv->cmd ("show-text", "skipped sponsorblock section \"$section\"", 3000);
1517 };
1518 } else {
1519 undef $skip_delay;
1520 $mpv->cmd ("show-text", "NOT skipping sponsorblock section \"$section\"", 3000);
1521 }
1522 } else {
1523 $mpv->cmd ("show-text", "UNRECOGNIZED sponsorblock section \"$section\"", 60000);
1524 }
1525 } else {
1526 # cancel a queued skip
1527 undef $skip_delay;
1528 }
1529
1530 } elsif (exists $SAVE_PROPERTY{$prop}) {
1531 $PLAYING_STATE->{"mpv_$prop"} = $INPUT_DATA->{data};
1532 ::state_save;
1533 }
1534 }
1535
1536 undef $arg;
1537 }
1538
1539 $mpv->cmd ("set", "pause", "yes");
1540
1541 while ($oid > 100) {
1542 $mpv->cmd ("unobserve_property", $oid--);
1543 }
1544
1545 if ($status) {
1546 eval {
1547 $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1548 ::state_save;
1549 };
1550 warn $@ if $@;#d#
1551 } else {
1552 $PLAYING_STATE->{watched} = int AE::now;
1553 ::state_save;
1554 }
1555
1556 $mpv->cmd_recv ("stop");
1557
1558 # make sure state is clean, even if its slower
1559 #$mpv->stop;
1560 #mpv_init;
1561
1562 #if ($DPMS_DISABLE) {
1563 # system "xse", "-dpms";
1564 #}
1565 }
1566
1567 sub play_video_kodi($$$) {
1568 my ($host, $path, $state) = @_;
1569
1570 unlink "$KODIPATH/$host.bin";
1571 symlink $path, "$KODIPATH/$host.bin";
1572 system "chmod", "o+r", "--", "$KODIPATH/$host.bin";
1573
1574 my $conn; $conn = new AnyEvent::Handle
1575 connect => [$host, 9090],
1576 on_error => sub {
1577 $conn; # self-reference
1578
1579 my ($hdl, $fatal, $msg) = @_;
1580
1581 AE::log error => $msg;
1582
1583 $hdl->destroy;
1584 },
1585 ;
1586
1587 $conn->on_read (sub {
1588 warn $conn->{rbuf};
1589 });
1590
1591 $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.open", "params": {"item":{"file":"$KODIURL/$host.bin"}}}>);
1592 warn "$KODIURL/$host.bin";#d#
1593
1594 if (my $curpos = $state->{curpos}) {
1595 Coro::AnyEvent::sleep 1;
1596
1597 my $ms = int +($curpos - int $curpos) * 1000;
1598 my $s = int $curpos % 60;
1599 my $m = int $curpos / 60 % 60;
1600 my $h = int $curpos / 60 / 60 ;
1601
1602 $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.seek", "params": {"playerid":1, "value":{"hours":$h, "minutes":$m, "seconds":$s, "milliseconds":$ms}}}>);
1603 }
1604
1605 $conn->push_shutdown;
1606 }
1607
1608 sub mangle_edit($$) {
1609 my ($playlist, $path) = @_;
1610
1611 my $base = basename $path;
1612
1613 my ($uploader, $title) = split /-/, basename $base;
1614
1615 my @pats;
1616
1617 utf8::decode $title; # filename must be utf-8, now unicode
1618
1619 while ($title =~ /(?:(\w+|\S+)|([[:space:]:!,‐]+))/mgs) {
1620 my ($w, $W) = ($1, $2);
1621 if (defined $w) {
1622 $w = quotemeta $w;
1623 $w =~ s/\d+/\\d+/g;
1624 push @pats, $w;
1625 } elsif ($W eq " ") {
1626 push @pats, " ";
1627 } else {
1628 push @pats, "\\W+?";
1629 }
1630 }
1631
1632 #utf8::encode $_ for @pats;
1633
1634 my ($o, $l) = (1, 0);
1635
1636 my $patterns = $STATE{mangle_config}{$uploader};
1637
1638 my $list_state = { curidx => 1 };
1639
1640 my $rescan;
1641
1642 while () {
1643 win_clear;
1644 win_set 1, "\e[33mmangle editor";
1645 win_set 3, dec $base;
1646 win_set 6, "keyboard: 4=left, 6=right, 8=extend, 2=shrink; remote: prev=left, next=right, instant=extend/shrink";
1647
1648 $o = 0 if $o < 0;
1649 $o = $#pats if $o > $#pats;
1650 $l = 0 if $l < 0;
1651 $l = $#pats - $o if $l > $#pats - $o;
1652
1653 my $edit = "";
1654 for my $i (0 .. $#pats) {
1655 $edit .= "<\e[30;43m" if $i == $o;
1656 $edit .= $pats[$i];
1657 $edit .= "\e[m>" if $i == $o + $l;
1658 }
1659
1660 win_set 8, "\e[36mpattern edit ($o+$l):\e[0m $edit";
1661 win_set 10, "resulting pattern: <\e[33m" . (join "", @pats[$o .. $o+$l]) . "\e[m>";
1662
1663 my @list = (
1664 ["return", sub { last }],
1665 ["add pattern", sub {
1666 push @$patterns, join "", @pats[$o .. $o+$l];
1667 $rescan = 1;
1668 last;
1669 }],
1670 ["use time for all (add empty pattern)", sub {
1671 push @$patterns, "";
1672 $rescan = 1;
1673 last;
1674 }],
1675 );
1676
1677 for my $pattern (@$patterns) {
1678 push @list, ["remove: <$pattern>", sub {
1679 $patterns = [grep $_ ne $pattern, @$patterns];
1680 $list_state->{curidx} = 0; # return
1681 $rescan = 1;
1682 }];
1683 }
1684
1685 my $menu = new list
1686 state => $list_state,
1687 y0 => 13,
1688 return => 0,
1689 left => 0,
1690 list => \@list,
1691 ;
1692
1693 1 while $menu->handle_events;
1694
1695 if ($INPUT eq "list/select") {
1696 $menu->selection->[1]();
1697 } elsif ($INPUT eq "4" or $INPUT eq "prev") {
1698 --$o;
1699 } elsif ($INPUT eq "6" or $INPUT eq "next") {
1700 ++$o;
1701 } elsif ($INPUT eq "8" or $INPUT eq "intfwd") {
1702 ++$l;
1703 } elsif ($INPUT eq "2" or $INPUT eq "intrev") {
1704 --$l;
1705 }
1706 }
1707
1708 if ($rescan) {
1709 if (@$patterns) {
1710 $STATE{mangle_config}{$uploader} = $patterns;
1711 } else {
1712 delete $STATE{mangle_config}{$uploader};
1713 }
1714
1715 state_save;
1716
1717 sub dfe::mangle_reconfig ();
1718 dfe::mangle_reconfig;
1719
1720 $playlist->{rescan} = 1;
1721 }
1722 }
1723
1724 sub file_menu($$) {
1725 my ($playlist, $path) = @_;
1726
1727 my $state = $STATE{filestate}{$path};
1728
1729 my $menu = new list
1730 y0 => 10,
1731 return => 0,
1732 left => 0,
1733 list => [
1734 ["return", sub { last }],
1735 ["clear state", sub { %$state = (); last }],
1736 ["kodiplay mate10", sub { play_video_kodi "loki-mate10pro", $path, $state }],
1737 ["toggle watched", sub { $state->{watched} = !$state->{watched}; last }],
1738 ["toggle deleted", sub { $state->{deleted} = !$state->{deleted}; last }],
1739 ["toggle archive", sub { $state->{archive} = !$state->{archive}; last }],
1740 ["toggle tagged" , sub { $state->{tagged} = !$state->{tagged} ; last }],
1741 ["mangle editor" , sub { mangle_edit $playlist, $path; last }],
1742 ];
1743
1744 win_clear;
1745 win_set 1, "\e[33mfile menu";
1746 win_set 3, dec $path;
1747
1748 while () {
1749 win_set 4, sprintf "watched:%d deleted:%d", $state->{watched}, $state->{deleted};
1750
1751 1 while $menu->handle_events;
1752
1753 $menu->selection->[1]() if $INPUT eq "list/select";
1754 }
1755 }
1756
1757 sub live_tv {
1758 win_nest {
1759 play_video {}, "dvb://", 0;
1760 };
1761 }
1762
1763 sub dir_menu {
1764 my ($self) = @_;
1765
1766 my $filter_update = sub {
1767 $self->{state}{list_menu}{curidx} = 0;
1768 $self->{rescan} = 1;
1769 };
1770
1771 my $do_unlink = sub {
1772 my ($filter) = @_;
1773
1774 my $filestate = $STATE{filestate};
1775
1776 my $pathpfx = $self->{pathpfx};
1777 my $list = $self->{list};
1778
1779 my $empty = 1;
1780
1781 for (@$list) {
1782 if ($filter->($filestate->{"$pathpfx$_->[1]"})) {
1783 $self->{rescan} = 1;
1784 IO::AIO::aio_unlink "$pathpfx/$_->[1]";
1785 IO::AIO::aio_unlink "$pathpfx/$_->[1].chapters";
1786 } else {
1787 $empty = 0;
1788 }
1789 }
1790
1791 if ($empty) {
1792 playlist_delete $self->{playlist};
1793 }
1794
1795 IO::AIO::flush; #d# should do a group, but I am too lazy
1796 };
1797
1798 my $do_archive = sub {
1799 my $filestate = $STATE{filestate};
1800
1801 while (my ($path, $state) = each %$filestate) {
1802 if ($state->{archive}) {
1803 $self->{rescan} = 1;
1804 system "mv", "-v", "-b", $path, $ARCHIVE_DIR;
1805 }
1806 }
1807 };
1808
1809 my $filter_uploader = sub {
1810 my @menu = (["\e[32mreturn"], ["\e[32mclear filter", undef]);
1811
1812 my %uploader;
1813
1814 for (@{ $self->{full_list} }) {
1815 ++$uploader{$1} if $_->[0] =~ /^([^-]+)/;
1816 }
1817
1818 push @menu,
1819 map [(sprintf "[%4d] %s", $uploader{$_}, dec $_), $_],
1820 grep $uploader{$_} >= MAX_ISLANDS,
1821 sort { "\L$a" cmp "\L$b" } keys %uploader;
1822
1823 my $menu = new list
1824 y0 => 3,
1825 return => 0,
1826 state => ($self->{state}{filter_uploader_menu} ||= {}),
1827 list => \@menu,
1828 ;
1829
1830 while () {
1831 win_clear;
1832 win_set 1, "\e[33mselect uploader";
1833
1834 1 while $menu->handle_events;
1835
1836 if ($INPUT eq "list/select") {
1837 my $sel = $menu->selection;
1838
1839 if (@$sel >= 2) {
1840 $self->{state}{filter_uploader} = $sel->[1];
1841 $filter_update->();
1842 }
1843
1844 last;
1845 }
1846 }
1847 };
1848
1849 my $chdir = sub {
1850 while () {
1851 my @menu = (["\e[32mreturn"]);
1852
1853 push @menu, [$_, $_]
1854 for playlist_names;
1855
1856 my $menu = new list
1857 y0 => 3,
1858 return => 0,
1859 list => \@menu,
1860 ;
1861
1862 while () {
1863 win_clear;
1864 win_set 1, "\e[33mselect playlist";
1865
1866 1 while $menu->handle_events;
1867
1868 if ($INPUT eq "list/select") {
1869 my $sel = $menu->selection;
1870
1871 if (@$sel >= 2) {
1872 external "--playlist=" . substr $sel->[1], 1;
1873 }
1874
1875 return;
1876
1877 } elsif ($INPUT eq "red") {
1878 my $sel = $menu->selection;
1879 delete $STATE{$sel->[1]};
1880 state_save;
1881 last;
1882 }
1883 }
1884 }
1885 };
1886
1887 my $menu = new list
1888 y0 => 10,
1889 return => 0,
1890 list => [
1891 ["return", sub { last }],
1892 ["delete marked as Deleted or Watched", sub { $do_unlink->(sub { $_[0]{deleted} || $_[0]{watched} }); last }],
1893 ["filter uploader" , sub { win_nest { $filter_uploader->() }; last }],
1894 ["delete marked as Watched" , sub { $do_unlink->(sub { $_[0]{watched} }); last }],
1895 ["delete marked as Deleted" , sub { $do_unlink->(sub { $_[0]{deleted} }); last }],
1896 ["clear uploader filter" , sub { delete $self->{state}{filter_uploader}; $filter_update->(); last; }],
1897 ["clear regex filter" , sub { delete $self->{state}{filter_regex}; $filter_update->(); last; }],
1898 ["archive marked as Archive" , sub { $do_archive->(); last }],
1899 #["run xdfe" , sub { system "/fs/doom/root/xdfe"; last }],
1900 ["play live tv" , sub { live_tv; last; }],
1901 ["delete this playlist" , sub { playlist_delete $STATE{curdir}; last } ],
1902 ["rescan playlist" , sub { $self->{rescan} = 1; last }],
1903 ["change playlist" , sub { win_nest { $chdir->() }; last }],
1904 ["change to PLAYLIST" , sub { external "--playlist=playlist"; last }],
1905 ["change to VIDEO_DIR" , sub { external "--playlist=videos" ; last }],
1906 ];
1907
1908 while () {
1909 win_clear;
1910 win_set 1, "\e[33mdirectory menu";
1911
1912 1 while $menu->handle_events;
1913
1914 win_nest { $menu->selection->[1]() } if $INPUT eq "list/select";
1915 }
1916 }
1917
1918 sub menu_playlist {
1919 my @pl = playlist_names
1920 or return;
1921
1922 #@pl = reverse @pl unless $INPUT =~ /^(?:prev|intrev|triangle)$/;
1923
1924 my $cur = max 0, List::MoreUtils::firstidx { $_ eq $STATE{curdir} } @pl;
1925
1926 win_clear;
1927 win_set 0, "\e[33mPLAYLIST SELECT";
1928
1929 my $menu = new list
1930 y0 => 5,
1931 list => [map [$_], @pl],
1932 ;
1933
1934 my $autoselect = 2; # initial delay longer
1935
1936 while () {
1937 if ($INPUT =~ /^(?:next|intfwd|circle)$/) {
1938 ++$cur;
1939 } elsif ($INPUT =~ /^(?:prev|intrev|triangle)$/) {
1940 --$cur;
1941 } elsif ($INPUT eq "enter") {
1942 external "--playlist=" . substr $pl[$cur], 1;
1943 last;
1944 } elsif ($INPUT eq "return") {
1945 last;
1946 }
1947
1948 $cur %= @pl;
1949 $menu->{cur} = $cur;
1950 $menu->changed;
1951 $menu->draw;
1952
1953 my ($timer, $time);
1954 $time = AE::now;
1955 $timer = AE::timer 0, 1/30, sub {
1956 my $bar = int $WIN_W * min 1, (AE::now - $time) / $autoselect;
1957
1958 win_set 2, "\e[43m" . (" " x ($WIN_W - $bar)) . "\e[m";
1959 _win_refresh;
1960 input_feed "enter" if $bar >= $WIN_W;
1961 };
1962
1963 input_next "playlist";
1964
1965 $autoselect = 0.66; # subsequent delay shorter
1966 }
1967 }
1968
1969 sub view_playlist {
1970 my ($playlist) = @_;
1971
1972 my $state = $STATE{$playlist} ||= {};
1973 my $filestate = $STATE{filestate} ||= {};
1974
1975 my $conf = $CONF_PLAYLIST{$playlist};
1976
1977 my $self = {
1978 playlist => $playlist,
1979 path => $state->{cwd} // $conf->{cwd},
1980 state => $state,
1981 pathpfx => "",
1982 };
1983
1984 while () {
1985 win_clear;
1986 win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
1987 win_set 3, "preparing...";
1988 _win_refresh;
1989
1990 # file scanning/selection
1991 my $pathpfx = "";
1992
1993 my $mode;
1994
1995 my $filter_status;
1996 my $list_state = $state->{list_menu} ||= {};
1997
1998 if ($self->{state}{full_list}) {
1999 $mode = "full list";
2000
2001 $self->{full_list} = $self->{state}{full_list};
2002
2003 # remove missing files
2004 $self->{full_list} = [ grep -e $_->[1], @{ $self->{full_list} } ];
2005
2006 } elsif ($conf->{glob}) {
2007 $mode = sprintf "glob %s", dec join ",", @{ $conf->{glob} };
2008
2009 my @list;
2010
2011 for (@{ $conf->{glob} }) {
2012 push @list,
2013 sort { "\L$a->[0]" cmp "\L$b->[0]" }
2014 map { stat_video $_ }
2015 File::Glob::bsd_glob
2016 $_ =~ /^\// ? $_ : "$self->{path}/$_",
2017 File::Glob::GLOB_MARK | File::Glob::GLOB_BRACE;
2018 }
2019
2020 $self->{full_list} = \@list;
2021
2022 } elsif ($conf->{scan}) {
2023 ($pathpfx, $self->{full_list}) = $conf->{scan}($self->{path}, $self);
2024 $mode = sprintf "confscan %s", dec $pathpfx;
2025
2026 } elsif ($state->{scan}) {
2027 $mode = sprintf "$state->{scan} %s", dec $self->{path};
2028
2029 #$pathpfx = "$self->{path}/";
2030 $self->{full_list} = eval { $state->{scan}($self->{path}, $self) };
2031
2032 } else {
2033 $mode = "empty";
2034
2035 $self->{full_list} = undef;
2036 }
2037
2038 #$self->{full_list} ||= [["error", "error"]];
2039 $self->{full_list} ||= [];
2040 $self->{pathpfx} = $pathpfx;
2041
2042 $self->{list} = $self->{full_list};
2043
2044 if (defined $state->{filter_uploader}) {
2045 $filter_status .= " (uploader " . (enc $state->{filter_uploader}) . ")";
2046 $list_state = $state->{uploader_list_menu}{$state->{filter_uploader}} ||= {};
2047 my $re = qr/^\Q$state->{filter_uploader}\E-/;
2048 $self->{list} = [grep $_->[0] =~ $re, @{ $self->{list} }]
2049 }
2050
2051 if (defined $state->{filter_regex}) {
2052 $filter_status .= " (regex $state->{filter_regex})";
2053 my $re = qr/$state->{filter_regex}/;
2054 $self->{list} = [grep $_->[1] =~ $re, @{ $self->{list} }]
2055 }
2056
2057 my $DESC_H = 18;
2058
2059 my $list = new list
2060 list => $self->{list},
2061 state => $list_state,
2062 y0 => 4,
2063 y1 => $WIN_H - $DESC_H - 1,
2064 display_cb => sub {
2065 my @flags = (" ") x 5;
2066
2067 if (my $state = $filestate->{"$pathpfx$_[0][1]"}) {
2068 $flags[4] = "*" if $state->{started};
2069 $flags[3]= "\e[95mW\e[m" if $state->{watched};
2070 $flags[2]= "\e[31mD\e[m" if $state->{deleted};
2071 $flags[1]= "\e[94mA\e[m" if $state->{archive};
2072 $flags[0]= "\e[32mT\e[m" if $state->{tagged};
2073 }
2074
2075 "[" . (join "", @flags) . "] $_[1]"
2076 },
2077 ;
2078
2079 win_clear;
2080 win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
2081 win_set 1, "$playlist ($mode)";
2082 win_set 2, sprintf "%d entries overall, %d entries filtered%s",
2083 scalar @{ $self->{full_list} },
2084 scalar @{ $self->{list} },
2085 $filter_status,
2086 ;
2087
2088 while () {
2089 if (delete $self->{rescan}) {
2090 #scan_video_dir_clear_cache;
2091 last;
2092 }
2093
2094 return if @EXTERNAL;
2095
2096 state $mediainfo_jobid;
2097 state $mediainfo_pid;
2098
2099 while () {
2100 if ($DESC_H) {
2101 my $jobid = ++$mediainfo_jobid;
2102 if (my $entry = $list->selection) {
2103 my $name = $entry->[1];
2104
2105 open my $old_stdout, ">&", \*STDOUT;
2106 pipe my ($r, $w);
2107 open STDOUT, ">&", $w;
2108 close $w;
2109
2110 $mediainfo_pid = Proc::FastSpawn::spawn $::MEDIAINFO, ["mediainfo", "--Inform=General;%Description%", "--", "$pathpfx$name"];
2111
2112 if ($mediainfo_pid) {
2113 win_set $WIN_H - $DESC_H + 1, "fetching media description...";
2114 _win_refresh;
2115
2116 my $iow; $iow = EV::io $r, EV::READ, sub {
2117 $iow->stop;
2118
2119 return if $mediainfo_jobid != $jobid;
2120
2121 read $r, my $description, 8192;
2122 undef $mediainfo_pid;
2123 close $r;
2124
2125 utf8::decode $description;
2126 $description = "<no description>" unless $description =~ /\S/;
2127
2128 $description =~ s/ \/ /\n/g; # youtube-dl uses " / " or so to separate lines
2129
2130 if (stat "$pathpfx$name") {
2131 $description = sprintf "%s %s\n%s",
2132 (POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime +(stat _)[9]),
2133 (Format::Human::Bytes::base10 +(stat _)[7]),
2134 $description;
2135 }
2136
2137 local $Text::Wrap::columns = $WIN_W;
2138 my @description = grep /\S/, split /\n/, Text::Wrap::wrap "", "", $description;
2139
2140 for (0 .. $DESC_H - 1) {
2141 win_set $WIN_H - $DESC_H + 1 + $_, $description[$_];
2142 }
2143 _win_refresh;
2144 };
2145 }
2146
2147 open STDOUT, ">&", $old_stdout;
2148 }
2149 };
2150
2151 my $handled = $list->handle_events;
2152
2153 if ($DESC_H) {
2154 ++$mediainfo_jobid;
2155 kill 9, $mediainfo_pid if $mediainfo_pid;
2156 for ($WIN_H - $DESC_H .. $WIN_H - 1) {
2157 win_set $_, "";
2158 }
2159 win_refresh;
2160 }
2161
2162 last unless $handled;
2163 }
2164
2165 input_context "view";
2166
2167 my $entry = $list->selection;
2168 my $name = $entry->[1];
2169 my $filestate = $filestate->{"$pathpfx$name"} ||= {};
2170
2171 if ($INPUT eq "list/select" or $INPUT eq "play" or $INPUT eq "pause") {
2172 $filestate->{started} = int AE::now;
2173 my $uploader = "$pathpfx$name" =~ /00_distant_worlds/ && $name =~ /^([^-]+)-/ ? $1 : undef;
2174
2175 my @uploader_props = qw(mpv_sid speed);
2176
2177 if ($uploader) {
2178 for (@uploader_props) {
2179 $filestate->{$_} //= $STATE{"uploader_$_"}{$uploader};
2180 }
2181 }
2182
2183 ::state_save;
2184 win_nest {
2185 play_video $filestate, "$pathpfx/$name", $INPUT ne "play";
2186 };
2187
2188 if ($uploader) {
2189 for (@uploader_props) {
2190 if ($filestate->{$_} != $STATE{"uploader_$_"}{$uploader}) {
2191 $STATE{"uploader_$_"}{$uploader} = $filestate->{$_};
2192 ::state_save;
2193 }
2194 }
2195 }
2196
2197 ++$list->{cur} if $filestate->{watched};
2198 $list->changed;
2199
2200 } else {
2201 if ($INPUT eq "esc") {
2202 EV::unloop;
2203
2204 } elsif ($INPUT eq "return") {
2205 prepare_exit;
2206 exec $0, "--restart";
2207
2208 } elsif ($INPUT =~ /^(?:next|prev|intfwd|intrev|triangle|circle)$/) {
2209 win_nest {
2210 menu_playlist;
2211 };
2212
2213 } elsif ($INPUT eq "red") {
2214 $filestate->{deleted} ? delete $filestate->{deleted} : ($filestate->{deleted} = 1);
2215 ::state_save;
2216 ++$list->{cur}; $list->changed;
2217
2218 } elsif ($INPUT eq "green") {
2219 $filestate->{watched} ? delete $filestate->{watched} : ($filestate->{watched} = 1);
2220 ::state_save;
2221 ++$list->{cur}; $list->changed;
2222
2223 } elsif ($INPUT eq "yellow") {
2224 $filestate->{started} ? delete $filestate->{started} : ($filestate->{started} = 1);
2225 ::state_save;
2226 ++$list->{cur}; $list->changed;
2227
2228 } elsif ($INPUT eq "blue") {
2229 $filestate->{archive} ? delete $filestate->{archive} : ($filestate->{archive} = 1);
2230 ::state_save;
2231 ++$list->{cur}; $list->changed;
2232
2233 } elsif ($INPUT eq "popup") {
2234 win_nest {
2235 dir_menu $self;
2236 };
2237
2238 } elsif ($INPUT eq "right") {
2239 win_nest {
2240 file_menu $self, "$pathpfx$name";
2241 };
2242 }
2243 }
2244 }
2245 }
2246 }
2247
2248 sub main {
2249 while () {
2250 if (my $args = shift @EXTERNAL) {
2251 state_save; # proactively request a state save since we are almost certain to change something
2252
2253 my $state = $STATE{ $STATE{curdir} // "/videos" } ||= {};
2254
2255 if ($args->[0] =~ /^--regex=(.*)/) {
2256 $state->{filter_regex} = dec $1;
2257 next;
2258 } elsif ($args->[0] =~ /^--uploader=(.*)/) {
2259 $STATE{"/videos"}{filter_uploader} = dec $1;
2260 next;
2261 } elsif ($args->[0] =~ /^--playlist=\/*(.*)/) {
2262 $STATE{curdir} = dec "/$1";
2263 next;
2264 } elsif ($args->[0] =~ /^--rescan$/) {
2265 next;
2266 }
2267
2268 my $playlist = @$args > 1 ? "/playlist" : "/playlist1";
2269
2270 if ($args->[0] =~ /--list=\/*(.*)/) {
2271 shift @$args;
2272 $playlist = dec "/$1";
2273 }
2274
2275 if ($args->[0] =~ /^--/) {
2276 next; # error case
2277 }
2278
2279 # playlist / directory
2280
2281 $STATE{curdir} = $playlist;
2282
2283 my $pl = $STATE{$playlist} ||= {};
2284
2285 delete $pl->{full_list};
2286 delete $pl->{cwd};
2287
2288 if ($args->[0] eq "-r") {
2289 $pl->{cwd} = canonpath $args->[1];
2290 $pl->{scan} = "state_scan_recursive";
2291
2292 } elsif (@$args == 1 && -d $args->[0]) {
2293 # single directory given, play directory
2294 $pl->{cwd} = canonpath $args->[0];
2295
2296 } else {
2297 # playlist, must be all files => create playlist with files
2298
2299 $pl->{full_list} = [map { ref ? $_ : stat_video canonpath $_ } @$args];
2300
2301 ::input_feed "enter" if @$args == 1; #d# hack: auto-play when single video
2302 }
2303 }
2304
2305 wakeup;
2306 view_playlist $STATE{curdir} // "/videos";
2307 }
2308 }
2309
2310 $WIN_READY->recv;
2311
2312 our $MAIN_CORO;
2313
2314 sub state_expire {
2315 my $filestate = $STATE{filestate};
2316
2317 if ($DOOM) { # only do it on doom
2318 # filter out old/empty state
2319
2320 while (my ($k, $v) = each %$filestate) {
2321 unless (%$v and -e $k) {
2322 delete $filestate->{$k};
2323 }
2324 }
2325 }
2326
2327 if (0) {
2328 for my $k (keys %$filestate) {
2329 my $k2 = $k =~ s%//+%/%gr;
2330 $k2 =~ s%^/fs/fuji/fs/doom/%/fs/doom/%;
2331 $k2 =~ s%^/fs/doom/fs/doom/%/fs/doom/%; # / <- vio fix
2332 if ($k2 ne $k) {
2333 $filestate->{$k2} = delete $filestate->{$k};
2334 }
2335 }
2336 }
2337 }
2338
2339 sub main_start {
2340 $MAIN_CORO ||= async {
2341 mpv_init;
2342 $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
2343
2344 if ($ARGV[0] eq "--state-reload") {
2345 win_progress "\e[31mstate was externally modified, press enter to reload and proceed";
2346
2347 while () {
2348 input_next "reload";
2349 last if $INPUT eq "enter" or $INPUT eq "return";
2350 }
2351
2352 win_clear;
2353 }
2354
2355 state_init;
2356 #use Data::Dump; ddx \%STATE;#d#
2357
2358 conf_check;
2359 state_expire;
2360
2361 main;
2362 EV::unloop;
2363 };
2364 }
2365
2366 sub state_file_check {
2367 if ($STATE_MTIME != (stat $STATE_FILE)[9]) {
2368 return if $TESTING;
2369
2370 $MAIN_CORO->safe_cancel;
2371 unlink $STATE_SHM;
2372 $mpv->stop;
2373 exec $0, "--state-reload";
2374 die "state changed, aborting to reload hack\n";
2375 async {
2376 win_clear;
2377 };
2378 }
2379 }
2380
2381 main_start;
2382 EV::loop;
2383 prepare_exit;
2384