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

File Contents

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