| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
use Storable; |
| 4 |
use POSIX 'strftime'; |
| 5 |
use Carp; |
| 6 |
use Curses; |
| 7 |
|
| 8 |
my $pair = 0; |
| 9 |
|
| 10 |
my $db_name = $ARGV[0]; |
| 11 |
|
| 12 |
END { endwin }; |
| 13 |
|
| 14 |
initscr; start_color; |
| 15 |
cbreak; noecho; |
| 16 |
nonl; intrflush 0; keypad 1; |
| 17 |
immedok 0; idlok 1; scrollok 0; leaveok 1; |
| 18 |
clear; |
| 19 |
|
| 20 |
sub cattr($$) { |
| 21 |
return $cattr{$_[0],$_[1]} if defined $cattr{$_[0], $_[1]}; |
| 22 |
$pair++; |
| 23 |
init_pair ($pair, $_[0], $_[1]); |
| 24 |
$cattr{$_[0],$_[1]} = COLOR_PAIR($pair); |
| 25 |
} |
| 26 |
|
| 27 |
sub date2unix { |
| 28 |
my($date,$time,$lto)=@_; |
| 29 |
381283200 |
| 30 |
+ ($date-45000) * 86400 |
| 31 |
+ ($time >> 12 ) * 10 * 60 * 60 |
| 32 |
+ ($time >> 8 & 15) * 60 * 60 |
| 33 |
+ ($time >> 4 & 15) * 10 * 60 |
| 34 |
+ ($time & 15) * 60 |
| 35 |
+ $lto * 15; |
| 36 |
} |
| 37 |
|
| 38 |
sub date2text { |
| 39 |
sprintf "{%04x}", $_[0]; |
| 40 |
} |
| 41 |
|
| 42 |
sub time2text { |
| 43 |
sprintf "%02x:%02x", $_[0] >> 8, $_[0] & 0xff; |
| 44 |
} |
| 45 |
|
| 46 |
my $wofs = -5*60; |
| 47 |
my $to; |
| 48 |
my $mtime = -1; |
| 49 |
my @pi; |
| 50 |
my $current = 1; |
| 51 |
my $shortinfo = 1; |
| 52 |
|
| 53 |
sub load_db { |
| 54 |
return if -M $db_name == $mtime; |
| 55 |
$mtime = -M $db_name; |
| 56 |
*db = eval { Storable::retrieve($db_name) } || { }; |
| 57 |
@pi = map values %$_, values %{$db{pi}}; |
| 58 |
for (@pi) { |
| 59 |
$_->{start_time} = date2unix($_->{start_date}, $_->{start_time}, $db{ai}{networks}[$_->{netwop_no}]{LTO}); |
| 60 |
$_->{stop_time} = date2unix($_->{start_date}, $_->{stop_time} , $db{ai}{networks}[$_->{netwop_no}]{LTO}); |
| 61 |
$_->{stop_time} += 86400 if $_->{stop_time} < $_->{start_time}; |
| 62 |
} |
| 63 |
@pi = sort { $a->{start_time} <=> $b->{start_time} || |
| 64 |
$a->{netwop_no} <=> $b->{netwop_no} } @pi; |
| 65 |
} |
| 66 |
|
| 67 |
move (1,0); standout; addch "=" for 1..$COLS; standend; |
| 68 |
|
| 69 |
for(;;) { |
| 70 |
load_db; |
| 71 |
$now = time; |
| 72 |
$to = $now + 60; |
| 73 |
move (0,0); addstr sprintf "%s (window offset %5d)\n", strftime("%H:%M:%S", localtime $now), int($wofs / 60); |
| 74 |
show_current(); |
| 75 |
move (0, 40); addstr ($to-$now); |
| 76 |
refresh; |
| 77 |
while (time < $to) { |
| 78 |
my $r = ""; vec ($r, fileno STDIN, 1) = 1; |
| 79 |
select $r,undef,undef,1; |
| 80 |
if (vec ($r, fileno STDIN, 1)) { |
| 81 |
my $key = getch; |
| 82 |
exit if $key eq "q" || $key eq "\x1b"; |
| 83 |
$current = !$current if $key eq "c"; |
| 84 |
$shortinfo = !$shortinfo if $key eq "s"; |
| 85 |
$wofs = -300 if $key eq "." || $key == KEY_HOME; |
| 86 |
$wofs -= 300 if $key eq "k" || $key == KEY_UP; |
| 87 |
$wofs += 300 if $key eq "j" || $key == KEY_DOWN; |
| 88 |
$wofs -= 3600 if $key eq ""|| $key == KEY_PPAGE; |
| 89 |
$wofs += 3600 if $key eq ""|| $key == KEY_NPAGE; |
| 90 |
last; |
| 91 |
} elsif (-M $db_name != $mtime) { |
| 92 |
last; |
| 93 |
} |
| 94 |
} |
| 95 |
} |
| 96 |
|
| 97 |
my ($y,$x); |
| 98 |
|
| 99 |
sub outstr { |
| 100 |
my $s = shift; |
| 101 |
my($l,$r); |
| 102 |
for (;;) { |
| 103 |
$l = length $s; |
| 104 |
$r = $COLS - $x; |
| 105 |
if ($l < $r) { |
| 106 |
addstr ($s); |
| 107 |
$x += $l; |
| 108 |
last; |
| 109 |
} |
| 110 |
addstr $1 if $s =~ s/^(.{1,$r})([\x00-\x20]+|$)//; |
| 111 |
$y++; |
| 112 |
move $y, 35; |
| 113 |
$x = 35; |
| 114 |
} |
| 115 |
} |
| 116 |
|
| 117 |
sub addttstr($$) { |
| 118 |
my ($fg, $bg) = (COLOR_WHITE, COLOR_BLACK); |
| 119 |
my $y1; |
| 120 |
local $_ = shift; |
| 121 |
y/~{|}[]/ίδφόΔάΦ/; # buggy as hell :( |
| 122 |
s/\s*([\x00-\x20])\s*/$1/g; # wipe away superflous spaces |
| 123 |
getyx $y, $x; $y1 = $y; |
| 124 |
for(;;) { |
| 125 |
if (/\G([\x20-\xff]+)/gc) { |
| 126 |
attrset (cattr ($fg, $bg)); |
| 127 |
outstr $1; |
| 128 |
} elsif (/\G([\x00-\x07])/gc) { |
| 129 |
$fg = COLOR_BLACK if $1 eq "\x00"; |
| 130 |
$fg = COLOR_RED if $1 eq "\x01"; |
| 131 |
$fg = COLOR_GREEN if $1 eq "\x02"; |
| 132 |
$fg = COLOR_YELLOW if $1 eq "\x03"; |
| 133 |
$fg = COLOR_BLUE if $1 eq "\x04"; |
| 134 |
$fg = COLOR_MAGENTA if $1 eq "\x05"; |
| 135 |
$fg = COLOR_CYAN if $1 eq "\x06"; |
| 136 |
$fg = COLOR_WHITE if $1 eq "\x07"; |
| 137 |
outstr " "; |
| 138 |
} elsif (/\G\x1d/gc) { |
| 139 |
$bg = $fg; |
| 140 |
outstr " "; |
| 141 |
} elsif (/\G./gc) { |
| 142 |
# nop |
| 143 |
} else { |
| 144 |
last; |
| 145 |
} |
| 146 |
} |
| 147 |
attrset (cattr (COLOR_WHITE, COLOR_BLACK)); |
| 148 |
#s/([\x00-\x07])/sprintf " [%dm", ord($1)+30/ge; |
| 149 |
#s/([\x00-\x09\x0b-\x1a\x1c-\x1f])/sprintf "·[%02x]",ord $1/ge; |
| 150 |
#s/^ //g; |
| 151 |
#$_."[37m"; |
| 152 |
$_[1] += $y-$y1; |
| 153 |
} |
| 154 |
|
| 155 |
sub show_current { |
| 156 |
my $trenn = 2; |
| 157 |
my $lines = $LINES - 2; |
| 158 |
move (2, 0); |
| 159 |
clrtobot; |
| 160 |
for (@pi) { |
| 161 |
if ($_->{start_time} < $now + $wofs) { |
| 162 |
next if !$current || $_->{stop_time} < $now; |
| 163 |
$to = $_->{stop_time} if $to > $_->{stop_time} && $_->{stop_time} >= $now; |
| 164 |
} else { |
| 165 |
$to = $_->{start_time} if $to > $_->{start_time} && $_->{start_time} > $now; |
| 166 |
} |
| 167 |
my $start = $_->{start_time}; |
| 168 |
my $stop = $_->{stop_time}; |
| 169 |
if ($start > $now) { |
| 170 |
if ($trenn == 1) { |
| 171 |
addch (ACS_HLINE) for 1..$COLS; |
| 172 |
$lines--; |
| 173 |
} |
| 174 |
$trenn = 0; |
| 175 |
} elsif ($trenn == 2) { |
| 176 |
$trenn = 1; |
| 177 |
} |
| 178 |
|
| 179 |
addstr sprintf "%s-%s (%+4d) %-10.10s ", |
| 180 |
strftime("%H:%M", localtime $start), strftime("%H:%M (%d)", localtime $stop), |
| 181 |
int (($start-$now)/60), |
| 182 |
$db{ai}{networks}[$_->{netwop_no}]{netwop_name}; |
| 183 |
|
| 184 |
my $si; |
| 185 |
if ($shortinfo) { |
| 186 |
unless ($_->{sinfo}) { |
| 187 |
$si = delete $_->{shortinfo}; |
| 188 |
my $li = delete $_->{longinfo}; |
| 189 |
for ($si, $li) { |
| 190 |
s/(.{40})/$1 /g; |
| 191 |
s/\s\s+/ /g; |
| 192 |
} |
| 193 |
for (my $x = length($si); $x; $x--) { |
| 194 |
if (substr ($si, -$x) eq substr ($li, 0, $x)) { |
| 195 |
substr ($si, -$x) = $li; |
| 196 |
last; |
| 197 |
} |
| 198 |
} |
| 199 |
$si =~ s/[\x00-\x20]+$//; |
| 200 |
$_->{sinfo} = $si; |
| 201 |
} |
| 202 |
$si = $_->{sinfo}; |
| 203 |
} |
| 204 |
addttstr ($_->{title}.$si, $lines); |
| 205 |
|
| 206 |
addch ("\n"); |
| 207 |
last unless --$lines; |
| 208 |
} |
| 209 |
clrtobot; |
| 210 |
} |
