ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/doomfrontend/doomfrontend
Revision: 1.1
Committed: Sat Mar 25 16:27:19 2023 UTC (14 months, 2 weeks ago) by root
Branch: MAIN
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" && $ENV{LD_PRELOAD} !~ /libmimalloc/) {
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 "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/var/lib/mythvideo/02_ytd/00_distant_worlds";
86 our $ARCHIVE_DIR = "/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 $path = Cwd::realpath $path;
892 $path = "/fs/$NODENAME$path" unless $path =~ /^\/fs\//;
893
894 $path
895 }
896
897 # check path for mythtv
898 sub is_myth($) {
899 my $a = canonpath $_[0];
900 my $b = canonpath $MYTHTV_DIR;
901 $a =~ /^\Q$b\E/
902 }
903
904 our $CONF_MTIME;
905 our $CONF;
906 our %CONF_PLAYLIST;
907 our @CONF_PLAYLIST_ORDER;
908
909 sub conf_postload {
910 %CONF_PLAYLIST = ();
911 @CONF_PLAYLIST_ORDER = ();
912
913 my @pl = @{ $CONF->{playlists} };
914 while (@pl) {
915 my ($k, $v) = splice @pl, 0, 2;
916
917 $k = "/$k";
918
919 push @CONF_PLAYLIST_ORDER, $k
920 unless $v->{hide};
921
922 $v->{cwd} = canonpath $v->{cwd} // $VIDEO_DIR;
923
924 my $state = $STATE{$k} //= {};
925 $CONF_PLAYLIST{$k} = $v;
926 $state->{from_conf} = 1;
927 }
928 }
929
930 sub conf_check {
931 if ((stat $CONF_FILE)[9] != $CONF_MTIME) {
932 warn "reloading $CONF_FILE...\n";
933
934 $CONF_MTIME = (stat _)[9];
935 $CONF = do $CONF_FILE;
936
937 warn $@ if $@;
938
939 conf_postload;
940 }
941 }
942
943 #############################################################################
944
945 sub playlist_names {
946 (
947 @CONF_PLAYLIST_ORDER,
948 grep
949 /^\//
950 && !exists $CONF_PLAYLIST{$_},
951 sort keys %STATE
952 )
953 }
954
955 sub stat_video($;$) {
956 my ($path, $prefix) = @_;
957
958 my $display = $path =~ s%^.*/%%r;
959
960 $display =~ /^\./ and return;
961 $display =~ /\..{2,5}$/ or return;
962
963 #next unless $name =~ /\.(mp4|mkv|webm|flv|ogg|mp3|m4a|mov|mpg|avi|ogv)$/i;
964
965 utf8::downgrade $path;
966
967 stat "$prefix$path" or return;
968 -f _ or return;
969
970 utf8::decode $display;
971
972 for ($display) {
973
974 #s%\.[A-Za-z0-9]{3,4}$%%; # .mp4
975 #s%-[A-Za-z0-9\-_]{11}$%%; # youtube-id
976 s%-[A-Za-z0-9\-_]{11}.(mkv|webm|mp4|mov)$%.$1%; # youtube-id
977
978 sub dfe::mangle_name ();
979 dfe::mangle_name;
980
981 # "improve" some filenames/episode numbers, mostly for sorting
982 s{(?:\bpart|\bep\.?|episode|Ch\.|Chapter|\bE)\s*#?(\d+)\b}{sprintf "Ep.%03d", $1}geia;
983 #s{(-\s*)(\d{1,4})(\s*-)}{sprintf "%s#%03d%s", $1, $2, $3}geia;
984 s{\s+#(\d+)}{sprintf " #%03d", $1}geia;
985 s{\[#?(\d+)\]}{sprintf "#%03d", $1}geia;
986 s{\bs(\d+)e(\d+)\b}{sprintf "S%02dE%02d", $1, $2}geia;
987
988 s{-20(\d\d)(\d\d)(\d\d)\.([^.]+)\z}{-20$1.$2.$3.$4}a;
989
990 s/\s+/ /g;
991 }
992
993 $display = sprintf "%s [%dMB]", $display, (-s _) * 1e-6;
994
995 [$display, $path]
996 }
997
998 sub video_sort {
999 # schwartzian version sort on filename
1000 map $_->[0],
1001 sort { $a->[1] cmp $b->[1] }
1002 map [$_, lc $_->[0] =~ s/([0-9]+)/sprintf "%19d", $1/ger],
1003 @_
1004 }
1005
1006 my $video_dir_cache;
1007
1008 sub scan_video_dir($) {
1009 my ($path) = @_;
1010
1011 my $cache = $video_dir_cache->{$path};
1012
1013 opendir my $dir, $path
1014 or return []; #die "$path: $!\n";
1015 my $mtime = (stat $dir)[9];
1016
1017 if ($mtime != $cache->[0]) {
1018 # hack to preload cache a bit
1019
1020 $cache = $cache->[1];
1021
1022 my @files =
1023 grep !/(?:\.(?:json|srt|vtt|part|ytdl|chapters|f\d\d\d\.[^.]+)$)/a,
1024 readdir $dir;
1025
1026 win_progress_init "scan_video_dir", $path;
1027
1028 # pre-cache files
1029 for my $file (@files) {
1030 IO::AIO::aio_stat "$path/$file"
1031 unless exists $cache->{$file};
1032 }
1033
1034 my %new_cache;
1035 my $progress = 0;
1036 for my $file (@files) {
1037 $new_cache{$file} = (delete $cache->{$file}) || (stat_video "$path/$file") || next;
1038
1039 win_progress_update 2, "$progress/" . @files
1040 unless ++$progress & 15;
1041 }
1042
1043 $cache = $video_dir_cache->{$path} = [$mtime, \%new_cache];
1044
1045 win_progress_done;
1046 }
1047
1048 [ video_sort values %{$cache->[1]} ]
1049 }
1050
1051 sub scan_video_dir_clear_cache() {
1052 $video_dir_cache = undef;
1053 }
1054
1055 sub scan_00_distant_worlds {
1056 (
1057 "",
1058 [
1059 video_sort #d#
1060 @{ scan_video_dir "/fs/doom/root/00_distant_worlds" },
1061 @{ scan_video_dir "/fs/doom/root/ytnew" },
1062 @{ scan_video_dir "/seagate2tb/sinatar" },
1063 ]
1064 )
1065 }
1066
1067 sub scan_islands($) {
1068 my ($path) = @_;
1069
1070 my $list = scan_video_dir $path;
1071
1072 my %byuploader;
1073 for (@$list) {
1074 push @{ $byuploader{$1} }, $_
1075 if $_->[1] =~ /^([^-]+)-/;
1076 }
1077
1078 (
1079 "",
1080 [
1081 sort { "\L$a->[0]" cmp "\L$b->[0]" }
1082 map @$_,
1083 grep @$_ <= MAX_ISLANDS,
1084 values %byuploader
1085 ]
1086 )
1087 }
1088
1089 sub state_scan_recursive($) {
1090 my ($path) = @_;
1091
1092 my @list;
1093
1094 my $scan = sub {
1095 my ($path, $display) = @_;
1096
1097 my @dirs;
1098
1099 opendir my $fh, $path
1100 or return;
1101 for (sort readdir $fh) {
1102 next if /^\.\.?$/;
1103 stat "$path/$_" or next;
1104
1105 if (-d _) {
1106 my $dis = dec $_;
1107 $dis = length $dis > 25 ? (substr $dis, 0, 24) . "…" : $dis;
1108
1109 push @dirs, ["$path/$_", "$display/$dis"];
1110
1111 } elsif (-f _) {
1112 my $dis = dec $_;
1113 push @list, [(substr "$display/$dis", 1), canonpath "$path/$_"];
1114 }
1115 }
1116
1117 __SUB__->(@$_)
1118 for @dirs;
1119 };
1120
1121 $scan->($path, "");
1122
1123 utf8::decode $_->[0] for @list;
1124
1125 \@list
1126 }
1127
1128 sub mythtv_dbh() {
1129 DBI->connect ("DBI:mysql:database=mythconverg;mysql_read_default_file=/root/.my.cnf;host=doom;user=root")
1130 or die "unable to connect to mythtv database"
1131 }
1132
1133 sub scan_mythtv($) {
1134 my $dbh = mythtv_dbh;
1135
1136 my $rv = $dbh->selectall_arrayref (
1137 "select basename, convert_tz(starttime, 'UTC', 'Europe/Berlin'), title, subtitle
1138 from recorded
1139 where recgroup not in ('Deleted', 'LiveTV')
1140 order by starttime asc
1141 ");
1142
1143 for (@$rv) {
1144 utf8::decode $_->[2];
1145 utf8::decode $_->[3];
1146 }
1147
1148 (
1149 "$MYTHTV_DIR/",
1150 [
1151 map ["$_->[1] " . (dec $_->[2]) . " (" . (dec $_->[3]) . ")", $_->[0]], @$rv
1152 ]
1153 )
1154 }
1155
1156 # delete /playlist, maybe switch away if current playlist
1157 sub playlist_delete {
1158 my ($playlist) = @_;
1159
1160 delete $STATE{$playlist};
1161
1162 if ($STATE{curdir} eq $playlist) {
1163 $STATE{curdir} = "/playlist";
1164 ::state_save;
1165 external "--playlist=playlist";
1166 }
1167 }
1168
1169 our ($PLAYING_STATE, $PLAYING_PATH);
1170
1171 sub play_video_speed_mult {
1172 sprintf "%.2f", 1.032 ** $PLAYING_STATE->{speed}
1173 }
1174
1175 sub play_video_set_speed {
1176 my $speed = play_video_speed_mult;
1177 delete $PLAYING_STATE->{speed} unless $PLAYING_STATE->{speed};
1178
1179 $mpv->cmd ("set", "speed", "$speed");
1180 $mpv->cmd ("show-text", "playback speed $speed");
1181 }
1182
1183 our $OSD_LEVEL = $DOOM ? 3 : 3; # was 1 on doom
1184
1185 sub sprintf_time($$) {
1186 sprintf $_[0],
1187 sprintf "%02d:%02d:%02d.%03d",
1188 $_[1] / 60 / 60 % 60,
1189 $_[1] / 60 % 60,
1190 $_[1] % 60,
1191 $_[1] * 1000 % 1000;
1192 }
1193
1194 my $curfps;
1195
1196 sub set_fps {
1197 return unless $DOOM;
1198
1199 my ($target) = @_;
1200
1201 my $new = $XRANDR_FPS;
1202
1203 if (defined $target) {
1204 my $maxerr = 0.02; # max. 2% off allowed
1205 for (@XRANDR_RATES) {
1206 for my $div (1..10) {
1207 my $err = abs ($target * $div / $_->[0] - 1);
1208 if ($err < $maxerr) {
1209 $maxerr = $err;
1210 $new = $_->[0];
1211 }
1212 }
1213 }
1214 }
1215
1216 if ($curfps != $new && defined $new) {
1217 warn "REFRESHRATE CHANGE current=$curfps, target=$target, selected=$new\n";
1218 system "xrandr", "--output", $XRANDR_OUTPUT, "--mode", $XRANDR_MODE, "--rate", $new;
1219 $curfps = $new;
1220 }
1221 }
1222
1223 # does not work: deinterlace, because it returns a boolean and expects i have no clue
1224 our %SAVE_PROPERTY = (aid => 1, sid => 1, "audio-delay" => 1);
1225
1226 sub mpv_init {
1227 $mpv->start ("--idle=yes", "--pause", "--force-window=no"); # "--start=$playback_start", "--", $mpv_path;
1228
1229 for (
1230 List::Util::pairs qw(
1231 ESC return
1232 q return
1233 ENTER enter
1234 SPACE pause
1235 [ steprev
1236 ] stepfwd
1237 j subtitle
1238 BS red
1239 i green
1240 o yellow
1241 b blue
1242 D triangle
1243 UP up
1244 DOWN down
1245 RIGHT right
1246 LEFT left
1247 ),
1248 (map { ("KP$_" => "num$_") } 0..9),
1249 KP_INS => 0, # KP0, but different
1250 ) {
1251 $mpv->bind_key ($_->[0] => $_->[1]);
1252 }
1253
1254 $mpv->cmd (observe_property => 1, "chapter-metadata");
1255
1256 eval {
1257 # the profile is optional
1258 $mpv->cmd ("apply-profile" => "doomfrontend");
1259 };
1260 }
1261
1262 sub play_video {
1263 ($PLAYING_STATE, $PLAYING_PATH, my $continue) = @_;
1264
1265 my $playback_start;
1266
1267 if ($continue) {
1268 $playback_start = $PLAYING_STATE->{curpos} // 0;
1269 } else {
1270 my @menu = ([beginning => 0], [cancel => undef]);
1271
1272 for my $idx (reverse 0..9) {
1273 if (my $pos = $PLAYING_STATE->{"bookmark$idx"}) {
1274 unshift @menu, [(sprintf_time "bookmark $idx (%s)", $pos) => $pos];
1275 }
1276 }
1277
1278 if (my $pos = $PLAYING_STATE->{curpos}) {
1279 unshift @menu, [(sprintf_time "current (%s)", $pos) => $pos];
1280 }
1281
1282 if (@menu > 2) {
1283 win_clear;
1284 win_set 3, "\e[33mmultiple start locations available:";
1285
1286 my $selection = menu_choice
1287 list => \@menu,
1288 y0 => 5,
1289 return => $#menu,
1290 left => $#menu,
1291 ;
1292
1293 $playback_start = $selection->[1];
1294
1295 defined $playback_start
1296 or return;
1297
1298 } else {
1299 $playback_start = 0;
1300 }
1301 }
1302
1303 win_clear;
1304 win_set 0, "starting video...";
1305 _win_refresh;
1306
1307 my $mpv_path = $PLAYING_PATH;
1308 my $initial_deinterlace;
1309
1310 if (is_myth $mpv_path) {
1311 $mpv_path = "appending://$mpv_path";
1312 $initial_deinterlace = 1;
1313 }
1314
1315 $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
1316 $mpv->cmd ("set", "vid", "auto");
1317 $mpv->cmd ("set", "aid", "auto");
1318 $mpv->cmd ("set", "sid", "no");
1319 $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters"));
1320 $mpv->cmd ("loadfile", $mpv->escape_binary ($mpv_path));
1321 $mpv->cmd ("script-message", "osc-visibility", "auto", "dummy");
1322 #$mpv->cmd ("playlist-clear");
1323
1324 my $oid = 100;
1325
1326 #$mpv->cmd ("observe_property", ++$oid, "shared-script-properties");
1327
1328 #$mpv->cmd ("get_property", "playback-time");
1329 #$mpv->cmd ("get_time_us");
1330
1331 my $playback_time;
1332
1333 my $status = 0;
1334 my $arg;
1335
1336 my $fps;
1337
1338 my $skip_delay;
1339
1340 while () {
1341 input_next "play";
1342
1343 if ($INPUT =~ /^num([0-9])$/ or $INPUT eq "red") {
1344 $INPUT eq "red"
1345 ? substr $arg, -1, 1, ""
1346 : ($arg .= $1);
1347
1348 $mpv->cmd ("osd-msg", "show-text", "argument: ${arg}_", 600000);
1349 $mpv->cmd ("osd-msg", "show-text", "") unless length $arg;
1350 next;
1351 }
1352
1353 if ($INPUT eq "mpv/quit") { # should not happen, but allows user to kill etc. without consequence
1354 $status = 1;
1355 mpv_init; # try reinit
1356 last;
1357
1358 } elsif ($INPUT eq "mpv/idle") { # normal end-of-file
1359 last;
1360
1361 } elsif ($INPUT eq "return") {
1362 $status = 1;
1363 last;
1364
1365 } elsif ($INPUT eq "mpv/file-loaded") { # start playing, configure video
1366 $mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0;
1367
1368 my $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60;
1369 $target_fps *= play_video_speed_mult;
1370 set_fps $target_fps;
1371
1372 unless (eval { $mpv->cmd_recv ("get_property", "video-format") }) {
1373 # assume audio-only TODO: better test
1374 $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]");
1375 };
1376
1377 for my $prop (keys %SAVE_PROPERTY) {
1378 if (exists $PLAYING_STATE->{"mpv_$prop"}) {
1379 $mpv->cmd ("set", "$prop", $PLAYING_STATE->{"mpv_$prop"} . "");
1380 }
1381
1382 $mpv->cmd ("observe_property", ++$oid, $prop);
1383 }
1384
1385 play_video_set_speed;
1386 $mpv->cmd ("set", "osd-level", "$OSD_LEVEL");
1387 $mpv->cmd ("observe_property", ++$oid, "osd-level");
1388 $mpv->cmd ("set", "pause", "no");
1389
1390 $mpv->cmd ("set_property", "deinterlace", "yes")
1391 if $initial_deinterlace;
1392
1393 $mpv->cmd ("show-text", "FPS: target $target_fps, current $curfps", 2000)
1394 if $curfps != $fps;#d#
1395
1396 win_clear;
1397
1398 } elsif ($INPUT eq "stepfwd") {
1399 ++$PLAYING_STATE->{speed};
1400 play_video_set_speed;
1401 ::state_save;
1402 } elsif ($INPUT eq "steprev") {
1403 --$PLAYING_STATE->{speed};
1404 play_video_set_speed;
1405 ::state_save;
1406
1407 } elsif ($INPUT eq "pause") {
1408 $mpv->cmd ("cycle", "pause");
1409 $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1410 ::state_save;
1411
1412 } elsif ($INPUT eq "green") {
1413 if (length $arg) { # seek-to
1414 if ($arg <= 99) { # MM
1415 $arg = sprintf "%02d:00", $arg;
1416 } elsif ($arg <= 9999) { # HHMM
1417 $arg = sprintf "%02d:%02d:00", $arg / 100, $arg % 100;
1418 } else { # HHMMSS
1419 $arg = sprintf "%02d:%02d:%02d", $arg / 100 / 100, $arg / 100 % 100, $arg % 100;
1420 }
1421 $mpv->cmd ("osd-msg", "seek", $arg, "absolute+exact");
1422 } else {
1423 $mpv->cmd ("osd-msg-bar", "show-progress");
1424 }
1425
1426 } elsif ($INPUT eq "yellow") {
1427 $mpv->cmd ("osd-auto", "cycle-values", "osd-level", "2", "3", "0", "1");
1428
1429 } elsif ($INPUT eq "right") {
1430 $mpv->cmd ("osd-msg-bar", "seek", $arg * 60 || 30, "relative+exact");
1431 } elsif ($INPUT eq "left") {
1432 $mpv->cmd ("osd-msg-bar", "seek", -$arg * 60 || -5, "relative+exact");
1433 } elsif ($INPUT eq "up") {
1434 $mpv->cmd ("osd-msg-bar", "seek", +600, "relative+exact");
1435 } elsif ($INPUT eq "down") {
1436 $mpv->cmd ("osd-msg-bar", "seek", -600, "relative+exact");
1437 } elsif ($INPUT eq "select") {
1438 $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "-0.100");
1439 } elsif ($INPUT eq "start") {
1440 $mpv->cmd ("osd-msg-bar", "add", "audio-delay", "0.100");
1441 } elsif ($INPUT eq "intfwd") {
1442 $mpv->cmd ("no-osd", "frame-step");
1443 } elsif ($INPUT eq "intrev") {
1444 $mpv->cmd ("no-osd", "frame-back-step");
1445
1446 } elsif ($INPUT eq "enter") {
1447 eval {
1448 my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1449 $mpv->cmd ("show-text", "saving bookmark $arg position at $pos");
1450 $PLAYING_STATE->{"bookmark$arg"} = $pos;
1451 ::state_save;
1452 };
1453
1454 } elsif ($INPUT eq "blue") { # recall bookmark
1455 my $pos = $mpv->cmd_recv ("get_property", "playback-time");
1456 $mpv->cmd ("no-osd", "seek", $PLAYING_STATE->{"bookmark$arg"}, "absolute+exact");
1457 $PLAYING_STATE->{"bookmark9"} = $pos;
1458 $mpv->cmd ("expand-properties", "show-text", "recalling bookmark $arg position \${playback-time}, recall bookmark 9 to return", 5000);
1459 ::state_save;
1460
1461 } elsif ($INPUT eq "square") {
1462 $mpv->cmd ("osd-auto", "screenshot", "video");
1463
1464 } elsif ($INPUT eq "audio") {
1465 $mpv->cmd ("osd-auto", "cycle", "audio");
1466
1467 } elsif ($INPUT eq "subtitle") {
1468 $mpv->cmd ("osd-auto", "cycle", "sub");
1469
1470 } elsif ($INPUT eq "triangle") {
1471 $mpv->cmd ("osd-auto", "cycle", "deinterlace");
1472
1473 } elsif ($INPUT eq "mpv/property-change") {
1474 my $prop = $INPUT_DATA->{name};
1475
1476 if ($prop eq "osd-level") {
1477 $OSD_LEVEL = $INPUT_DATA->{data};
1478 #win_set 0, "playback position $playback_time";
1479 #warn "$playback_time\n";#d#
1480 #$mpv->cmd ("expand-properties", "show-text", '${time-pos}', "1500");
1481 } elsif ($prop eq "chapter-metadata") {
1482 if ($INPUT_DATA->{data}{TITLE} =~ /^\[SponsorBlock\]: (.*)/) {
1483 my $section = $1;
1484 my $skip;
1485
1486 $skip ||= $SPONSOR_SKIP{$_}
1487 for split /\s*,\s*/, $section;
1488
1489 if (defined $skip) {
1490 if ($skip) {
1491 # delay a bit, in case we get two metadata changes in quick succession, e.g.
1492 # because we have a skip at file load time.
1493 $skip_delay = AE::timer 2/50, 0, sub {
1494 $mpv->cmd ("no-osd", "add", "chapter", 1);
1495 $mpv->cmd ("show-text", "skipped sponsorblock section \"$section\"", 3000);
1496 };
1497 } else {
1498 undef $skip_delay;
1499 $mpv->cmd ("show-text", "NOT skipping sponsorblock section \"$section\"", 3000);
1500 }
1501 } else {
1502 $mpv->cmd ("show-text", "UNRECOGNIZED sponsorblock section \"$section\"", 60000);
1503 }
1504 } else {
1505 # cancel a queued skip
1506 undef $skip_delay;
1507 }
1508
1509 } elsif (exists $SAVE_PROPERTY{$prop}) {
1510 $PLAYING_STATE->{"mpv_$prop"} = $INPUT_DATA->{data};
1511 ::state_save;
1512 }
1513 }
1514
1515 undef $arg;
1516 }
1517
1518 $mpv->cmd ("set", "pause", "yes");
1519
1520 while ($oid > 100) {
1521 $mpv->cmd ("unobserve_property", $oid--);
1522 }
1523
1524 if ($status) {
1525 eval {
1526 $PLAYING_STATE->{curpos} = $mpv->cmd_recv ("get_property", "playback-time");
1527 ::state_save;
1528 };
1529 warn $@ if $@;#d#
1530 } else {
1531 $PLAYING_STATE->{watched} = int AE::now;
1532 ::state_save;
1533 }
1534
1535 $mpv->cmd_recv ("stop");
1536
1537 # make sure state is clean, even if its slower
1538 $mpv->stop;
1539 mpv_init;
1540
1541 #if ($DPMS_DISABLE) {
1542 # system "xse", "-dpms";
1543 #}
1544 }
1545
1546 sub play_video_kodi($$$) {
1547 my ($host, $path, $state) = @_;
1548
1549 unlink "$KODIPATH/$host.bin";
1550 symlink $path, "$KODIPATH/$host.bin";
1551 system "chmod", "o+r", "--", "$KODIPATH/$host.bin";
1552
1553 my $conn; $conn = new AnyEvent::Handle
1554 connect => [$host, 9090],
1555 on_error => sub {
1556 $conn; # self-reference
1557
1558 my ($hdl, $fatal, $msg) = @_;
1559
1560 AE::log error => $msg;
1561
1562 $hdl->destroy;
1563 },
1564 ;
1565
1566 $conn->on_read (sub {
1567 warn $conn->{rbuf};
1568 });
1569
1570 $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.open", "params": {"item":{"file":"$KODIURL/$host.bin"}}}>);
1571 warn "$KODIURL/$host.bin";#d#
1572
1573 if (my $curpos = $state->{curpos}) {
1574 Coro::AnyEvent::sleep 1;
1575
1576 my $ms = int +($curpos - int $curpos) * 1000;
1577 my $s = int $curpos % 60;
1578 my $m = int $curpos / 60 % 60;
1579 my $h = int $curpos / 60 / 60 ;
1580
1581 $conn->push_write (qq<{"jsonrpc":"2.0","method":"player.seek", "params": {"playerid":1, "value":{"hours":$h, "minutes":$m, "seconds":$s, "milliseconds":$ms}}}>);
1582 }
1583
1584 $conn->push_shutdown;
1585 }
1586
1587 sub mangle_edit($$) {
1588 my ($playlist, $path) = @_;
1589
1590 my $base = basename $path;
1591
1592 my ($uploader, $title) = split /-/, basename $base;
1593
1594 my @pats;
1595
1596 utf8::decode $title; # filename must be utf-8, now unicode
1597
1598 while ($title =~ /(?:(\w+|\S+)|([[:space:]:!,‐]+))/mgs) {
1599 my ($w, $W) = ($1, $2);
1600 if (defined $w) {
1601 $w = quotemeta $w;
1602 $w =~ s/\d+/\\d+/g;
1603 push @pats, $w;
1604 } elsif ($W eq " ") {
1605 push @pats, " ";
1606 } else {
1607 push @pats, "\\W+?";
1608 }
1609 }
1610
1611 #utf8::encode $_ for @pats;
1612
1613 my ($o, $l) = (1, 0);
1614
1615 my $patterns = $STATE{mangle_config}{$uploader};
1616
1617 my $list_state = { curidx => 1 };
1618
1619 my $rescan;
1620
1621 while () {
1622 win_clear;
1623 win_set 1, "\e[33mmangle editor";
1624 win_set 3, dec $base;
1625 win_set 6, "keyboard: 4=left, 6=right, 8=extend, 2=shrink; remote: prev=left, next=right, instant=extend/shrink";
1626
1627 $o = 0 if $o < 0;
1628 $o = $#pats if $o > $#pats;
1629 $l = 0 if $l < 0;
1630 $l = $#pats - $o if $l > $#pats - $o;
1631
1632 my $edit = "";
1633 for my $i (0 .. $#pats) {
1634 $edit .= "<\e[30;43m" if $i == $o;
1635 $edit .= $pats[$i];
1636 $edit .= "\e[m>" if $i == $o + $l;
1637 }
1638
1639 win_set 8, "\e[36mpattern edit ($o+$l):\e[0m $edit";
1640 win_set 10, "resulting pattern: <\e[33m" . (join "", @pats[$o .. $o+$l]) . "\e[m>";
1641
1642 my @list = (
1643 ["return", sub { last }],
1644 ["add pattern", sub {
1645 push @$patterns, join "", @pats[$o .. $o+$l];
1646 $rescan = 1;
1647 last;
1648 }],
1649 ["use time for all (add empty pattern)", sub {
1650 push @$patterns, "";
1651 $rescan = 1;
1652 last;
1653 }],
1654 );
1655
1656 for my $pattern (@$patterns) {
1657 push @list, ["remove: <$pattern>", sub {
1658 $patterns = [grep $_ ne $pattern, @$patterns];
1659 $list_state->{curidx} = 0; # return
1660 $rescan = 1;
1661 }];
1662 }
1663
1664 my $menu = new list
1665 state => $list_state,
1666 y0 => 13,
1667 return => 0,
1668 left => 0,
1669 list => \@list,
1670 ;
1671
1672 1 while $menu->handle_events;
1673
1674 if ($INPUT eq "list/select") {
1675 $menu->selection->[1]();
1676 } elsif ($INPUT eq "4" or $INPUT eq "prev") {
1677 --$o;
1678 } elsif ($INPUT eq "6" or $INPUT eq "next") {
1679 ++$o;
1680 } elsif ($INPUT eq "8" or $INPUT eq "intfwd") {
1681 ++$l;
1682 } elsif ($INPUT eq "2" or $INPUT eq "intrev") {
1683 --$l;
1684 }
1685 }
1686
1687 if ($rescan) {
1688 if (@$patterns) {
1689 $STATE{mangle_config}{$uploader} = $patterns;
1690 } else {
1691 delete $STATE{mangle_config}{$uploader};
1692 }
1693
1694 state_save;
1695
1696 sub dfe::mangle_reconfig ();
1697 dfe::mangle_reconfig;
1698
1699 $playlist->{rescan} = 1;
1700 }
1701 }
1702
1703 sub file_menu($$) {
1704 my ($playlist, $path) = @_;
1705
1706 my $state = $STATE{filestate}{$path};
1707
1708 my $menu = new list
1709 y0 => 10,
1710 return => 0,
1711 left => 0,
1712 list => [
1713 ["return", sub { last }],
1714 ["clear state", sub { %$state = (); last }],
1715 ["kodiplay mate10", sub { play_video_kodi "loki-mate10pro", $path, $state }],
1716 ["toggle watched", sub { $state->{watched} = !$state->{watched}; last }],
1717 ["toggle deleted", sub { $state->{deleted} = !$state->{deleted}; last }],
1718 ["toggle archive", sub { $state->{archive} = !$state->{archive}; last }],
1719 ["toggle tagged" , sub { $state->{tagged} = !$state->{tagged} ; last }],
1720 ["mangle editor" , sub { mangle_edit $playlist, $path; last }],
1721 ];
1722
1723 win_clear;
1724 win_set 1, "\e[33mfile menu";
1725 win_set 3, dec $path;
1726
1727 while () {
1728 win_set 4, sprintf "watched:%d deleted:%d", $state->{watched}, $state->{deleted};
1729
1730 1 while $menu->handle_events;
1731
1732 $menu->selection->[1]() if $INPUT eq "list/select";
1733 }
1734 }
1735
1736 sub live_tv {
1737 win_nest {
1738 play_video {}, "dvb://", 0;
1739 };
1740 }
1741
1742 sub dir_menu {
1743 my ($self) = @_;
1744
1745 my $filter_update = sub {
1746 $self->{state}{list_menu}{curidx} = 0;
1747 $self->{rescan} = 1;
1748 };
1749
1750 my $do_unlink = sub {
1751 my ($filter) = @_;
1752
1753 my $filestate = $STATE{filestate};
1754
1755 my $pathpfx = $self->{pathpfx};
1756 my $list = $self->{list};
1757
1758 my $empty = 1;
1759
1760 for (@$list) {
1761 if ($filter->($filestate->{"$pathpfx$_->[1]"})) {
1762 $self->{rescan} = 1;
1763 IO::AIO::aio_unlink "$pathpfx/$_->[1]";
1764 IO::AIO::aio_unlink "$pathpfx/$_->[1].chapters";
1765 } else {
1766 $empty = 0;
1767 }
1768 }
1769
1770 if ($empty) {
1771 playlist_delete $self->{playlist};
1772 }
1773
1774 IO::AIO::flush; #d# should do a group, but I am too lazy
1775 };
1776
1777 my $do_archive = sub {
1778 my $filestate = $STATE{filestate};
1779
1780 while (my ($path, $state) = each %$filestate) {
1781 if ($state->{archive}) {
1782 $self->{rescan} = 1;
1783 system "mv", "-v", "-b", $path, $ARCHIVE_DIR;
1784 }
1785 }
1786 };
1787
1788 my $filter_uploader = sub {
1789 my @menu = (["\e[32mreturn"], ["\e[32mclear filter", undef]);
1790
1791 my %uploader;
1792
1793 for (@{ $self->{full_list} }) {
1794 ++$uploader{$1} if $_->[0] =~ /^([^-]+)/;
1795 }
1796
1797 push @menu,
1798 map [(sprintf "[%4d] %s", $uploader{$_}, dec $_), $_],
1799 grep $uploader{$_} >= MAX_ISLANDS,
1800 sort { "\L$a" cmp "\L$b" } keys %uploader;
1801
1802 my $menu = new list
1803 y0 => 3,
1804 return => 0,
1805 state => ($self->{state}{filter_uploader_menu} ||= {}),
1806 list => \@menu,
1807 ;
1808
1809 while () {
1810 win_clear;
1811 win_set 1, "\e[33mselect uploader";
1812
1813 1 while $menu->handle_events;
1814
1815 if ($INPUT eq "list/select") {
1816 my $sel = $menu->selection;
1817
1818 if (@$sel >= 2) {
1819 $self->{state}{filter_uploader} = $sel->[1];
1820 $filter_update->();
1821 }
1822
1823 last;
1824 }
1825 }
1826 };
1827
1828 my $chdir = sub {
1829 while () {
1830 my @menu = (["\e[32mreturn"]);
1831
1832 push @menu, [$_, $_]
1833 for playlist_names;
1834
1835 my $menu = new list
1836 y0 => 3,
1837 return => 0,
1838 list => \@menu,
1839 ;
1840
1841 while () {
1842 win_clear;
1843 win_set 1, "\e[33mselect playlist";
1844
1845 1 while $menu->handle_events;
1846
1847 if ($INPUT eq "list/select") {
1848 my $sel = $menu->selection;
1849
1850 if (@$sel >= 2) {
1851 external "--playlist=" . substr $sel->[1], 1;
1852 }
1853
1854 return;
1855
1856 } elsif ($INPUT eq "red") {
1857 my $sel = $menu->selection;
1858 delete $STATE{$sel->[1]};
1859 state_save;
1860 last;
1861 }
1862 }
1863 }
1864 };
1865
1866 my $menu = new list
1867 y0 => 10,
1868 return => 0,
1869 list => [
1870 ["return", sub { last }],
1871 ["delete marked as Deleted or Watched", sub { $do_unlink->(sub { $_[0]{deleted} || $_[0]{watched} }); last }],
1872 ["filter uploader" , sub { win_nest { $filter_uploader->() }; last }],
1873 ["delete marked as Watched" , sub { $do_unlink->(sub { $_[0]{watched} }); last }],
1874 ["delete marked as Deleted" , sub { $do_unlink->(sub { $_[0]{deleted} }); last }],
1875 ["clear uploader filter" , sub { delete $self->{state}{filter_uploader}; $filter_update->(); last; }],
1876 ["clear regex filter" , sub { delete $self->{state}{filter_regex}; $filter_update->(); last; }],
1877 ["archive marked as Archive" , sub { $do_archive->(); last }],
1878 #["run xdfe" , sub { system "/fs/doom/root/xdfe"; last }],
1879 ["play live tv" , sub { live_tv; last; }],
1880 ["delete this playlist" , sub { playlist_delete $STATE{curdir}; last } ],
1881 ["rescan playlist" , sub { $self->{rescan} = 1; last }],
1882 ["change playlist" , sub { win_nest { $chdir->() }; last }],
1883 ["change to PLAYLIST" , sub { external "--playlist=playlist"; last }],
1884 ["change to VIDEO_DIR" , sub { external "--playlist=videos" ; last }],
1885 ];
1886
1887 while () {
1888 win_clear;
1889 win_set 1, "\e[33mdirectory menu";
1890
1891 1 while $menu->handle_events;
1892
1893 win_nest { $menu->selection->[1]() } if $INPUT eq "list/select";
1894 }
1895 }
1896
1897 sub menu_playlist {
1898 my @pl = playlist_names
1899 or return;
1900
1901 #@pl = reverse @pl unless $INPUT =~ /^(?:prev|intrev|triangle)$/;
1902
1903 my $cur = max 0, List::MoreUtils::firstidx { $_ eq $STATE{curdir} } @pl;
1904
1905 win_clear;
1906 win_set 0, "\e[33mPLAYLIST SELECT";
1907
1908 my $menu = new list
1909 y0 => 5,
1910 list => [map [$_], @pl],
1911 ;
1912
1913 my $autoselect = 2; # initial delay longer
1914
1915 while () {
1916 if ($INPUT =~ /^(?:next|intfwd|circle)$/) {
1917 ++$cur;
1918 } elsif ($INPUT =~ /^(?:prev|intrev|triangle)$/) {
1919 --$cur;
1920 } elsif ($INPUT eq "enter") {
1921 external "--playlist=" . substr $pl[$cur], 1;
1922 last;
1923 } elsif ($INPUT eq "return") {
1924 last;
1925 }
1926
1927 $cur %= @pl;
1928 $menu->{cur} = $cur;
1929 $menu->changed;
1930 $menu->draw;
1931
1932 my ($timer, $time);
1933 $time = AE::now;
1934 $timer = AE::timer 0, 1/30, sub {
1935 my $bar = int $WIN_W * min 1, (AE::now - $time) / $autoselect;
1936
1937 win_set 2, "\e[43m" . (" " x ($WIN_W - $bar)) . "\e[m";
1938 _win_refresh;
1939 input_feed "enter" if $bar >= $WIN_W;
1940 };
1941
1942 input_next "playlist";
1943
1944 $autoselect = 0.66; # subsequent delay shorter
1945 }
1946 }
1947
1948 sub view_playlist {
1949 my ($playlist) = @_;
1950
1951 my $state = $STATE{$playlist} ||= {};
1952 my $filestate = $STATE{filestate} ||= {};
1953
1954 my $conf = $CONF_PLAYLIST{$playlist};
1955
1956 my $self = {
1957 playlist => $playlist,
1958 path => $state->{cwd} // $conf->{cwd},
1959 state => $state,
1960 pathpfx => "",
1961 };
1962
1963 while () {
1964 win_clear;
1965 win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
1966 win_set 3, "preparing...";
1967 _win_refresh;
1968
1969 # file scanning/selection
1970 my $pathpfx = "";
1971
1972 my $mode;
1973
1974 my $filter_status;
1975 my $list_state = $state->{list_menu} ||= {};
1976
1977 if ($self->{state}{full_list}) {
1978 $mode = "full list";
1979
1980 $self->{full_list} = $self->{state}{full_list};
1981
1982 # remove missing files
1983 $self->{full_list} = [ grep -e $_->[1], @{ $self->{full_list} } ];
1984
1985 } elsif ($conf->{glob}) {
1986 $mode = sprintf "glob %s", dec join ",", @{ $conf->{glob} };
1987
1988 my @list;
1989
1990 for (@{ $conf->{glob} }) {
1991 push @list,
1992 sort { "\L$a->[0]" cmp "\L$b->[0]" }
1993 map { stat_video $_ }
1994 File::Glob::bsd_glob
1995 $_ =~ /^\// ? $_ : "$self->{path}/$_",
1996 File::Glob::GLOB_MARK | File::Glob::GLOB_BRACE;
1997 }
1998
1999 $self->{full_list} = \@list;
2000
2001 } elsif ($conf->{scan}) {
2002 ($pathpfx, $self->{full_list}) = $conf->{scan}($self->{path}, $self);
2003 $mode = sprintf "confscan %s", dec $pathpfx;
2004
2005 } elsif ($state->{scan}) {
2006 $mode = sprintf "$state->{scan} %s", dec $self->{path};
2007
2008 #$pathpfx = "$self->{path}/";
2009 $self->{full_list} = eval { $state->{scan}($self->{path}, $self) };
2010
2011 } else {
2012 $mode = "empty";
2013
2014 $self->{full_list} = undef;
2015 }
2016
2017 #$self->{full_list} ||= [["error", "error"]];
2018 $self->{full_list} ||= [];
2019 $self->{pathpfx} = $pathpfx;
2020
2021 $self->{list} = $self->{full_list};
2022
2023 if (defined $state->{filter_uploader}) {
2024 $filter_status .= " (uploader " . (enc $state->{filter_uploader}) . ")";
2025 $list_state = $state->{uploader_list_menu}{$state->{filter_uploader}} ||= {};
2026 my $re = qr/^\Q$state->{filter_uploader}\E-/;
2027 $self->{list} = [grep $_->[0] =~ $re, @{ $self->{list} }]
2028 }
2029
2030 if (defined $state->{filter_regex}) {
2031 $filter_status .= " (regex $state->{filter_regex})";
2032 my $re = qr/$state->{filter_regex}/;
2033 $self->{list} = [grep $_->[1] =~ $re, @{ $self->{list} }]
2034 }
2035
2036 my $DESC_H = 18;
2037
2038 my $list = new list
2039 list => $self->{list},
2040 state => $list_state,
2041 y0 => 4,
2042 y1 => $WIN_H - $DESC_H - 1,
2043 display_cb => sub {
2044 my @flags = (" ") x 5;
2045
2046 if (my $state = $filestate->{"$pathpfx$_[0][1]"}) {
2047 $flags[4] = "*" if $state->{started};
2048 $flags[3]= "\e[95mW\e[m" if $state->{watched};
2049 $flags[2]= "\e[31mD\e[m" if $state->{deleted};
2050 $flags[1]= "\e[94mA\e[m" if $state->{archive};
2051 $flags[0]= "\e[32mT\e[m" if $state->{tagged};
2052 }
2053
2054 "[" . (join "", @flags) . "] $_[1]"
2055 },
2056 ;
2057
2058 win_clear;
2059 win_set 0, "\e[33m" . ($conf->{title} // uc $playlist);
2060 win_set 1, "$playlist ($mode)";
2061 win_set 2, sprintf "%d entries overall, %d entries filtered%s",
2062 scalar @{ $self->{full_list} },
2063 scalar @{ $self->{list} },
2064 $filter_status,
2065 ;
2066
2067 while () {
2068 if (delete $self->{rescan}) {
2069 #scan_video_dir_clear_cache;
2070 last;
2071 }
2072
2073 return if @EXTERNAL;
2074
2075 state $mediainfo_jobid;
2076 state $mediainfo_pid;
2077
2078 while () {
2079 if ($DESC_H) {
2080 my $jobid = ++$mediainfo_jobid;
2081 if (my $entry = $list->selection) {
2082 my $name = $entry->[1];
2083
2084 open my $old_stdout, ">&", \*STDOUT;
2085 pipe my ($r, $w);
2086 open STDOUT, ">&", $w;
2087 close $w;
2088
2089 $mediainfo_pid = Proc::FastSpawn::spawn $::MEDIAINFO, ["mediainfo", "--Inform=General;%Description%", "--", "$pathpfx$name"];
2090
2091 if ($mediainfo_pid) {
2092 win_set $WIN_H - $DESC_H + 1, "fetching media description...";
2093 _win_refresh;
2094
2095 my $iow; $iow = EV::io $r, EV::READ, sub {
2096 $iow->stop;
2097
2098 return if $mediainfo_jobid != $jobid;
2099
2100 read $r, my $description, 8192;
2101 undef $mediainfo_pid;
2102 close $r;
2103
2104 utf8::decode $description;
2105 $description = "<no description>" unless $description =~ /\S/;
2106
2107 $description =~ s/ \/ /\n/g; # youtube-dl uses " / " or so to separate lines
2108
2109 if (stat "$pathpfx$name") {
2110 $description = sprintf "%s %s\n%s",
2111 (POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime +(stat _)[9]),
2112 (Format::Human::Bytes::base10 +(stat _)[7]),
2113 $description;
2114 }
2115
2116 local $Text::Wrap::columns = $WIN_W;
2117 my @description = grep /\S/, split /\n/, Text::Wrap::wrap "", "", $description;
2118
2119 for (0 .. $DESC_H - 1) {
2120 win_set $WIN_H - $DESC_H + 1 + $_, $description[$_];
2121 }
2122 _win_refresh;
2123 };
2124 }
2125
2126 open STDOUT, ">&", $old_stdout;
2127 }
2128 };
2129
2130 my $handled = $list->handle_events;
2131
2132 if ($DESC_H) {
2133 ++$mediainfo_jobid;
2134 kill 9, $mediainfo_pid if $mediainfo_pid;
2135 for ($WIN_H - $DESC_H .. $WIN_H - 1) {
2136 win_set $_, "";
2137 }
2138 win_refresh;
2139 }
2140
2141 last unless $handled;
2142 }
2143
2144 input_context "view";
2145
2146 my $entry = $list->selection;
2147 my $name = $entry->[1];
2148 my $filestate = $filestate->{"$pathpfx$name"} ||= {};
2149
2150 if ($INPUT eq "list/select" or $INPUT eq "play" or $INPUT eq "pause") {
2151 $filestate->{started} = int AE::now;
2152 my $uploader = "$pathpfx$name" =~ /00_distant_worlds/ && $name =~ /^([^-]+)-/ ? $1 : undef;
2153
2154 my @uploader_props = qw(mpv_sid speed);
2155
2156 if ($uploader) {
2157 for (@uploader_props) {
2158 $filestate->{$_} //= $STATE{"uploader_$_"}{$uploader};
2159 }
2160 }
2161
2162 ::state_save;
2163 win_nest {
2164 play_video $filestate, "$pathpfx/$name", $INPUT ne "play";
2165 };
2166
2167 if ($uploader) {
2168 for (@uploader_props) {
2169 if ($filestate->{$_} != $STATE{"uploader_$_"}{$uploader}) {
2170 $STATE{"uploader_$_"}{$uploader} = $filestate->{$_};
2171 ::state_save;
2172 }
2173 }
2174 }
2175
2176 ++$list->{cur} if $filestate->{watched};
2177 $list->changed;
2178
2179 } else {
2180 if ($INPUT eq "esc") {
2181 EV::unloop;
2182
2183 } elsif ($INPUT eq "return") {
2184 prepare_exit;
2185 exec $0, "--restart";
2186
2187 } elsif ($INPUT =~ /^(?:next|prev|intfwd|intrev|triangle|circle)$/) {
2188 win_nest {
2189 menu_playlist;
2190 };
2191
2192 } elsif ($INPUT eq "red") {
2193 $filestate->{deleted} ? delete $filestate->{deleted} : ($filestate->{deleted} = 1);
2194 ::state_save;
2195 ++$list->{cur}; $list->changed;
2196
2197 } elsif ($INPUT eq "green") {
2198 $filestate->{watched} ? delete $filestate->{watched} : ($filestate->{watched} = 1);
2199 ::state_save;
2200 ++$list->{cur}; $list->changed;
2201
2202 } elsif ($INPUT eq "yellow") {
2203 $filestate->{started} ? delete $filestate->{started} : ($filestate->{started} = 1);
2204 ::state_save;
2205 ++$list->{cur}; $list->changed;
2206
2207 } elsif ($INPUT eq "blue") {
2208 $filestate->{archive} ? delete $filestate->{archive} : ($filestate->{archive} = 1);
2209 ::state_save;
2210 ++$list->{cur}; $list->changed;
2211
2212 } elsif ($INPUT eq "popup") {
2213 win_nest {
2214 dir_menu $self;
2215 };
2216
2217 } elsif ($INPUT eq "right") {
2218 win_nest {
2219 file_menu $self, "$pathpfx$name";
2220 };
2221 }
2222 }
2223 }
2224 }
2225 }
2226
2227 sub main {
2228 while () {
2229 if (my $args = shift @EXTERNAL) {
2230 state_save; # proactively request a state save since we are almost certain to change something
2231
2232 my $state = $STATE{ $STATE{curdir} // "/videos" } ||= {};
2233
2234 if ($args->[0] =~ /^--regex=(.*)/) {
2235 $state->{filter_regex} = dec $1;
2236 next;
2237 } elsif ($args->[0] =~ /^--uploader=(.*)/) {
2238 $STATE{"/videos"}{filter_uploader} = dec $1;
2239 next;
2240 } elsif ($args->[0] =~ /^--playlist=\/*(.*)/) {
2241 $STATE{curdir} = dec "/$1";
2242 next;
2243 } elsif ($args->[0] =~ /^--rescan$/) {
2244 next;
2245 }
2246
2247 my $playlist = @$args > 1 ? "/playlist" : "/playlist1";
2248
2249 if ($args->[0] =~ /--list=\/*(.*)/) {
2250 shift @$args;
2251 $playlist = dec "/$1";
2252 }
2253
2254 if ($args->[0] =~ /^--/) {
2255 next; # error case
2256 }
2257
2258 # playlist / directory
2259
2260 $STATE{curdir} = $playlist;
2261
2262 my $pl = $STATE{$playlist} ||= {};
2263
2264 delete $pl->{full_list};
2265 delete $pl->{cwd};
2266
2267 if ($args->[0] eq "-r") {
2268 $pl->{cwd} = canonpath $args->[1];
2269 $pl->{scan} = "state_scan_recursive";
2270
2271 } elsif (@$args == 1 && -d $args->[0]) {
2272 # single directory given, play directory
2273 $pl->{cwd} = canonpath $args->[0];
2274
2275 } else {
2276 # playlist, must be all files => create playlist with files
2277
2278 $pl->{full_list} = [map { ref ? $_ : stat_video $_ } @$args];
2279
2280 ::input_feed "enter" if @$args == 1; #d# hack: auto-play when single video
2281 }
2282 }
2283
2284 wakeup;
2285 view_playlist $STATE{curdir} // "/videos";
2286 }
2287 }
2288
2289 $WIN_READY->recv;
2290
2291 our $MAIN_CORO;
2292
2293 sub state_expire {
2294 my $filestate = $STATE{filestate};
2295
2296 if ($DOOM) { # only do it on doom
2297 # filter out old/empty state
2298
2299 while (my ($k, $v) = each %$filestate) {
2300 unless (%$v and -e $k) {
2301 delete $filestate->{$k};
2302 }
2303 }
2304 }
2305
2306 if (0) {
2307 for my $k (keys %$filestate) {
2308 my $k2 = $k =~ s%//+%/%gr;
2309 $k2 =~ s%^/fs/fuji/fs/doom/%/fs/doom/%;
2310 $k2 =~ s%^/fs/doom/fs/doom/%/fs/doom/%; # / <- vio fix
2311 if ($k2 ne $k) {
2312 $filestate->{$k2} = delete $filestate->{$k};
2313 }
2314 }
2315 }
2316 }
2317
2318 sub main_start {
2319 $MAIN_CORO ||= async {
2320 mpv_init;
2321 $mpv->cmd ("script-message", "osc-visibility", "never", "dummy");
2322
2323 if ($ARGV[0] eq "--state-reload") {
2324 win_progress "\e[31mstate was externally modified, press enter to reload and proceed";
2325
2326 while () {
2327 input_next "reload";
2328 last if $INPUT eq "enter" or $INPUT eq "return";
2329 }
2330
2331 win_clear;
2332 }
2333
2334 state_init;
2335 #use Data::Dump; ddx \%STATE;#d#
2336
2337 conf_check;
2338 state_expire;
2339
2340 main;
2341 EV::unloop;
2342 };
2343 }
2344
2345 sub state_file_check {
2346 if ($STATE_MTIME != (stat $STATE_FILE)[9]) {
2347 return if $TESTING;
2348
2349 $MAIN_CORO->safe_cancel;
2350 unlink $STATE_SHM;
2351 $mpv->stop;
2352 exec $0, "--state-reload";
2353 die "state changed, aborting to reload hack\n";
2354 async {
2355 win_clear;
2356 };
2357 }
2358 }
2359
2360 main_start;
2361 EV::loop;
2362 prepare_exit;
2363