]> mj.ucw.cz Git - vs.git/blob - vs.pl
Added transpose mode.
[vs.git] / vs.pl
1 #!/usr/bin/perl
2 # The Virtual Songbook 0.0
3 # (c) 2003 Martin Mares <mj@ucw.cz>
4
5 use Curses;
6 use strict;
7 use warnings;
8
9 ### Interface with Curses ###
10
11 my $W;
12 my $color_mode;
13
14 sub init_terminal() {
15         $W = new Curses;
16         start_color;
17         $color_mode = (has_colors && COLORS >= 8 && COLOR_PAIRS >= 8) unless defined $color_mode;
18         cbreak; noecho;
19         $W->intrflush(0);
20         $W->keypad(1);
21         $W->meta(1);
22 }
23
24 sub cleanup_terminal() {
25         endwin;
26 }
27
28 my ($attr_normal, $attr_status, $attr_hilite, $attr_chord);
29
30 sub setup_attrs() {
31         if ($color_mode) {
32                 init_pair(1, COLOR_YELLOW, COLOR_BLUE);
33                 $attr_status = COLOR_PAIR(1) | A_BOLD;
34                 init_pair(2, COLOR_YELLOW, COLOR_BLACK);
35                 $attr_chord = COLOR_PAIR(2);
36         } else {
37                 $attr_status = A_BOLD;
38                 $attr_chord = A_BOLD;
39         }
40         $attr_normal = A_NORMAL;
41         $attr_hilite = A_BOLD;
42 }
43
44 my $try_full_names = 1;
45 my $auto_enter = 1;
46 my $file_window_width = 20;
47
48 my ($term_w, $term_h);
49 my @window_list = ();
50 my $status_window = new VS::Window::Status;
51 my $main_window = new VS::Window::Main;
52 my $file_window = new VS::Window::File;
53 $file_window->reload;
54 my $focused_window_i = 2;
55 my $focused_window = $file_window;
56
57 sub focus_next() {
58         $focused_window->{"focused"} = 0;
59         do {
60                 $focused_window_i++;
61                 if ($focused_window_i > $#window_list) { $focused_window_i=0; }
62                 $focused_window = $window_list[$focused_window_i];
63         } while (!$focused_window->{"focusable"} || !$focused_window->{"visible"});
64         $focused_window->{"focused"} = 1;
65 }
66
67 sub recalc_windows() {
68         my $w = COLS;
69         my $h = LINES;
70         $term_w = $w;
71         $term_h = $h;
72         $status_window->place(0, 0, 1, $w);
73         if ($file_window->{"visible"}) {
74                 my $fww = $file_window_width;
75                 $main_window->place(1, 0, $h-1, $w-$fww-1);
76                 $W->attrset($focused_window == $file_window ? $attr_hilite : $attr_normal);
77                 $W->vline(2, $w-$fww-1, ACS_VLINE, $h-3);
78                 $W->hline(1, $w-$fww, ACS_HLINE, $fww);
79                 $W->hline($h-1, $w-$fww, ACS_HLINE, $fww);
80                 $W->addch(1, $w-$fww-1, ACS_ULCORNER);
81                 $W->addch($h-1, $w-$fww-1, ACS_LLCORNER);
82                 $W->attrset($attr_normal);
83                 $file_window->place(2, $w-$fww, $h-3, $fww);
84         } else {
85                 $main_window->place(1, 0, $h-1, $w);
86                 $file_window->place(0, 0, 0, 0);
87         }
88 }
89
90 sub toggle_window($) {
91         my $win = shift;
92         if ($win->{"visible"} = !$win->{"visible"}) {
93                 while ($focused_window != $win) { focus_next; }
94         } else {
95                 if ($focused_window == $win) { focus_next; }
96         }
97         recalc_windows;
98 }
99
100 init_terminal;
101 setup_attrs;
102 recalc_windows;
103
104 for(;;) {
105         $W->move($term_h-1, $term_w-1);
106         $W->refresh;
107         my $key = $W->getch;
108         if ($key eq "\033" || $key eq "q") {
109                 cleanup_terminal;
110                 exit 0;
111         } elsif ($key eq "f") {
112                 toggle_window($file_window);
113         } elsif ($key eq "\t") {
114                 focus_next;
115                 recalc_windows;
116         } elsif ($key eq "\014") {
117                 $curscr->clearok(1);
118         } elsif ($key eq "<" && $file_window_width < $term_w-1) {
119                 $file_window_width++;
120                 recalc_windows;
121         } elsif ($key eq ">" && $file_window_width > 1) {
122                 $file_window_width--;
123                 recalc_windows;
124         } elsif ($key eq "j") {
125                 $file_window->key(KEY_DOWN);
126         } elsif ($key eq "k") {
127                 $file_window->key(KEY_UP);
128         } elsif ($key eq "h") {
129                 $file_window->key(KEY_LEFT);
130         } elsif ($key eq "l") {
131                 $file_window->key(KEY_RIGHT);
132         } else {
133                 $focused_window->key($key);
134         }
135 }
136
137 ### Chords ###
138
139 package VS::Chord;
140
141 # Internal representation of chords: <base-tone>:<type> (so C="0:", C#="1:", Dmi="2:mi" etc.)
142 # but usually they are accompanied by position info after a second colon
143
144 our (%t2n, @n2t);
145
146 BEGIN {
147 %t2n = (
148         "C" => 0,
149         "C#" => 1,
150                 "Db" => 1,
151         "D" => 2,
152         "D#" => 3,
153                 "Eb" => 3,
154         "E" => 4,
155                 "Fb" => 4,
156                 "E#" => 5,
157         "F" => 5,
158         "F#" => 6,
159                 "Gb" => 6,
160         "G" => 7,
161         "G#" => 8,
162                 "Ab" => 8,
163         "A" => 9,
164                 "Bb" => 9,
165         "A#" => 10,
166                 "Hb" => 10,
167                 "B" => 10,
168         "H" => 11,
169                 "B#" => 11,
170                 "Cb" => 11,
171                 "H#" => 0
172 );
173 @n2t = ( "C", "C#", "D", "D#", "E", "F", "F#", "G", "G#", "A", "B", "H" );
174 }
175
176 sub parse_line($) {
177         my $r = shift @_;
178         my @l = ();
179         my $pos = 0;
180         while (my ($spaces,$chord,$rest) = $r =~ /(\s*)(\S+)(.*)/) {
181                 $pos += length $spaces;
182                 if (my ($tone,$sh,$mod) = ($chord =~ /^([CDEFGABH](#|b|))(.*)$/)) {
183                         my $k = $t2n{$tone};
184                         push @l, "$k:$mod:$pos"
185                 } else {
186                         push @l, "0:?$chord:$pos";
187                 }
188                 $pos += length $chord;
189                 $r = $rest;
190         }
191         return \@l;
192 }
193
194 sub synthesize_line($$) {
195         my ($l,$xpos) = @_;
196         my $pp = 0;
197         my $result = "";
198         for (my $i=0; $i<@$l; $i++) {
199                 my ($tone,$mod,$pos) = split(/:/, $l->[$i]);
200                 $tone = ($tone + $xpos) % 12;
201                 my $chord = $n2t[$tone] . "$mod ";
202                 if ($pp < $pos) {
203                         $result .= " " x ($pos - $pp);
204                         $pp = $pos;
205                 }
206                 $result .= $chord;
207                 $pp += length $chord;
208         }
209         return $result;
210 }
211
212 ### Window Objects ###
213
214 package VS::Window;
215
216 sub new($) {
217         my $w = {
218                 "visible" => 1,
219                 "focusable" => 1,
220                 "focused" => 0,
221                 "x" => -1,
222                 "y" => -1,
223                 "w" => -1,
224                 "h" => -1
225         };
226         push @window_list, $w;
227         return bless $w;
228 }
229
230 sub place($$$$$) {
231         my ($w,$nx,$ny,$nh,$nw) = @_;
232         if ($w->{"visible"}) {
233                 if (!defined $w->{"win"} || $w->{"x"} != $nx || $w->{"y"} != $ny
234                  || $w->{"w"} != $nw || $w->{"h"} != $nh) {
235                         $w->{"win"} = $W->subwin($nh,$nw,$nx,$ny);
236                         $w->{"x"} = $nx;
237                         $w->{"y"} = $ny;
238                         $w->{"w"} = $nw;
239                         $w->{"h"} = $nh;
240                         $w->redraw;
241                 }
242         } else {
243                 delete $w->{"win"};
244         }
245 }
246
247 sub key($) { }
248 sub redraw($) { }
249
250 package VS::Window::Main;
251 use Curses;
252 BEGIN { our @ISA = qw(VS::Window); }
253
254 sub new($) {
255         my $w = new VS::Window;
256         $w->{"file"} = "";
257         $w->{"attrs"} = {};
258         $w->{"lines"} = ["", "", "   The Virtual Songbook 0.0\n", "   (c) 2003 Martin Mares <mj\@ucw.cz>"];
259         $w->{"chords"} = [0,0,0,0];
260         $w->{"n"} = 4;
261         $w->{"top"} = 0;
262         $w->{"chords_analysed"} = 0;
263         $w->{"current_xpose"} = 0;
264         $w->{"requested_xpose"} = 0;
265         return bless $w;
266 }
267
268 sub view($$$) {
269         my ($w,$f,$x) = @_;
270         if ($w->{"file"} ne $f) {
271                 $w->{"file"} = $f;
272                 $w->{"xfile"} = $x;
273                 $w->{"current_xpose"} = 0;
274                 $w->{"chords_analysed"} = 0;
275                 $f =~ s@^./@@;
276                 $x =~ s@^./@@;
277                 if (open X, $f) {
278                         my %attrs = ();
279                         while (<X>) {
280                                 chomp;
281                                 /^$/ && last;
282                                 if (/^(\w+):\s*(.*)/ && !defined $attrs{$1}) {
283                                         $attrs{$1} = $2;
284                                 }
285                         }
286                         my @lines = ();
287                         my @chords = ();
288                         while (<X>) {
289                                 chomp;
290                                 if (s/^!//) { push @chords, 1; } else { push @chords, 0; }
291                                 push @lines, $_;
292                         }
293                         close X;
294                         $w->{"attrs"} = \%attrs;
295                         $w->{"lines"} = \@lines;
296                         $w->{"chords"} = \@chords;
297                         $w->{"chordtable"} = [];
298                         $w->{"top"} = 0;
299                         $w->{"n"} = scalar @lines;
300                         $w->redraw;
301                         if (defined $attrs{"Name"}) {
302                                 $x = $attrs{"Name"};
303                                 $x = $attrs{"Author"} . ": $x" if defined $attrs{"Author"};
304                         }
305                         $status_window->tell($x);
306                 } else {
307                         $status_window->tell("Cannot open $f");
308                 }
309         }
310 }
311
312 sub transpose($) {
313         my $w = shift @_;
314         if (!$w->{"chords_analysed"}) {
315                 for (my $i=0; $i<$w->{"n"}; $i++) {
316                         if ($w->{"chords"}->[$i]) {
317                                 $w->{"chordtable"}->[$i] = VS::Chord::parse_line($w->{"lines"}->[$i]);
318                         }
319                 }
320                 $w->{"chords_analysed"} = 1;
321         }
322         for (my $i=0; $i<$w->{"n"}; $i++) {
323                 if ($w->{"chords"}->[$i]) {
324                         $w->{"lines"}->[$i] = VS::Chord::synthesize_line($w->{"chordtable"}->[$i], $w->{"requested_xpose"});
325                 }
326         }
327         $w->{"current_xpose"} = $w->{"requested_xpose"};
328 }
329
330 sub redraw_line($$) {
331         my ($w,$i) = @_;
332         my $win = $w->{"win"};
333         my $l = $w->{"lines"}->[$i];
334         if ($w->{"linetypes"}->[$i]) { $win->attrset($attr_chord); }
335         if (length $l < $w->{"w"}) {
336                 $win->addstr($i-$w->{"top"}, 0, $l);
337                 $win->clrtoeol;
338         } else {
339                 $win->addstr($i-$w->{"top"}, 0, substr($l, 0, $w->{"w"}));
340         }
341         $win->attrset($attr_normal);
342 }
343
344 sub redraw($) {
345         my $w = shift @_;
346         $w->transpose if $w->{"current_xpose"} != $w->{"requested_xpose"};
347         my $win = $w->{"win"};
348         my $top = $w->{"top"};
349         my $cnt = $w->{"n"} - $w->{"top"};
350         if ($cnt > $w->{"h"}) { $cnt = $w->{"h"}; }
351         for (my $i=$top; $i<$top+$cnt; $i++) { $w->redraw_line($i); }
352         if ($cnt < $w->{"h"}) {
353                 $win->move($cnt, 0);
354                 $win->clrtobot;
355         }
356         $win->noutrefresh;
357 }
358
359 sub go($$) {
360         my ($w,$delta) = @_;
361         my $win = $w->{"win"};
362         my $top = $w->{"top"} + $delta;
363         if ($top + $w->{"h"} > $w->{"n"}) { $top = $w->{"n"} - $w->{"h"}; }
364         if ($top < 0) { $top = 0; }
365         my $otop = $w->{"top"};
366         $w->{"top"} = $top;
367         if ($top < $otop - $w->{"h"}/2) {
368                 $w->redraw;
369         } elsif ($top < $otop) {
370                 my $j = $otop - $top;
371                 $win->scrollok(1);
372                 $win->scrl(-$j);
373                 $win->scrollok(0);
374                 for (my $i=0; $i<$j; $i++) { $w->redraw_line($top+$i); }
375         } elsif ($top == $otop) {
376                 # Nothing happens
377         } elsif ($top < $otop + $w->{"h"}/2) {
378                 my $j = $top - $otop;
379                 $win->scrollok(1);
380                 $win->scrl($j);
381                 $win->scrollok(0);
382                 for (my $i=$j; $i>0; $i--) { $w->redraw_line($top+$w->{"h"}-$i); }
383         } else {
384                 $w->redraw;
385         }
386         $win->noutrefresh;
387 }
388
389 sub key($$) {
390         my ($w,$key) = @_;
391         if ($key eq KEY_UP) { $w->go(-1); }
392         elsif ($key eq KEY_DOWN) { $w->go(1); }
393         elsif ($key eq KEY_PPAGE) { $w->go(-$w->{"h"}-1); }
394         elsif ($key eq KEY_NPAGE) { $w->go($w->{"h"}-1); }
395         elsif ($key eq KEY_HOME) { $w->go(-1000000000); }
396         elsif ($key eq KEY_END) { $w->go(1000000000); }
397         elsif ($key eq "+" || $key eq "=") { $w->{"requested_xpose"} = ($w->{"requested_xpose"}+1)%12; $status_window->redraw; $w->redraw; }
398         elsif ($key eq "-") { $w->{"requested_xpose"} = ($w->{"requested_xpose"}+11)%12; $status_window->redraw; $w->redraw; }
399         elsif ($key eq "0") { $w->{"requested_xpose"} = 0; $status_window->redraw; $w->redraw; }
400         else { $status_window->tell("Unknown key <$key>"); }
401 }
402
403 package VS::Window::File;
404 use Curses;
405 BEGIN { our @ISA = qw(VS::Window); }
406
407 sub new($) {
408         my $w = new VS::Window;
409         $w->{"dir"} = "./";
410         $w->{"xdir"} = "./";
411         return bless $w;
412 }
413
414 sub reload($) {
415         my $w = shift;
416         my $p = $w->{"dir"};
417         my @l = `cd $p && ls`;
418         my @fn = ();
419         my @full = ();
420         if ($p ne "./") { push @fn, "../"; push @full, "<parent>"; }
421         foreach my $x (@l) {
422                 chomp $x;
423                 if (-f "$p/$x") {
424                         push @fn, $x;
425                         my $fullname = $x;
426                         if ($try_full_names && open(X, "$p/$x")) {
427                                 while (<X>) {
428                                         chomp;
429                                         /^$/ && last;
430                                         if (/^Name:\s*(.*)/) {
431                                                 $fullname = $1;
432                                                 last;
433                                         }
434                                 }
435                                 close X;
436                         }
437                         push @full, $fullname;
438                 } elsif (-d "$p/$x") { push @fn, "$x/"; push @full, "$x/"; }
439         }
440         $w->{"flist"} = \@fn;
441         $w->{"list"} = \@full;
442         $w->{"n"} = scalar @fn;
443         $w->{"i"} = 0;
444         $w->{"1st"} = 0;
445 }
446
447 sub redraw_line($$) {
448         my ($w,$i) = @_;
449         my $line = $i - $w->{"1st"};
450         if ($line < 0 || $line >= $w->{"h"}) { return; }
451         my $win = $w->{"win"};
452         my $item = ($i < $w->{"n"}) ? substr($w->{"list"}->[$i], 0, $w->{"w"}) : "";
453         if ($i == $w->{"i"}) { $win->bkgdset($attr_status); }
454         $win->addstr($line, 0, $item);
455         $win->clrtoeol if length $item < $w->{"w"};
456         $win->bkgdset($attr_normal);
457 }
458
459 sub redraw($) {
460         my $w = shift @_;
461         my $win = $w->{"win"};
462         # Window size might have changed...
463         if ($w->{"1st"} + $w->{"h"} > $w->{"n"}) { $w->{"1st"} = $w->{"n"} - $w->{"h"}; }
464         if ($w->{"1st"} < 0) { $w->{"1st"} = 0; }
465         $win->idlok(1);
466         for (my $i=0; $i<$w->{"h"}; $i++) {
467                 $w->redraw_line($w->{"1st"} + $i);
468         }
469         $win->noutrefresh;
470 }
471
472 sub go($$) {
473         my ($w,$delta) = @_;
474         my $i = $w->{"i"};
475         my $oldi = $i;
476         $i += $delta;
477         if ($i < 0) { $i = 0; }
478         if ($i >= $w->{"n"}) { $i = $w->{"n"}-1; }
479         $w->{"i"} = $i;
480         if ($w->{"visible"}) {
481                 $w->redraw_line($oldi);
482                 if ($i < $w->{"1st"}) {
483                         my $j = $w->{"1st"} - $i;
484                         $w->{"1st"} = $i;
485                         if ($j >= $w->{"h"}/2) {
486                                 $w->{"win"}->scrollok(1);
487                                 $w->{"win"}->scrl(-$j);
488                                 $w->{"win"}->scrollok(0);
489                                 for (my $k=0; $k<$j; $k++) { $w->redraw_line($i+$k); }
490                         } else { $w->redraw; }
491                 } elsif ($i >= $w->{"1st"} + $w->{"h"}) {
492                         my $j = $i - $w->{"1st"} - $w->{"h"} + 1;
493                         $w->{"1st"} += $j;
494                         if ($j < $w->{"h"}/2) {
495                                 $w->{"win"}->scrollok(1);
496                                 $w->{"win"}->scrl($j);
497                                 $w->{"win"}->scrollok(0);
498                                 for (my $k=1; $k<=$j; $k++) { $w->redraw_line($i-$j+$k); }
499                         } else { $w->redraw; }
500                 } else { $w->redraw_line($i); }
501                 $w->{"win"}->noutrefresh;
502         }
503         if ($auto_enter && $i < $w->{"n"} && $w->{"flist"}->[$i] !~ /\/$/) { $w->select; }
504 }
505
506 sub select($) {
507         my ($w) = @_;
508         if ($w->{"i"} < $w->{"n"}) {
509                 my $f = $w->{"flist"}->[$w->{"i"}];
510                 my $x = $w->{"list"}->[$w->{"i"}];
511                 if ($f =~ /\/$/) {
512                         if ($f eq "../") {
513                                 $w->{"dir"} =~ s@([^/]*/)$@@;
514                                 my $back = $1;
515                                 $w->{"xdir"} =~ s@[^/]*/$@@;
516                                 $w->reload;
517                                 for (my $i=0; $i<$w->{"n"}; $i++) {
518                                         if ($w->{"flist"}->[$i] eq $back) {
519                                                 $w->{"i"} = $i;
520                                                 $w->{"1st"} = $i - int($w->{"h"}/2);
521                                                 last;
522                                         }
523                                 }
524                         } else {
525                                 $w->{"dir"} .= $f;
526                                 $w->{"xdir"} .= $x;
527                                 $w->reload;
528                         }
529                         $w->redraw;
530                 } else {
531                         $main_window->view($w->{"dir"} . $f, $w->{"xdir"} . $x);
532                 }
533         }
534 }
535
536 sub key($$) {
537         my ($w,$key) = @_;
538         if ($key eq KEY_UP) { $w->go(-1); }
539         elsif ($key eq KEY_DOWN) { $w->go(1); }
540         elsif ($key eq KEY_PPAGE) { $w->go(-$w->{"h"}-1); }
541         elsif ($key eq KEY_NPAGE) { $w->go($w->{"h"}-1); }
542         elsif ($key eq KEY_HOME) { $w->go(-1000000000); }
543         elsif ($key eq KEY_END) { $w->go(1000000000); }
544         elsif ($key eq "\n" || $key eq "\r" || $key eq KEY_RIGHT) { $w->select; }
545         elsif ($key eq KEY_LEFT) {
546                 if ($w->{"list"}->[0] eq "<parent>") {
547                         $w->{"i"} = 0;
548                         $w->select;
549                 }
550         }
551 }
552
553 package VS::Window::Status;
554 BEGIN { our @ISA = qw(VS::Window); }
555
556 sub new($) {
557         my $w = new VS::Window;
558         $w->{"focusable"} = 0;
559         $w->{"msg"} = "";
560         return bless $w;
561 }
562
563 sub redraw($) {
564         my $w = shift @_;
565         my $win = $w->{"win"};
566         $win->bkgdset($attr_status);
567         $win->addstr(0, 0, $w->{"msg"});
568         $win->clrtoeol;
569         my $aux = "";
570         $aux = "T=" . $main_window->{"requested_xpose"} if ($main_window->{"requested_xpose"});
571         $win->addstr(0, $w->{"w"}-length $aux, $aux) if $aux ne "";
572         $win->refresh;
573 }
574
575 sub tell($$) {
576         my ($w,$m) = @_;
577         if ($w->{"msg"} ne $m) {
578                 $w->{"msg"} = $m;
579                 $w->redraw;
580         }
581 }