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