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 (8 months, 1 week ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +66 -44 lines
Log Message:
§

File Contents

# User Rev Content
1 root 1.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 root 1.5 $END{__GL_SYNC_TO_VBLANK} = 0;
12 root 1.1
13     BEGIN {
14     if ($ARGV[0] eq "-=reloaded=-") {
15     shift;
16 root 1.5 } elsif ($^C) {
17     # nop
18 root 1.3 } elsif (-e "/root/mlockall.so") {
19 root 1.1 $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 root 1.5 #system "echo 3 > /proc/sys/vm/drop_caches";
23 root 1.1 system "echo 1 > /proc/sys/vm/compact_memory";
24 root 1.5 #exec "taskset", "-c", "12-15", "nice", "-n-20", "ionice", "-c1", $0, "-=reloaded=-", @ARGV;
25     exec "nice", "-n-20", "ionice", "-c1", $0, "-=reloaded=-", @ARGV;
26 root 1.1 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 root 1.5 IO::AIO::min_parallel 32;
59 root 1.1
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 root 1.5 our $FONTSIZE = $NODENAME eq "doom" ? 18 : 18;
82 root 1.1 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 root 1.2 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 root 1.1 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 root 1.2 sub _canonpath {
893 root 1.1 my $path = $_[0];
894    
895 root 1.2 my $file;
896    
897     unless (-d $path) {
898     $path =~ s/((?:^|\/)[^\/]+\z)//;
899     $file = $1;
900     }
901    
902 root 1.1 $path = Cwd::realpath $path;
903     $path = "/fs/$NODENAME$path" unless $path =~ /^\/fs\//;
904    
905 root 1.2 "$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 root 1.1 $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 root 1.2 $v->{cwd} = $v->{cwd} ? canonpath $v->{cwd} : $VIDEO_DIR;
942 root 1.1
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 root 1.5 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 root 1.1 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 root 1.5 s{\bE(\d+)\b}{sprintf "Ep.%03d", $1}geia;
1012 root 1.1 #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 root 1.5 $display = sanitize $display;
1022    
1023 root 1.1 $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 root 1.2 @{ scan_video_dir $VIDEO_DIR },
1091 root 1.5 #@{ scan_video_dir "/fs/doom/root/ytnew" },
1092     #@{ scan_video_dir "/seagate2tb/sinatar" },
1093 root 1.1 ]
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 root 1.2 $path = canonpath $path;
1130    
1131 root 1.1 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 root 1.5 my $dis = sanitize dec $_;
1139 root 1.1 $dis = length $dis > 25 ? (substr $dis, 0, 24) . "…" : $dis;
1140    
1141     push @dirs, ["$path/$_", "$display/$dis"];
1142    
1143     } elsif (-f _) {
1144 root 1.5 my $dis = sanitize dec $_;
1145 root 1.2 push @list, [(substr "$display/$dis", 1), "$path/$_"];
1146 root 1.1 }
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 root 1.5 warn "target fps $target, cur_fps $new\n";#d#
1224    
1225 root 1.1 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 root 1.5 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 root 1.1 # 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 root 1.4 if ($mpv->start ("--idle=yes", "--pause", "--force-window=no")) { # "--start=$playback_start", "--", $mpv_path)
1262     $mpv->{info_page} = 0;
1263     }
1264 root 1.1
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 root 1.2 my $playback_start = 0;
1302 root 1.5 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 root 1.1
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 root 1.4 win_set 0, "starting video..."; _win_refresh;
1350 root 1.1
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 root 1.2 #$mpv->cmd ("set", "sub-delay", "-19.100");
1364     #$mpv->cmd ("set", "sub-codepage", "UTF-8-BROKEN");
1365 root 1.1 $mpv->cmd ("set", "file-local-options/chapters-file", $mpv->escape_binary ("$mpv_path.chapters"));
1366 root 1.2 $mpv->cmd ("set", "options/start" => "$playback_start"); # file-local-options, or just start do not work
1367 root 1.1 $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 root 1.2 #$mpv->cmd ("seek", $playback_start, "absolute+exact") if $playback_start > 0;
1414 root 1.1
1415 root 1.5 $target_fps = eval { $mpv->cmd_recv ("get_property", "container-fps") } || 60;
1416 root 1.1
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 root 1.5 $update_speed->();
1431 root 1.1 $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 root 1.5 $mpv->cmd ("seek", 0, "relative+exact"); # workaround for sometimes not playing(?) mpv 0.35.1
1438     $mpv->cmd ("set", "pause", "no");
1439 root 1.1 win_clear;
1440    
1441     } elsif ($INPUT eq "stepfwd") {
1442     ++$PLAYING_STATE->{speed};
1443 root 1.5 $update_speed->();
1444 root 1.1 ::state_save;
1445     } elsif ($INPUT eq "steprev") {
1446     --$PLAYING_STATE->{speed};
1447 root 1.5 $update_speed->();
1448 root 1.1 ::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 root 1.3 #$mpv->cmd ("osd-msg-bar", "show-progress");
1467 root 1.4
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 root 1.1 }
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 root 1.2 #$mpv->stop;
1600     #mpv_init;
1601 root 1.1
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 root 1.2 $pl->{full_list} = [map { ref ? $_ : stat_video canonpath $_ } @$args];
2340 root 1.1
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