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