1#!/usr/local/bin/perl -w 2 3# {{{ information and version 4# 5# Purpose of the script: 6# 7# This is a utility for typesetting guitar chords in chordpro format. 8# It uses TeX typesetting system, namely LaTeX2e macro package for TeX. 9# 10# Author: Daniel Polansky ( dan.polansky@seznam.cz ) 11# Release: 0.8.1 12# Script home page: http://sweb.cz/dan.polansky/chordpack/ 13# 14# }}} 15 16# {{{ help message 17$help_message="Usage: chordpack [OPTION]... TASK [FILE]...\n". 18 "\n". 19 "Operate on songs for guitar found in FILEs. The songs are supposed\n". 20 "to be in chordpro format. Operation is determined by TASK, most\n". 21 "common is typesetting with TeX. Possible TASKs are tex, html, ascii,\n". 22 "nochord, transpose key-or-shift, pro. Options are\n". 23 "\n". 24 " -f song-list-file \tUse song-list-file\n". 25 " -l language \tUse language\n". 26 " -e encoding \tUse input encoding when typesetting with LaTeX\n". 27 " -b \tTypeset with minimum barre chords\n". 28 " -c chord-style \tSet the style of chord typesetting\n". 29 " -s font-sizes \tSet the font sizes\n". 30 "\n". 31 "For more detailed information see chordpack-documentation.html.\n"; 32# }}} 33# {{{ support functions 34sub warning { 35 if (not $chordpack_introduced) { 36 $chordpack_introduced=1; 37 printf STDERR "\nChordpack: warning messages:\n\n"; 38 } 39 print STDERR $_[0]; } 40 41sub check_for_the_length { 42 my ($line,$file,$maxlength)=@_; 43 44 if (length($line) > $maxlength) { 45 if (not exists($files_warned{$file})) { 46 $files_warned{$file}=1; 47 if ($error_explained==0) { 48 $error_explained=1; 49 warning "Warning >> means too long line ". 50 "(line longer than $maxlength characters).\nFile name where this happened". 51 " follows.\n";} 52 warning ">> $file.\n";}}} 53 54sub insertstring { 55 my ($inserted,$source,$position)=@_; 56 57 # Inset string $inserted into the string $source at position 58 # $position. If the position is farther than than the length of 59 # $source, die. 60 61 if ($position>=length($source)) { 62 die "insertstring: position too far.\n"; } 63 64 return substr($source,0,$position).$inserted.substr($source,$position,length($source)-$position);} 65 66# }}} 67 68# {{{ global variables and constants 69$chordpack_introduced=0; 70$error_explained=0; 71$carriage_return_warned=0; 72 73@tex_font_size = ( "\\tiny" , "\\scriptsize" , "\\footnotesize" , 74 "\\small" , "\\normalsize" , "\\large", "\\Large" , 75 "\\LARGE", "\\huge" , "\\Huge" ); 76 77# }}} 78# {{{ global options 79use Getopt::Std; 80getopts('bf:c:l:s:e:'); 81 82sub option_process { 83 my ($option,$default,$option_letter) = @_; 84 $from_options{$option}=0; 85 eval ("\$$option=\"$default\""); 86 if (eval "defined(\$opt_$option_letter)") { 87 $from_options{$option}=1; 88 eval ("\$$option=\$opt_$option_letter"); }} 89 90 91option_process("language","","l"); 92# the only supported languages are Czech and German. The default language is English. 93 94option_process("inputenc","","e"); 95# for LaTeX typesetting 96 97option_process("chord_style","m","c"); 98# chordstyle string contains mi,m or - and also h if h is required 99 100 101option_process("font_sizes",3,"s"); 102# currently available values are 0,1,2,3 103 104option_process("title_style","",""); 105 106option_process("columns",2,""); 107 108$nobarre=0; $nobarre=1 if defined($opt_b) and $opt_b==1; 109# This option cannot be set using {} command 110 111# option -f is processed in tex task 112 113$ignore_tablature=0; 114$ignore_tablature=1 if $nobarre; 115 116 117# ------------------------------------ 118 119# {{{ finalize_options 120sub finalize_options { 121 122 $language=lc($language); 123 124 $H_chord=0; 125 $chord_style_string=$chord_style; 126 for ($chord_style_string) { 127 $H_chord=1 if (/h/); 128 $chord_style="-" if (/jazz/ or /-/); 129 $chord_style="mi" if (/mi/); 130 $chord_style="low" if (/low/); } 131 132 # ------------------------- 133 134 if ($columns == 2) { 135 $pagewidth="0.47\\textwidth"; 136 $twocolumns="[twocolumn]"; 137 138 $hoffset=-1.1; 139 $textwidth=16-2*$hoffset; } 140 else { 141 $pagewidth="0.9\\textwidth"; 142 $twocolumns=""; 143 144 $hoffset=-0.5; 145 $textwidth=16-2*$hoffset; 146 147 $hoffset-=2; } 148 149 150 $font_sizes=0 if ($font_sizes<0); 151 $font_sizes=3 if ($font_sizes>3); 152 153 $text_font_size=$tex_font_size[$font_sizes+2]; 154 $chord_font_size=$tex_font_size[$font_sizes+1]; 155 $song_title_font_size=$tex_font_size[$font_sizes+4]; 156 157 $tabuline_max=180/(($font_sizes+1)**0.7*$columns**0.7); 158 $tabuline_norm=$tabuline_max*(0.6)."em"; 159 $bearable_length=$tabuline_max*(0.85); 160 161 # ------------------- Locale settings ------------------------- 162 163 # This is Czech collation for ISO 8859-2 character encoding. 164 # We do not solve a problem of other encodings, also 165 # we don't know how to tell TeX to understand Codepage1250, for instace. 166 # This collation is not prefect, but working pretty well. 167 168 $collation{"czech"}{"list"}= "\"#$%&'()*+,-.:;<=>[\\]'`{}". 169 "0123456789 A�BC�D�E��FGH".chr(0)."I�JKLťMN�O�PQR�S�T�U��VWXY�Z�". 170 "a�bc�d�e��fgh".chr(0)."i�jkl�mn�o�pqr�s�t�u��vwxy�z�"; 171 $collation{"czech"}{"replace"}={"ch" => chr(0) }; 172 173 174 while (1) { 175 if ($language eq "czech") { 176 $alphabetical_name="Abecedn� seznam"; 177 $transposed_by_1="Transponov�no o "; 178 $transposed_by_2=" p�lton�."; 179 last; } 180 if ($language eq "german") { 181 $alphabetical_name="Alphabetischer index"; 182 $transposed_by_1="Transponiert um "; 183 $transposed_by_2=" Halbt�ne."; 184 last; } 185 186 # english is default 187 $alphabetical_name="Alphabetical index"; 188 $transposed_by_1="Transposed by "; 189 $transposed_by_2=" halftones."; 190 last; } 191 192 # ---------------------- 193 194 $songtitles_newpage=""; 195 for ($title_style) { 196 $songtitles_newpage="\\newpage" if (/songnewpage/); } 197 198 $album_title_font_size="\\Huge"; 199 200 setup_collation(); 201 202 #print STDERR %collation_hash; 203} 204 205 206# }}} 207 208 209 210# }}} 211 212# {{{ shared functions 213sub min { 214 return $_[0]<$_[1]?$_[0]:$_[1]; } 215 216sub find_chords { 217 my $crdprep = $_[0]; 218 for ($crdprep) { 219 s/^[^\]]*\[//; 220 s/\][^\]]*$//; } 221 return split (/][^[]*\[/, $crdprep); } 222 223sub find_text { 224 # parameters: 1 - string of mixed text/chord 225 # 2 - possibly bool indicating whether we sould 226 # fix odd characters for tex 227 @text = split (/\[[^:\]]*\]/,$_[0]); 228 if ($_[1]) { 229 for (@text) { 230 $_=fix_odd_characters($_); }} 231 return @text; } 232# }}} 233# {{{ transposition "class" 234 235# transposition functions and constants are listed 236# here because they are neede not only in transposition 237# but also in tex setting 238 239 240# {{{ constants 241%chord_to_offset = ("C", 0,"C#",1, "Db",1, 242 "D", 2, "D#",3, "Eb",3, 243 "E", 4, 244 "F", 5,"F#",6,"Gb",6, 245 "G", 7,"G#",8,"Ab",8, 246 "A", 9,"A#",10,"Bb",10, 247 "H", 11, 248 "B", 11); 249 250# chord_price 251 252for my $offset (0..11) { 253 for my $minor (0..1) { 254 $chord_price[$offset][$minor]=0; }} 255 256$chord_price[0][0]=-2; 257$chord_price[5][0]=-1; 258$chord_price[7][0]=-1; 259$chord_price[2][1]=-1; 260$chord_price[4][1]=-1; 261$chord_price[9][1]=-2; 262 263# key_norm 264 265@key_norm=("b","b","#","b","#","b","b","#","b","#","b","#"); 266 267# chord_barre 268 269for my $offset (0..11) { 270 for my $minor (0..1) { 271 $chord_barre[$offset][$minor]=1; }} 272 273$chord_barre[0][0]=0; 274$chord_barre[2][0]=0; 275$chord_barre[2][1]=0; 276$chord_barre[4][0]=0; 277$chord_barre[4][1]=0; 278$chord_barre[7][0]=0; 279$chord_barre[9][0]=0; 280$chord_barre[9][1]=0; 281 282# barre recognition is simplified 283# e.g. B7 is not barre, but we care only about base note and 284# major/minor. 285 286# }}} 287 288sub transpose_basic { 289 # global $norm, $shift 290 291 # Down shares 292 293 $transposed=$_[0]; 294 for (my $i=0; $i<$shift; ++$i) { 295 transpose_basic_one_up();} 296 297 # normalize 298 if ($norm eq "b") { 299 for ($transposed) { 300 s/C\x23/Db/; 301 s/D\x23/Eb/; 302 s/F\x23/Gb/; 303 s/G\x23/Ab/; 304 s/A\x23/Bb/; }} 305 else { 306 for ($transposed) { 307 s/Db/C\x23/; 308 s/Eb/D\x23/; 309 s/Gb/F\x23/; 310 s/Ab/G\x23/; 311 s/Bb/A\x23/; }} 312 313 for ($transposed) { 314 s/mi/m/; 315 s/min/m/; 316 s/H/B/; } 317 return $transposed; } 318 319sub transpose_basic_one_up { 320 # global $transposed 321 # Transpose one chord by one halftone up 322 323 for ($transposed) { 324 s/H/B/; 325 if (s/C\x23/D/) {last;} 326 if (s/D\x23/E/) {last;} 327 if (s/F\x23/G/) {last;} 328 if (s/G\x23/A/) {last;} 329 if (s/A\x23/B/) {last;} 330 331 if (s/Db/D/) {last;} 332 if (s/Eb/E/) {last;} 333 if (s/Gb/G/) {last;} 334 if (s/Ab/A/) {last;} 335 if (s/Bb/B/) {last;} 336 337 if (s/C/C\x23/) {last;} 338 if (s/D/D\x23/) {last;} 339 if (s/E/F/) {last;} 340 if (s/F/F\x23/) {last;} 341 if (s/G/G\x23/) {last;} 342 if (s/A/A\x23/) {last;} 343 if (s/B/C/) {last;}}} 344 345sub transpose { 346 # global @tpose, $transposition 347 # global /*out*/ @tpose 348 349 # $transposition is one of: 350 # . "nobarre" 351 # . an integer (number of halftones to be transposed up) 352 # . destination key 353 354 # @tpose is an array of lines from chordpro songfile to be transposed 355 356 # <i>Normalization</i> is setting either with # or with b depending on 357 # key of the paragraph. 358 359 360 361 # {{{ Count chord frequencies 362 363 # count separately for each paragraph 364 365 $paragraph=0; 366 $was_space=1; 367 368 for (@tpose) { 369 chomp;$_.="\n"; #Every line _really_ has endline character 370 371 # {{{ Chords 372 373 if (/\[/) { 374 enter_paragraph_if_required(); 375 376 my @chords = find_chords($_); 377 378 for (@chords) { 379 s/^\((.*)\)$/$1/; #kill brackets 380 381 s/\/.*$//; #kill bass 382 s/maj//; 383 $minor=(/m/); 384 $minor=0 if (not $minor); 385 386 $base=substr($_,0,1); 387 $base.="b" if (/^.b/); 388 $base.="#" if (/^.\x23/); 389 #print "$paragraph\n"; 390 ++$chord_count[$paragraph][$chord_to_offset{$base}][$minor]; } 391 next } 392 393 # }}} 394 # {{{ Whitespace 395 if (/^\s*$/) { 396 $was_space=1; next } 397 # }}} 398 # {{{ Text 399 enter_paragraph_if_required(); 400 # }}} 401 } 402 $paragraphs=$paragraph; 403 404 # global statistics if nobarre transposition 405 406 if ($transposition eq "nobarre") { 407 for $minor (0..1) { 408 for $offset (0..11) { 409 $song_chord_count[$offset][$minor]=0; }} 410 for $paragraph (1..$paragraphs) { 411 for $minor (0..1) { 412 for $offset (0..11) { 413 $song_chord_count[$offset][$minor]+= 414 $chord_count[$paragraph][$offset][$minor]; }}}} 415 416 417 # }}} 418 # {{{ Determine best keys 419 420 for ($paragraph=1; $paragraph<=$paragraphs; ++$paragraph) { 421 422 # {{{ debugging print 423 # print $chord_count[$paragraph];print "\n\n"; 424 425 #for my $minor (0..1) { 426 # print "min:$minor: "; 427 # for my $chord (0..11) { 428 # print "$chord_count[$paragraph][$chord][$minor] "; 429 # } 430 # print "\n"; 431 #} 432 # }}} 433 434 $bestvalue0=10000; 435 $bestkey0=0; 436 for $key (0..11) { 437 $value=0; 438 for my $chord (0..11) { 439 for my $minor (0..1) { 440 $value+=$chord_price[($chord-$key) % 12][$minor] * 441 $chord_count[$paragraph][$chord][$minor]; }} 442 $bestvalue0=$value,$bestkey0=$key if $value<$bestvalue0; } 443 $bestkey[$paragraph]=$bestkey0; 444 $bestvalue[$paragraph]=$bestvalue0; } 445 # }}} 446 # {{{ Determine numeric shift 447 if ($transposition eq "nobarre") { 448 $bestshift=0; 449 $bestprice=100000; 450 for $shift (0..11) { 451 $price=0; 452 for $minor (0..1) { 453 for $offset (0..11) { 454 $price+=($song_chord_count[$offset][$minor] 455 * $chord_barre[($offset+$shift)%12][$minor]) }} 456 if ($price<$bestprice) { 457 $bestprice=$price; 458 $bestshift=$shift; }} 459 $shift=$bestshift; } 460 elsif ($transposition =~ /^[-0-9]+$/) { 461 $shift=$transposition % 12; } 462 else { 463 $shift=-1; 464 for $paragraph (1..$paragraphs) { 465 if ($bestvalue[$paragraph]<0) { 466 if (not exists $chord_to_offset{$transposition}) { 467 warning("Key \"$transposition\" is unknown.\n"); 468 exit; } 469 $shift=($chord_to_offset{$transposition}-$bestkey[$paragraph]) % 12; 470 last; }}} 471 # }}} 472 # {{{ Transpose and normalize 473 $paragraph=0; 474 $was_space=1; 475 476 for (@tpose) { 477 if (/\[/) { # Chord instructions 478 if ($was_space) { 479 $was_space=0; 480 ++$paragraph; 481 $norm=$key_norm[($bestkey[$paragraph]+$shift)%12]; } 482 483 # {{{ Ensure chords contain no spaces 484 if (/\[[^\]]* [^\]]*\]/) { 485 warning "\nSetchord: Chords cannot contain spaces.\n"; 486 warning "This was broken at file $ARGV:\n"; 487 warning $_; 488 exit; } 489 # }}} 490 491 my @text = split (/\[[^\]]*\]/,$_); 492 my @chords = find_chords($_); 493 # {{{ Transpose 494 for (@chords) { 495 @basses = split (/\//,$_); 496 $tpose=transpose_basic($basses[0]); 497 $tpose.="/".transpose_basic($basses[1]) if ($#basses==1); 498 $_=$tpose; } 499 # }}} 500 # {{{ Print everything out 501 my $out = shift @text; 502 my $textpos=0; 503 for (@chords) { 504 $out.="[$_]$text[$textpos]"; 505 ++$textpos; } 506 $_= $out; # Write the result back to array 507 # }}} 508 next; } 509 if (/^\s*$/) { # Whitespace 510 $was_space=1; next; } 511 if ($was_space) { # ext or instruction 512 $was_space=0; 513 ++$paragraph; 514 $norm=$key_norm[($bestkey[$paragraph]+$shift)%12]; }} 515 # }}} 516 # {{{ Inform about cappo (the case of nobarre) 517 if ($transposition eq "nobarre" and $shift!=0) { 518 $capo=(12-$shift); 519 if ($capo<6) { 520 $capotext="{c:Cappo $capo}\n"} 521 else { 522 $capotext="{c:".$transposed_by_1.$shift.$transposed_by_2."}\n"} 523 524 splice @tpose,1,0,$capotext; } 525 # }}} 526} 527 528sub enter_paragraph_if_required { 529 # initializes @chord_count array by the way 530 if ($was_space) { 531 ++$paragraph; $was_space=0; 532 533 for my $chord (0..11) { 534 for my $minor (0..1) { 535 $chord_count[$paragraph][$chord][$minor]=0;}}}} 536 537 538# }}} 539 540# {{{ collation functions 541sub setup_collation { 542 # global $language,%collation 543 # print STDERR "[".$language."]"; 544 545 if (defined($collation{$language})) { 546 #print STDERR "defined"; 547 @collation_list=split(//,$collation{$language}{"list"}); 548 $i=0; 549 for (@collation_list) { 550 $collation_hash{$_}=$i; 551 ++$i;}} 552 if (defined($collation{$language}{"replace"})) { 553 $collation_replace_ref=$collation{$language}{"replace"}; 554 %collation_replace=%$collation_replace_ref; }} 555 556sub by_locale_collation { 557 # global $language,%collation 558 # print STDERR "byloc"; 559 560 my $aa=$a; 561 my $bb=$b; 562 while (($old, $new) = each %collation_replace) { 563 $aa=~s/$old/$new/g; 564 $bb=~s/$old/$new/g; } 565 566 $i=0; 567 $min_length=min(length($aa),length($bb)); 568 # print STDERR $min_length; 569 while ($i<$min_length) { 570 # print STDERR "[".substr($aa,$i,1)."]"; 571 if ($collation_hash{substr($aa,$i,1)} < $collation_hash{substr($bb,$i,1)}) { 572 return -1; } 573 if ($collation_hash{substr($aa,$i,1)} > $collation_hash{substr($bb,$i,1)}) { 574 return 1; } 575 ++$i; } 576 return 0; } 577# }}} 578 579$task = shift @ARGV; 580 581# {{{ undefined task 582if (not defined($task)) { 583 print STDERR $help_message; 584 exit; } 585# }}} 586# {{{ learn os dependecies 587$long_newlines_os=0; 588if ($^O eq "dos" or $^O eq "MSWin32" or $^O eq "os2") { 589 $long_newlines_os=1; } 590# }}} 591# {{{ tex 592 593 # {{{ to_nobarre_if_required 594 sub to_nobarre_if_required { 595 if ($nobarre) { 596 my $songstart=0; 597 @tpose=(); 598 push @input,"{title:none}"; # Add one false song start at an end 599 my $i=0; 600 while ($i<=$#input) { 601 if ($input[$i] =~ /\x7btitle:/) { 602 $transposition="nobarre"; 603 transpose(); 604 #warning "I transpose, sir.\n"; 605 splice @input,$songstart,$i-$songstart,@tpose; 606 $i=$songstart+$#tpose+1; # Correct $i so that it points to 607 # position after inserted transposed song 608 @tpose=$input[$i]; 609 $songstart=$i; } 610 else { 611 push @tpose,$input[$i]; } 612 ++$i;} 613 pop @input; } # Pop false song start 614 } 615 616# }}} 617 # {{{ set_one_chord 618sub set_one_chord { 619 my $set=""; 620 $_=$_[0]; 621 622 # {{{ Switch B <-> H notation (B is common) 623 if ($H_chord) { 624 s/B([^b])/H$1/g; 625 s/B$/H/g; } 626 else { 627 s/H/B/g; } 628 # }}} 629 630 $set.="\\sf "; 631 # It is nice to represent special sequences with nonprintable characters. 632 s/maj/\001/;s/mi/m/;s/min/m/;s/dim/\002/;s/m75-/z/; 633 s/\0017/\001/;s/7\001/\001/; 634 635 # brackets 636 my $brackets=0; 637 if (/^\(.*\)$/) { 638 s/\(//;s/\)//; 639 $brackets=1; 640 $set.="("; } 641 # basses 642 my $bass=""; 643 if (/\//) { 644 @basssplit = split(/\//,"$_"); 645 ($bass = $basssplit[1]) =~ s/\043/h/; #043 is octal hash 646 $_ = $basssplit[0]; } 647 648 my $majset;my $dimset;my $minorset;my $minorshiftedbase; 649 650 # {{{ Chord style dependencies 651 for ($chord_style) { 652 if (/^\-$/) { 653 $majset="\$\\triangle\$"; 654 $dimset="o"; 655 $minorset="\\raisebox{0.26ex}{--}"; 656 $minorshiftedbase="F"; 657 last} 658 if (/^mi$/) { 659 $majset="maj7"; 660 $dimset="dim"; 661 $minorset="mi"; 662 $minorshiftedbase="?"; 663 last} 664 if (/^m$/) { 665 $majset="7maj"; 666 $dimset="dim"; 667 $minorset="m"; 668 $minorshiftedbase="?";} 669 if (/^low$/) { 670 $majset="7maj"; 671 $dimset="dim"; 672 $minorset="low"; 673 $minorshiftedbase="?";}} 674 # }}} 675 676 my $bot=""; my $top=""; 677 my $bot0=""; my $top0=""; 678 my $puttobot=0; 679 my $numfound=0; 680 my $force_stay_in_upper_index=0; 681 my @CHORD = split (//, $_); 682 $basenote=uc(shift @CHORD); # uc() is upper_case() 683 684 685 # if not reasonable chord, do not try to set indices 686 if (not $basenote=~/[ABCDEFGH]/) { 687 return "\\sf ".$_[0]."\\hskip.7em"; } 688 689 #$set.=$basenote; 690 for (@CHORD) { 691 if ($puttobot) { $bot.=$_; next; } 692 if ($numfound and /[2-9]/ and not $force_stay_in_upper_index) { 693 $bot.=$_; $puttobot=1; next; } 694 695 if (/[-\(]/) { 696 $force_stay_in_upper_index=1; $top.=$_; next; } 697 if (/\)/) { 698 $force_stay_in_upper_index=0; $top.=$_; next; } 699 700 if (/\001/) { 701 my $dest=\$top; 702 if ($numfound) { 703 $puttobot=1; 704 $dest=\$bot;} 705 706 if ($chord_style eq "mi") { 707 $$dest.=7; 708 $bot0.=" " if $bot0; 709 $bot0.="maj"; 710 $numfound=1; next; } 711 $$dest.=$majset; $numfound=1; next; } # maj 712 713 if (/[2-9]/) { $top.="$_"; $numfound=1; next; } 714 if (/\002/) { $top.=$dimset; next; } # dim 715 if (/z/) { $top.="\$\\varnothing\$"; next; } 716 if (/b/) { $top0.="\$\\hskip0.1em\\mathbf{\\flat}\$"; next; } 717 if (/\x23/) { $top0.="\$\\hskip0.1em\\mathbf{\\sharp}\$"; next; } 718 # \x23 is octal hash 719 720 if (/m/) { # minor 721 if ($chord_style eq "-" and 722 not $basenote eq $minorshiftedbase) {$bot0.="\\hskip0.1em"} 723 $bot0.=$minorset; next;} 724 if (/\+/) { $bot.="+"; next; } # + 725 $top.="$_"; } 726 727 # Set basenote 728 729 if ($chord_style eq "low" and $bot0) { 730 $set.=lc($basenote); 731 $bot0=""; } 732 else { 733 $set.=$basenote; } 734 735 # Now INDEXES are really nasty 736 INDEXES: { 737 if (not $top0 and not $bot and $bot0 and $top and $chord_style eq "-") { 738 $set.="\\crdx{$top}{$bot0}{}{}"; # Typical case of Fm7 739 last INDEXES; } 740 if (not $top and $bot eq "+") { 741 if ($top0 =~ /flat/) { 742 $set.="\\crdx{$top0}{$bot0}{}{}\\hskip-.3em+"; 743 last INDEXES; } 744 745 $set.="\\crdx{$top0}{$bot0}{}{}\\hskip-.1em+"; 746 last INDEXES; } 747 748 if ($top =~ /dim/) { #case of dim in "m" and "mi" style setting 749 $set.="\\crdx{$top0}{$bot0}{}{}dim"; 750 last INDEXES; } 751 752 $set.="\\crdx{$top0}{$bot0}{$top}{$bot}"; 753 } 754 # 755 756 @basses = split(//,$bass); 757 $set.="\\crdbass{$bass}{}" if ($#basses==(1-1)); 758 $set.="\\crdbass{$basses[0]}{$basses[1]}" if ($#basses==(2-1)); 759 760 $set.=")" if ($brackets); 761 762 $set.="\\hskip.7em"; 763 return $set; } 764 765 766# }}} 767 # {{{ set_tex_head 768sub set_tex_head { 769 770 finalize_options(); 771 if (defined($output_file_base)) { 772 create_alphabetical_toc ($output_file_base); } 773 774 to_nobarre_if_required(); 775 776 $head="\\documentclass${twocolumns}{article}\n"; 777 if ($language eq "czech") { 778 $head.="\\usepackage{czech}\n"; } 779 if ($inputenc) { 780 $head.="\\usepackage[$inputenc]{inputenc}\n"; } 781 if ($language eq "german") { 782 $head.="\\usepackage{german}\n"; } 783 $head.="\\usepackage{palatino} 784\\usepackage{amsfonts,amssymb} 785\\usepackage{colortbl} 786\\usepackage{verbatim} 787\\usepackage{graphics} 788\\usepackage{exscale} 789\\textwidth=${textwidth}cm 790\\hoffset=${hoffset}cm 791\\textheight=26cm 792\\voffset=-3cm 793\\columnsep=0.07\\columnwidth% This is the size of white space separating two columns 794% 795% 796% ================================== 797% Commands and environments 798% ================================== 799% 800% 801\\newcommand{\\N}{\\\\\\rule{0pt}{0pt}} 802% /\ This is a newline which does not produce underfull box warnings. 803\\newcommand{\\spc}{\\setbox0=\\hbox{x}\\hskip\\wd0} 804\\newcommand{\\largeskip}{\\bigskip\\bigskip} 805% silent \\par not producing undefull hboxes (hack a little) 806\\newcommand{\\spar}{\\rule{0pt}{0pt}\\par} 807 808\\newcommand{\\maxskip}[2]{% 809\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}% 810\\ifdim\\wd0<\\wd1\\hskip\\wd1\\else\\hskip\\wd0\\fi}% 811 812\\newdimen\\tempdimen% 813 814\\newcommand{\\filldifrule}[3]{% 815\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}% 816\\ifdim\\wd1<\\wd0% 817\\tempdimen=\\wd0% 818\\advance\\tempdimen by - \\wd1% 819\\ifdim\\tempdimen<0.3em\\tempdimen=0.3em\\fi% 820\\advance\\tempdimen by -0.1em% 821\\hskip0.05em% 822\\rule[.5ex]{\\tempdimen}{0.12ex}% 823\\hskip0.05em% 824\\else% 825#3% 826\\fi} 827 828\\newcommand{\\skipdif}[2]{% 829\\setbox0=\\hbox{#1}\\setbox1=\\hbox{#2}% 830\\ifdim\\wd1<\\wd0% 831\\tempdimen=\\wd0% 832\\advance\\tempdimen by - \\wd1% 833\\hskip\\tempdimen% 834\\fi} 835 836\\newcommand{\\leftrepeat}{% 837\\rule[-0.3ex]{0.05em}{2ex}\\hskip0.1em\\rule[-0.3ex]{0.05em}{2ex}% 838\\hskip0.1em\\raisebox{0.1ex}{:} } 839 840\\newcommand{\\rightrepeat}{% 841 \\raisebox{0.1ex}{:}\\hskip0.1em% 842\\rule[-0.3ex]{0.05em}{2ex}\\hskip0.1em\\rule[-0.3ex]{0.05em}{2ex}} 843 844"; 845 846$song_title_shared_start= 847"\\newcommand{\\songtitle}[2]{ 848\\spar\\vfill 849$songtitles_newpage% 850\\begin{minipage}{\\columnwidth}% 851\\addcontentsline{toc}{subsection}{#1}% 852"; 853 854$song_title_shared_end="\\bigskip 855\\end{minipage}\\nopagebreak[4]\\par\\nopagebreak[4]}"; 856 857 858 859SONGTITLE: { 860 if ($title_style =~ /norule/) { 861 $head.=$song_title_shared_start. 862"{$song_title_font_size \\sf\\bfseries #1\\\\[0.2ex]}% 863{\\it #2}% 864".$song_title_shared_end; 865 last SONGTITLE; } 866 867 if ($title_style =~ /graybox/) { 868 $head.=$song_title_shared_start. 869"\\begin{tabular}{>{\\columncolor[gray]{0.8}}p{\\textwidth}}% 870$song_title_font_size \\sf\\bfseries\\rule{0pt}{1.6ex}#1% 871\\end{tabular}\\\\[1.5ex]% 872{\\it #2}% 873".$song_title_shared_end; 874 last SONGTITLE; } 875 876 # default style - rule 877 878 $head.=$song_title_shared_start. 879 "\\rule{\\textwidth}{.5ex}\\\\[1.3ex]\n". 880 "{$song_title_font_size \\sf\\bfseries #1\\\\[0.2ex]}%\n". 881 "{\\it #2}%\n".$song_title_shared_end; 882 883} 884 885 $head.=" 886\\newcommand{\\albumtitle}[1]{ 887%\\spar 888\\vfill 889\\newpage 890\\begin{minipage}{\\columnwidth} 891\\addcontentsline{toc}{section}{#1} 892\\rule{\\textwidth}{.7ex}\\\\ 893$album_title_font_size \\sf\\bfseries #1% 894\\bigskip\\bigskip\\bigskip 895\\end{minipage}} 896 897\\newcommand{\\tabuline}[1]{ 898\\def\\emptyparameter{}% 899\\def\\currentparameter{#1}% 900\\ifx\\emptyparameter\\currentparameter% 901% This is a case of empty line. Empty line is not as high as nonempty line. 902\\colorbox[gray]{0.87}{\\rule{0pt}{1ex}\\rule{0.95\\textwidth}{0pt}}% 903\\else% 904% This is a case of nonempty line. 905\\colorbox[gray]{0.87}{% 906\\resizebox{0.95\\textwidth}{1.5ex}{% 907\\rule{0pt}{1.5ex}#1\\setbox0=\\hbox{#1}\\hskip-\\wd0\\rule{$tabuline_norm}{0pt}% 908}% 909}% 910\\fi% 911\\\\[-0.3ex]% 912} 913"; 914 915 $head.= " 916\\newcommand{\\crdx}[4]{ 917\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#1}_\\textsf{#2}\$}% 918\\hskip0.25em 919\\if:#1:\\if:#2:\\hskip0.1em\\fi\\fi 920\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#3}_\\textsf{#4}\$}} 921" if ($chord_style eq "-"); 922 923 $head.= " 924\\newcommand{\\crdx}[4]{ 925\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#1}\$}% 926\\hskip0.25em% 927\\if:#2: 928\\else\\hskip-0.3em{}#2\\hskip0.3em\\fi 929\\hskip-0.3em\\lower-0.2ex\\hbox{$chord_font_size\$^\\textsf{#3}_\\textsf{#4}\$}} 930" if ($chord_style =~ /m|mi|low/); 931 932 $head.= " 933\\newcommand{\\crdbass}[2]{ 934\\hskip-0.4em\\big/#1\\crdx{\$% 935\\if b#2% 936\\flat\\fi\\if h#2% 937\\sharp\\fi\$}{}{}{}} 938 939\\newenvironment{tabbingnb} 940{\\noindent 941\\begin{minipage}{0.4\\textwidth}\\begin{tabbing}} 942{\\end{tabbing}\\end{minipage}\\par\\vskip-\\baselineskip}\n"; 943 944$head_after_begin_document=" 945% 946% 947% =========================== 948% BEGIN DOCUMENT 949% =========================== 950% 951% 952\\begin{document} 953\\setlength{\\parindent}{0pt} 954\\boldmath 955$text_font_size\n"; 956$head_after_begin_document.="\\csprimeson\n" if ($language eq "czech"); 957 958#------------------------------------ 959 960$table_of_contents.= " 961% 962% 963% ===================== 964% TABLE OF CONTENTS 965% ===================== 966% 967% 968\\thispagestyle{empty} 969 970\\tableofcontents 971 972%This is macro of Petr Olsak. It inputs the file but 973%does not cry, if file does not exist 974 975\\newread\\testin 976\\def\\softinput #1 {\\let\\next=\\relax \\openin\\testin=#1 977\\ifeof\\testin% 978\\else\\closein\\testin\\def\\next{\\input #1 }\\fi 979\\next} 980 981% Insert alphabetical table of contents, 982% if there is one 983 984\\openin\\testin=\\jobname.atoc 985\\ifeof\\testin\\closein\\testin% 986\\else\\closein\\testin 987\\newpage 988\\section*{$alphabetical_name} 989\\softinput \\jobname.atoc 990\\fi 991 992\\clearpage\n"; 993 994$titlepage_head=" 995% 996% ======================= 997% Titlepage 998% ======================= 999% 1000\\thispagestyle{empty} 1001\\ 1002\\vskip16\\baselineskip 1003{\\Huge 1004\\begin{tabular*}{\\textwidth}{c} 1005\\hskip\\textwidth\\ \\\\ 1006\\bfseries "; 1007 1008$titlepage_tail= " 1009\\end{tabular*}} 1010\\clearpage"; 1011 1012} 1013# }}} 1014 # {{{ fix_odd_characters 1015sub fix_odd_characters { 1016 # fix odd characters for normal text and chords 1017 # (there is other slightly different fixing process for tabulatures) 1018 1019 $_=$_[0]; 1020 1021 # Backslashes previously inserted by chordpack 1022 # are coded by character with ascii code 01. 1023 1024 # assumption - there are no nonprintable characters 1025 # this assumption may later be explicitly checked 1026 1027 s/\\/\x00/g; # mark backslashes 1028 1029 for ($ascii=33;$ascii<=38;++$ascii) { 1030 $re="\\x".sprintf "%.2x",$ascii; 1031 s/$re/\\char$ascii\x02/g; } #\x02 is reserved for {} 1032 1033 s/\{/\$\\{\$/g; s/\}/\$\\}\$/g; 1034 s/\^/\\char094\x02/g; 1035 s/\|/\$\|\$/g; 1036 s/</\$<\$/g; 1037 s/>/\$>\$/g; 1038 s/~/\\~{}/g; 1039 s/\[/\$\[\$/g; s/\]/\$\]\$/g; 1040 1041 1042 # backslashes must be done on their own 1043 s/\x00/\$\\backslash\$/g; 1044 s/\x01/\\/g; 1045 s/\x02/\{\}/g; 1046 return $_; 1047} 1048# }}} 1049 # {{{ set_songtitle 1050sub set_songtitle { 1051 # global $songtitle 1052 # global @subtitles 1053 1054 $subtitle_set=""; 1055 for (@subtitles) { 1056 $subtitle_set.=$_."\\\\"; } 1057 print "%\n%\n%\n%\n\\songtitle{$songtitle}{$subtitle_set}%\n"; } 1058 1059# }}} 1060 # {{{ previous_block_care 1061sub previous_block_care { 1062 # global $previous_block 1063 1064 $pb=$previous_block; 1065 1066 if ($previous_block==1) {} 1067 1068 if ($pb==1) { 1069 print $_[0]; } 1070 if ($pb==2) { 1071 print $_[1]; } 1072 if ($pb==3) { 1073 set_songtitle(); } 1074 $previous_block=0; } # global change 1075 1076# }}} 1077 # {{{ create_alphabetical_toc 1078sub create_alphabetical_toc { 1079 # global $previous_block 1080 1081 # print STDERR "creating alphabetical"; 1082 1083 $output_file_base=$_[0]; 1084 1085 if (open(TOC,$output_file_base.".toc")) { 1086 while (<TOC>) { 1087 push @toc,$_; } 1088 close (TOC); 1089 1090 # There may be a problem with sorting for languages. I do not know a solution. 1091 # I suppose in that case alphabetical must be edited manually. 1092 1093 # To be done: 1094 # . switch and option producing alphabetical 1095 # . discuss languages 1096 # . update documentation (not alphabetical, but atoc) 1097 1098 # print STDERR %collation_hash; 1099 1100 @sorted_toc = defined(%collation_hash) ? sort by_locale_collation @toc : sort @toc; 1101 @alpha_toc = grep(!/{sect.*}/, @sorted_toc); 1102 1103 open(ATOC,">".$output_file_base.".atoc"); 1104 for (@alpha_toc) { 1105 print ATOC $_; } 1106 close (ATOC); }} 1107 1108# }}} 1109 1110 1111if ($task eq "tex") { 1112 1113 my $previous_line=0; 1114 $previous_block=0; 1115 # previous_line: 0=emptyline, 1=text_line, 2=chord, 3=songtitle, 4=albumtitle 1116 # previous_block: 0=we're in block, 1=text_line, 2=chord, 3=songtitle, 4=albumtitle 1117 1118 1119 # Definitions: 1120 # White line is a line which contains only whitespace character. 1121 # Block is a maximal sequence of lines which are not white. 1122 # Lines can be of several kinds, one block can contain lines of 1123 # different kinds. 1124 # A kind of a block is the kind of last line of that block. 1125 1126 # Variable Previousblock contains the kind of previous block. 1127 # An exception to this is songtitle, which sets previousblock explicitly 1128 # as it's current block. 1129 1130 %files_warned=(); 1131 $head_printed=0; 1132 $verbatim_tex=0; 1133 $table_of_contents_printed=0; 1134 $tex_prebegin_part=0; 1135 $in_tablature=0; 1136 $subtitles_enabled=0; 1137 1138 # {{{ Read input into @input variable 1139 1140 @input=(); 1141 $stdout_opened=0; 1142 if (defined($opt_f)) { 1143 1144 open(FILE,"$opt_f") or warning("File \"$opt_f\" does not exist."),exit; 1145 $mainpath=$opt_f;$mainpath =~ s|/[^/]*$|/|; chdir "$mainpath"; 1146 1147 $verbatim_lines=0; 1148 while(<FILE>) { 1149 if (/^\x23/) {next} # comment 1150 if (s/^ //) {push @input,"$_";next} # just one line is verbatim 1151 if (/^\s*$/) {next} # whitespace line 1152 1153 chomp; 1154 open(FILE2,"$_") or warning("File \"$_\" does not exist."),exit; 1155 my $filename="$_"; 1156 while(<FILE2>) { 1157 #check_for_the_length("$_",$filename,$bearable_length); 1158 push @input,"$_"; } 1159 close(FILE2);} 1160 close(FILE); 1161 1162 # Open output 1163 $output_file=$opt_f; 1164 for ($output_file) { 1165 if (not s/\.[^.]*$/.tex/) { 1166 s/$/.tex/; }} 1167 1168 # Alphabetical file 1169 $output_file_base=$output_file; 1170 $output_file_base=~s/\.[^.]*$//; # remove .tex 1171 1172 open(STDOUT,">".$output_file); 1173 $stdout_opened=1; } 1174 else { 1175 while (<>) { 1176 #check_for_the_length("$_",$ARGV,$bearable_length); 1177 push @input,"$_"; }} 1178 1179 # }}} 1180 1181 for (@input) { 1182 chomp; 1183 # {{{ Remove carriage return 1184 if (not $long_newlines_os) { 1185 if (s/\x0d//g) { 1186 if (not $carriage_return_warned) { 1187 warning "Your chordpro files have DOS carriage return ends of line". 1188 " - not a serious problem.\n"; 1189 $carriage_return_warned=1; }}} 1190 # }}} 1191 1192 # {{{ Parenthesis 1193 s/\" /\'\' /g; 1194 s/\"$/\'\'/g; 1195 s/ \"/ \`\`/g; 1196 s/^\"/\`\`/g; 1197 # }}} 1198 1199 # Process line 1200 1201 # {{{ Head not yet printed 1202 if (not $head_printed) { 1203 # {{{ Remove comment 1204 s/\x23.*$//; 1205 # }}} 1206 1207 # {{{ In TeX prebegin 1208 if ($tex_prebegin_part) { 1209 if (/\173tex_prebegin_end/) { 1210 $tex_prebegin_part=0; 1211 set_tex_head(); 1212 print "$head"; 1213 print "$tex_prebegin_text"; 1214 print "$head_after_begin_document"; 1215 $head_printed=1; 1216 next; } 1217 $tex_prebegin_text.="$_\n"; next} 1218 # }}} 1219 1220 # {{{ Chordstyle 1221 if (/{chordstyle:.*}/) { 1222 if ($from_options{"chord_style"}) { 1223 next; } 1224 1225 s/{[^:]*: *//; s/}//; 1226 $chord_style=$_; 1227 next; } 1228 # }}} 1229 # {{{ Language 1230 if (/{language:.*}/) { 1231 if ($from_options{"language"}) { 1232 next; } 1233 1234 s/{[^:]*: *//; s/}//; 1235 $language=$_; 1236 next; } 1237 # }}} 1238 # {{{ Fontsize 1239 if (/{fontsize:.*}/) { 1240 if ($from_options{"font_sizes"}) { 1241 next; } 1242 1243 s/{[^:]*: *//; s/}//; 1244 1245 $font_sizes=$_; 1246 next; } 1247 # }}} 1248 # {{{ Title style 1249 if (/{titlestyle:.*}/) { 1250 if ($from_options{"title_style"}) { 1251 next; } 1252 1253 s/{[^:]*: *//; s/}//; 1254 1255 $title_style=$_; 1256 next; } 1257 # }}} 1258 # {{{ Columns 1259 if (/{columns:.*}/) { 1260 if ($from_options{"columns"}) { 1261 next; } 1262 1263 s/{[^:]*: *//; s/}//; 1264 1265 $columns=$_; 1266 next; } 1267 # }}} 1268 1269 # {{{ Emptyline 1270 if (/^\s*$/) { 1271 next; } 1272 # }}} 1273 1274 # {{{ Songbook title 1275 if (/{songbooktitle:.*}/) { 1276 s/{[^:]*: *//; s/}//; 1277 s/&/\\&/g; 1278 1279 @titlelist = split (/\^/, $_ ); 1280 1281 set_tex_head(); 1282 print "$head"; 1283 print "$head_after_begin_document"; 1284 print "$titlepage_head"; 1285 1286 for (@titlelist) { 1287 print "$_\\\\\n"; } 1288 1289 print "$titlepage_tail"; 1290 print "$table_of_contents"; 1291 $table_of_contents_printed=1; 1292 1293 $head_printed=1; 1294 next; } 1295 # }}} 1296 # {{{ Songbook title not found 1297 if (/{tex_prebegin_start.*}/) { 1298 $tex_prebegin_part=1; 1299 $tex_prebegin_text=""; next} 1300 1301 set_tex_head(); 1302 print "$head"; 1303 print "$head_after_begin_document"; 1304 $head_printed=1; 1305 # }}} 1306 } 1307 # }}} 1308 # {{{ Command allowed only in before head 1309 if (/{fontsize.*}/ or /{language.*}/ or /{titlestyle.*}/ or /{columns.*}/ 1310 or /{chordstyle.*}/ ) { 1311 warning ("Command $_ can be used only before first {album: } or {title: } command is used.\n"); 1312 next; } 1313 # }}} 1314 # {{{ In Verbatim TeX 1315 if ($verbatim_tex) { 1316 if (/{vtexe.*}/ or /{verbatim_tex_end.*}/) { 1317 $verbatim_tex=0; next; } 1318 print "$_\n"; next; } 1319 # }}} 1320 # {{{ In tablature 1321 if ($in_tablature) { 1322 if (/{eot.*}/ or /{end_of_tab.*}/) { 1323 $in_tablature=0; 1324 if (not $ignore_tablature) { 1325 # \\rule is here just to prevent underfull hbox messages 1326 print "\\rule{0pt}{0pt}\\end{minipage}\n"}; 1327 next} 1328 1329 if (not $ignore_tablature) { 1330 $_=substr($_,0,$tabuline_max); 1331 s/^ +$//g; #no whitespace lines 1332 1333 # {{{ ascii based translation 1334 s/\\/\x00/g; #mark backslashes 1335 s/ /\x01/g; #mark spaces 1336 for ($ascii=33;$ascii<=47;++$ascii) { 1337 $re="\\x".sprintf "%.2x",$ascii; 1338 s/$re/\\char$ascii /g; } 1339 for ($ascii=93;$ascii<=96;++$ascii) { 1340 $re="\\x".sprintf "%.2x",$ascii; 1341 s/$re/\\char$ascii /g; } 1342 for ($ascii=123;$ascii<=126;++$ascii) { 1343 $re="\\x".sprintf "%.2x",$ascii; 1344 s/$re/\\char$ascii /g; } 1345 # backslashes and spaces must be done on their own 1346 s/\x00/\\char92 /g; 1347 s/\x01/\\hskip0.602em /g; 1348 # }}} 1349 1350 print "\\tabuline{$_}\n";} 1351 next} 1352 # }}} 1353 1354 # Line contains 1355 1356 # {{{ Comment (programmer's kind of) 1357 if (/^\043/) { # 043 is octal of hash 1358 next} 1359 # }}} 1360 1361 # {{{ Subtitles_on command 1362 if (/{subtitles_on.*}/) { 1363 $subtitles_enabled=1; 1364 next; } 1365 # }}} 1366 # {{{ Subtitles_off command 1367 if (/{subtitles_off.*}/) { 1368 $subtitles_enabled=0; 1369 next; } 1370 # }}} 1371 1372 # {{{ Start of verbatim TeX 1373 if (/{vtexs.*}/ or /{verbatim_tex_start.*}/) { 1374 $verbatim_tex=1; next } 1375 # }}} 1376 # {{{ Start of Tablature 1377 if (/{sot.*}/ or /{start_of_tab.*}/) { 1378 previous_block_care("\\spar\n","\\spar\\largeskip\n"); 1379 $in_tablature=1; 1380 if (not $ignore_tablature) { 1381 print "\n\\begin{minipage}{\\columnwidth}\\tt\n"; 1382 $previous_line=1; } 1383 next; } 1384 # }}} 1385 1386 # {{{ Table of contents 1387 if (/{toc.*}/ or /{table_of_contents.*}/) { 1388 if ($table_of_contents_printed) { 1389 warning("You ask me to print table of contents though it\n". 1390 "has already been printed with songbook's titlepage.\n"); } 1391 else { 1392 print "$table_of_contents"; } 1393 next; } 1394 # }}} 1395 1396 # {{{ Title command 1397 if (/{t:.*}/ or /{title:.*}/) { 1398 s/{[^:]*: *//; s/}//; 1399 1400 if ($previous_line!=0) { 1401 $previous_block=$previous_line } 1402 #$previous_line=0; 1403 1404 # print "\\bigskip" if ($previous_line==0); 1405 previous_block_care("\\bigskip","\\bigskip\\bigskip"); 1406 1407 #s/&/\\&/g; # hack, I don't like this 1408 #print "%\n%\n%\n%\n\\songtitle{$_}{}%\n"; 1409 $previous_line=3; 1410 $previous_block=3; # explicit previousblock 1411 1412 $songtitle=fix_odd_characters($_); 1413 #$songtitle=$_; 1414 @subtitles=(); 1415 next; } 1416 # }}} 1417 # {{{ Subtitle command 1418 if (/{st:.*}/ or /{subtitle:.*}/) { 1419 s/{[^:]*: *//; s/}//; 1420 1421 if ($subtitles_enabled) { 1422 push @subtitles,fix_odd_characters($_); } 1423 $previous_block=3; # explicit previous_block 1424 1425 # ignored, so far 1426 #print "\n\\bigskip" if ($previous_line==1); 1427 #print "\\bigskip\\bigskip" if ($previous_line==2); 1428 #print "\\bigskip" if ($previous_line==0); 1429 1430 #s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 1431 #s/&/\\&/g; 1432 #print "%\n%\n%\n%\n\\songtitle{$_}%\n"; 1433 #$previous_line=3; 1434 next} 1435 # }}} 1436 # {{{ Album command 1437 if (/{album:.*}/) { 1438 1439 print "\n\\bigskip" if ($previous_line==1); 1440 print "\\bigskip\\bigskip" if ($previous_line==2); 1441 print "\\bigskip" if ($previous_line==0); 1442 1443 s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 1444 s/&/\\&/g; 1445 print "%\n" . 1446 "%\n" . 1447 "% ======================\n" . 1448 "% $_\n". 1449 "% ======================\n" . 1450 "%\n" . 1451 "%\n\\albumtitle{$_}%\n"; 1452 $previous_line=4; 1453 next} 1454 # }}} 1455 # {{{ Start of choir 1456 if (/{soc.*}/ or /{start_of_chorus.*}/) { 1457 print "\\it\n"; 1458 next} 1459 # }}} 1460 # {{{ End of choir 1461 if (/{eoc.*}/ or /{end_of_chorus.*}/) { 1462 print "\\rm\n"; 1463 next} 1464 # }}} 1465 # {{{ Comment 1466 if (/{c:.*}/ or /{comment:.*}/ or /{comment_italic:.*}/ or /{comment_box:.*}/) { 1467 s/{[^:]*: *//; s/}//; 1468 s/&/\\&/g; 1469 1470 previous_block_care("\\spar\n","\\spar\\largeskip\n"); 1471 1472 print "{\\it $_\\rm}\\\\\n"; 1473 $previous_line=1; #Comment is close to ordinary text 1474 next} 1475 # }}} 1476 # {{{ Chord command (not chordpack) 1477 if (/{ns.*}/ or /{new_song.*}/ or /{define.*}/ or /{textfont.*}/ or /{textsize.*}/ 1478 or /{chordfont.*}/ or /{chordsize.*}/ or /{no_grids.*}/ or /{ng.*}/ or 1479 /{grid.*}/ or /{g.*}/ or /{new_page.*}/ or /{np.*}/ or /{new_physical_pages.*}/ or 1480 /{npp.*}/ or /{columns_break.*}/ or /{colb.*}/) { 1481 warning($_.": Here is a command of chord but not of chordpack\n"); 1482 next} 1483 # }}} 1484 1485 # {{{ Other command 1486 if (/{.+}/) { 1487 warning($_.": unrecognized command\n"); 1488 next} 1489 # }}} 1490 1491 # {{{ Repeat marks [: :] 1492 # Final backslashes are represented by character with code 0 1493 # This DEPENDS on behaviour of fix_odd_characters function 1494 1495 s/\[:/\x01leftrepeat/g; s/:\]/\x01rightrepeat/g; 1496 # }}} 1497 1498 # {{{ Chord instructions 1499 if (/\[[^ ].*\]/) { 1500 $_.=" "; 1501 1502 previous_block_care("\\spar\\bigskip\n","\\spar\\largeskip\n"); 1503 # { Ensure chords contain no spaces 1504 if (/\[[^\]]* [^\]]*\]/) { 1505 warning "\nSetchord: Chords cannot contain spaces.\n"; 1506 warning "This was broken at file $ARGV:\n"; 1507 warning $_; 1508 exit;} 1509 # } 1510 1511 s/\]\[/\] \[/g; #no chords tightly follow 1512 1513 # { Determine chord and text arrays 1514 my @text = find_text($_,1); 1515 my @chords = find_chords($_); 1516 # } 1517 # {{{ Print tab stops for chords, chords and text 1518 1519 my $tabstops=$text[0]; 1520 my $text_line=$text[0]; 1521 my $chord_line=""; 1522 my $i=1; 1523 for (@chords) { 1524 $crd = set_one_chord("$_"); 1525 1526 $text[$i] =~ s/^ /\\hskip.7em /; #chord is preshifted to the left of the text 1527 #$tabstops.="\\=\\maxskip{$crd}{$text[$i]}"; 1528 $chord_line.="\\>$crd"; 1529 #$text_line.="\\>$text[$i]"; 1530 # Join two broken parts of word, if needed 1531 $text=$text[$i]; 1532 if ($i<$#text) { 1533 $last_char=substr($text[$i],length($text[$i])-1,1); 1534 $first_char=substr($text[$i+1],0,1); 1535 if (($last_char =~ /^[^ .,]$/) and ($first_char =~ /^[^ .,]$/)) { 1536 for ($text) { 1537 if (s/ ([^ ])/ \\skipdif{$crd}{$text}$1/) {last;} 1538 if (s/ / \\skipdif{$crd}{$text}/) {last;} 1539 1540 $present_dash=""; 1541 if(s/-+$//) {$present_dash="-"} # Remove dashes already present in adjacent 1542 if($text[$i+1] =~ s/^-+([a-zA-Z])/$1/) {$present_dash="-"} # texts 1543 s/$/\\filldifrule{$crd}{$text}{$present_dash}/;}}} 1544 1545 $text_line.="\\>$text"; 1546 $tabstops.="\\=\\maxskip{$crd}{$text}"; 1547 1548 $text[$i] =~ s/^ /\\hskip.7em /g; #chord is preshifted to the left of the text 1549 ++$i;} 1550 1551 print "\\begin{tabbingnb}\n"; 1552 print "$tabstops\\kill\n"; 1553 print "$chord_line\\\\\n"; 1554 print "$text_line\\\\\n"; 1555 print "\\end{tabbingnb}\n"; 1556 1557 # }}} 1558 1559 $previous_line=2; 1560 next} 1561 # }}} 1562 # {{{ Spaces only 1563 if (/^ *$/) { 1564 $previous_block=$previous_line if ($previous_line!=0); 1565 $previous_line=0; 1566 next} 1567 # }}} 1568 # {{{ Text without chords 1569 previous_block_care("\\spar\n","\\spar\\largeskip\n"); 1570 1571 print fix_odd_characters($_)."\\N\n"; 1572 $previous_line=1; 1573 # }}} 1574 } 1575 1576 print "\\spar\\end{document}\n"; 1577 exit; } 1578 1579# }}} 1580# {{{ ascii 1581if ($task eq "ascii") { 1582 while (<>) { 1583 chomp; 1584 1585 # Process line 1586 1587 # Line contains 1588 # {{{ Title command 1589 if (/{t:.*}/ or /{title:.*}/) { 1590 1591 s/{[^:]*: *//; s/}//; 1592 printf "$_\n"; 1593 next; } 1594 # }}} 1595 # {{{ Other command 1596 if (/{.*}/) {next;} 1597 # }}} 1598 1599 # {{{ Comment (programmer's kind of) 1600 if (/^\x23/) { # \x23 is hash 1601 next; } 1602 # }}} 1603 # {{{ Chord instructions 1604 if (/\[[^:]/) { 1605 $_.=" "; 1606 1607 # {{{ Ensure chords contain no spaces 1608 if (/\[[^\]]* [^\]]*\]/) { 1609 warning "\nSetchord: Chords cannot contain spaces.\n"; 1610 warning "This was broken at file $ARGV:\n"; 1611 warning $_; 1612 exit; } 1613 # }}} 1614 1615 1616 s/\]\[/\] \[/g; #no chords tightly follow 1617 1618 # {{{ Determine chord and text arrays 1619 my @text = find_text($_); 1620 my @chords = find_chords($_); 1621 # }}} 1622 # {{{ Print chords and text 1623 1624 my $chord_line=$text[0]; $chord_line =~ s/./ /g; 1625 my $textpos=1; 1626 my $text_line=$text[0]; 1627 for (@chords) { 1628 $crd=$_; 1629 $chord_line.=$_ . (' ' x (length($text[$textpos])-length($crd))); 1630 $text_line.=$text[$textpos] . ' ' x (length($crd)-length($text[$textpos])); 1631 $textpos++; } 1632 1633 print "$chord_line\n$text_line\n"; 1634 1635 # }}} 1636 1637 next; } 1638 # }}} 1639 # {{{ Spaces only 1640 if (/^ *$/) { 1641 print "\n"; 1642 next;} 1643 # }}} 1644 # {{{ Text without chords 1645 print "$_\n"; 1646 # }}} 1647 } 1648exit; 1649} 1650# }}} 1651# {{{ nochord 1652if ($task eq "nochord") { 1653 $in_tablature=0; 1654while (<>) { 1655 chomp; 1656 1657 # Process line 1658 1659 # {{{ In tablature 1660 if ($in_tablature) { 1661 if (/\x7beot/ or /\x7bend_of_tab/) { 1662 $in_tablature=0; 1663 next} 1664 next} 1665 # }}} 1666 1667 # Line contains 1668 1669 # {{{ Title command 1670 if (/{t:.*}/ or /{title:.*}/) { 1671 1672 s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 1673 printf "$_\n"; 1674 next; } 1675 # }}} 1676 # {{{ Start of Tablature 1677 if (/\x7bsot/ or /\x7bstart_of_tab/) { 1678 $in_tablature=1; 1679 next; } 1680 # }}} 1681 # {{{ Other command 1682 if (/{.*}/) {next;} 1683 # }}} 1684 1685 # {{{ Comment (programmer's kind of) 1686 if (/^\043/) { # 043 is octal of hash 1687 next; } 1688 # }}} 1689 # {{{ Chord instructions 1690 1691 if (/\[/) { 1692 $_.="\n"; 1693 1694 my @text = find_text($_); 1695 1696 for (@text) { 1697 print; } 1698 1699 next; } 1700 1701 # }}} 1702 # {{{ Spaces only 1703 if (/^ *$/) { 1704 print "\n"; 1705 next;} 1706 # }}} 1707 # {{{ Text without chords 1708 print "$_\n"; 1709 # }}} 1710} 1711exit; 1712} 1713# }}} 1714# {{{ pro 1715 1716# Assumption: chord lines do not contain any tabulator characters. 1717 1718$in_tabulature=0; 1719 1720if ($task eq "pro") { 1721 $previous_was_chord_line=0; 1722while (<>) { 1723 chomp; $_.="\n"; 1724 if ($previous_was_chord_line) { 1725 $previous_was_chord_line=0; 1726 1727 chomp; 1728 $chord_line =~ s/\s+$//; 1729 $_.=" " x (length($chord_line)-length($_)); 1730 1731 $chord_end=length($chord_line)-1; 1732 $chord_curr=$chord_end; 1733 $looking_for_chord_end=1; 1734 while (1) { 1735 if ($looking_for_chord_end) { 1736 last if $chord_curr==-1; 1737 if (not substr($chord_line,$chord_curr,1) eq " ") { 1738 $chord_end=$chord_curr; 1739 $looking_for_chord_end=0; }} 1740 else { 1741 if ((substr($chord_line,$chord_curr,1) eq " ") or $chord_curr==-1) { 1742 $looking_for_chord_end=1; 1743 $chord=substr($chord_line,$chord_curr+1,$chord_end-$chord_curr); 1744 $_=insertstring("[$chord]",$_,$chord_curr+1); } 1745 last if $chord_curr==-1; } 1746 --$chord_curr; } 1747 1748 s/\+*$//; 1749 print "$_\n"; } 1750 else { 1751 if ($in_tabulature) { # In tabulature 1752 if (/{eot.*}/ or /{end_of_tab.*}/) { 1753 $in_tabulature=0; } 1754 print "$_"; } 1755 else { # Not in tabulature 1756 if (/{sot.*}/ or /{start_of_tab.*}/) { 1757 $in_tabulature=1; } 1758 1759 if (/^[ \/\+\x23()12345679A-Hbmajindsu]+$/ and not /^\s*$/) { 1760 # ^ Is this a chord line? 1761 $previous_was_chord_line=1; 1762 $chord_line=$_; } 1763 else { 1764 print "$_"; }}}} 1765exit; } 1766# }}} 1767# {{{ html 1768 1769$chord_color_command="<font color=\"#aa4422\">"; 1770# chord_color_command must be <font> tag. Atributes are optional 1771 1772 # {{{ set_one_chord_html 1773sub set_one_chord_html { 1774 $tdxs="<td><small>$chord_color_command"; 1775 $tdxe="</font></small></td>"; 1776 1777 my $table_s="<table border=0 cellpadding=0 cellspacing=0>"; 1778 1779 my $set=""; 1780 $_=$_[0]; 1781 1782 # {{{ Switch B <-> H notation (B is common) 1783 if ($H_chord) { 1784 s/B([^b])/H$1/g; 1785 s/B$/H/g; } 1786 else { 1787 s/H/B/g; } 1788 # }}} 1789 1790 #$set.="\\sf "; 1791 # It is nice to represent special sequences with nonprintable characters. 1792 s/maj/\001/;s/mi/m/;s/min/m/;s/dim/\002/;s/m75-/z/; 1793 s/\0017/\001/;s/7\001/\001/; 1794 1795 # {{{ brackets 1796 my $brackets=0; 1797 if (/^\(.*\)$/) { 1798 s/\(//;s/\)//; 1799 $brackets=1; 1800 $set.="("; 1801 } 1802 # }}} 1803 # {{{ basses 1804 my $bass=""; 1805 if (/\//) { 1806 @basssplit = split(/\//,"$_"); 1807 $bass = $basssplit[1]; 1808 $_ = $basssplit[0]; 1809 } 1810 # }}} 1811 1812 my $majset;my $dimset;my $minorset;my $minorshiftedbase; 1813 1814 # {{{ Chord style dependencies 1815# if ($chord_style==0) { 1816# $majset="\$\\triangle\$"; 1817# $dimset="o"; 1818# $minorset="\\raisebox{0.26ex}{--}"; 1819# $minorshiftedbase="F"; } 1820# else { 1821 $majset="7maj"; 1822 $dimset="dim"; 1823 $minorset="m"; 1824 $minorshiftedbase="?"; 1825# } 1826 # }}} 1827 1828 my $bot=""; my $top=""; 1829 my $bot0=""; my $top0=""; 1830 my $puttobot=0; 1831 my $numfound=0; 1832 my @CHORD = split (//, $_); 1833 $basenote=uc(shift @CHORD); 1834 for (@CHORD) { 1835 if ($puttobot) { $bot.="$_"; next; } 1836 if ($numfound and /[2-9]/) { $bot.="$_"; $puttobot=1; next; } 1837 if ($numfound and /\001/) { $bot.=$majset; $puttobot=1; next; } 1838 1839 if (/[2-9]/) { $top.="$_"; $numfound=1; next; } 1840 1841 if (/\001/) { $top.=$majset; $numfound=1; next; } # maj 1842 if (/\002/) { $top.=$dimset; next; } # dim 1843 if (/z/) { $top.="\$\\varnothing\$"; next; } 1844 if (/b/) { $top0.="b"; next; } 1845 if (/\043/) { $top0.="#"; next; } 1846 # \043 is octal hash 1847 1848 if (/m/) { 1849 #if (not $basenote eq $minorshiftedbase) {$bot0.="\hskip0.1em"} 1850 $bot0.=$minorset; next; 1851 } # minor 1852 if (/\+/) { $bot.="+"; next; } # + 1853 $top.="$_"; 1854 } 1855 1856 1857 $start_with_basenote="$table_s <tr><td>$chord_color_command$basenote</font></td>"; 1858 1859 # Now this really is nasty 1860 PRINT: { 1861 if (not ($top0 or $bot0 or $top or $bot)) { # No indices at all 1862 $set.="$start_with_basenote"; 1863 $set.="$tdxs <br> $tdxe"; 1864 last PRINT; } 1865 1866 if ($top =~ /dim/) { 1867 $bot0=" " if not $bot0; 1868 $set.="$start_with_basenote"; 1869 $set.="$tdxs$top0<br>$bot0$tdxe" 1870 if ($top0 or not $bot0 eq " "); 1871 $set.="<td>${chord_color_command}dim</font></td>"; 1872 last PRINT } 1873 1874# if (not $bot0 and not $bot) { # No bottom indices 1875# $set.="$table_s<tr><td>$chord_color_command$basenote<td>"; 1876# $set.="<td>$table_s $idxs$top0$top$idxe$idxs $idxe</table></td>" if ($top0 or $top); 1877# last PRINT; } 1878 1879 if ($bot0) { 1880 $bot=" " if not $bot; 1881 $set.="$start_with_basenote"; 1882 $set.="$tdxs$top0<br> $tdxe" if ($top0); 1883 $set.="$tdxs$bot0$tdxe"; 1884 $set.="$tdxs$top<br>$bot$tdxe"; 1885 last PRINT } 1886 1887 1888 $bot0=" "; 1889 $bot=" " unless ($bot); 1890 1891 $set.="$start_with_basenote"; 1892 $set.="$tdxs$top0<br>$bot0$tdxe" if ($top0 or $bot0); 1893 $set.="$tdxs$top<br>$bot$tdxe" if ($top or not $bot eq " "); 1894 1895 } 1896 # 1897 1898 $set.="<td>$chord_color_command"; 1899 @basses = split(//,$bass); 1900 $set.="/$bass" if ($#basses==(1-1)); 1901 if ($#basses==(2-1)) { 1902 $set.="/$basses[0]</font></td>"; 1903 $set.="<td>$chord_color_command$basses[1]<br> </font></td>"; 1904 $set.="<td>$chord_color_command"; 1905 } 1906 1907 $set.=")" if ($brackets); 1908 $set.=" </font></td></tr></table>"; 1909 1910 return $set; 1911} 1912 1913# }}} 1914 1915if ($task eq "html") { 1916 # {{{ head 1917 1918 $head="<!doctype html public \"-//W3C//DTD HTML 4.0 Transitional//EN\"> 1919<html> 1920<head> 1921<title>Songbook</title> 1922</head> 1923<body bgcolor=\"#eeeeee\">"; 1924 1925 print $head; 1926 1927# }}} 1928 1929 # Process input files 1930 1931 my $previous_line=0; my $previous_block=0; 1932 # previous_line: 0=emptyline, 1=text_line, 2=chord, 3=title 1933 # previousblock: 0=we're in block, 1=text_line, 2=chord, 3=title 1934 1935 $bearable_length=50; 1936 %files_warned=(); 1937 $head_printed=0; 1938 $verbatim_tex=0; 1939 $table_of_contents_printed=0; 1940 $tex_prebegin_part=0; 1941 $it=""; 1942 1943 # {{{ Read input into @input variable 1944 1945 @input=(); 1946 if (defined($opt_f)) { 1947 1948 open(FILE,"$opt_f") or warning("File \"$opt_f\" does not exist."),exit; 1949 $mainpath=$opt_f;$mainpath =~ s|/[^/]*$|/|; chdir "$mainpath"; 1950 1951 $verbatim_lines=0; 1952 while(<FILE>) { 1953 if ($verbatim_lines) { 1954 if (/^\^e/) {$verbatim_lines=0} # end verbatimline mode 1955 else {push @input,("$_")} 1956 next; } 1957 if (/^\x23/) {next} # comment 1958 if (/^\^s/) {$verbatim_lines=1;next} # start verbatimline mode 1959 if (s/^\^\^//) {push @input,("$_");next} # just one line is verbatim 1960 if (/^\s*$/) {next} 1961 1962 chomp; 1963 open(FILE2,"$_") or warning("File \"$_\" does not exist."),exit; 1964 my $filename="$_"; 1965 while(<FILE2>) { 1966 check_for_the_length("$_",$filename,$bearable_length); 1967 push @input,("$_"); } 1968 close(FILE2);} 1969 close(FILE); 1970 } 1971 else { 1972 while (<>) { 1973 check_for_the_length("$_",$ARGV,$bearable_length); 1974 push @input,("$_"); } 1975 } 1976 1977 # }}} 1978 1979 1980 for (@input) { 1981 chomp; 1982 # {{{ Parenthesis 1983 s/\" /\'\' /g; 1984 s/\"$/\'\'/g; 1985 s/ \"/ \`\`/g; 1986 s/^\"/\`\`/g; 1987 # }}} 1988 1989 # Process line 1990 # {{{ In Verbatim TeX 1991 if ($verbatim_tex) { 1992 if (/{texe.*}/ or /{verbatim_tex_end.*}/) { 1993 $verbatim_tex=0; next; } 1994 print "$_\n"; next; } 1995 # }}} 1996 # {{{ In tablature 1997 if ($in_tablature) { 1998 if (/{eot.*}/ or /{end_of_tab.*}/) { 1999 $in_tablature=0; 2000 if (not $ignore_tablature) { 2001 print "</pre></font></td></tr></table>\n"}; 2002 next;} 2003 2004 if (not $ignore_tablature) { 2005 print "$_\n";} 2006 next;} 2007 # }}} 2008 2009 # Line contains: 2010 # {{{ Start of verbatim TeX 2011 if (/{texs.*}/ or /{verbatim_tex_start.*}/) { 2012 $verbatim_tex=1; next; } 2013 # }}} 2014 # {{{ Start of Tablature 2015 if (/{sot.*}/ or /{start_of_tab.*}/) { 2016 # {{{ Care about previous block 2017 if ($previous_block!=0) { 2018 print "<br>\n" if ($previous_block==1); 2019 print "<br><br>\n" if ($previous_block==2); 2020 $previous_block=0; 2021 } 2022 # }}} 2023 $in_tablature=1; 2024 if (not $ignore_tablature) { 2025 print "<table><tr><td bgcolor=\"#dddddd\"><font size=\"-1\"><pre>\n"; 2026 $previous_line=1; 2027 } 2028 next} 2029 # }}} 2030 # {{{ Table of contents 2031 if (/{toc.*}/ or /{table_of_contents.*}/) { 2032 if ($table_of_contents_printed) { 2033 warning("You ask me to print table of contents though it\n". 2034 "has already been printed with songbook's titlepage.\n"); } 2035 else { 2036 print "$table_of_contents"; }} 2037 # }}} 2038 2039 # {{{ Title command 2040 if (/{t:.*}/ or /{title:.*}/) { 2041 2042 print "\n<br>" if ($previous_line==1); 2043 print "<br><br>" if ($previous_line==2); 2044 print "<br>" if ($previous_line==0); 2045 2046 s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 2047 s/&/&/g; 2048 print "<br><br><br><br>\n<H3>$_</H3>\n"; 2049 $previous_line=3; 2050 next; 2051 } 2052 # }}} 2053 # {{{ Album command 2054 if (/{album:.*}/) { 2055 2056 print "\n<br>" if ($previous_line==1); 2057 print "<br><br>\n" if ($previous_line==2); 2058 print "<br>\n" if ($previous_line==0); 2059 2060 s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 2061 s/&/\\&/g; 2062 print "<H2> $_</H2>\n"; 2063 $previous_line=3; 2064 next; 2065 } 2066 # }}} 2067 # {{{ Start of choir 2068 if (/{soc.*}/ or /{start_of_chorus.*}/) { 2069 $it="<i>"; 2070 #print "<it>\n"; 2071 next; 2072 } 2073 # }}} 2074 # {{{ End of choir 2075 if (/{eoc.*}/ or /{end_of_chorus.*}/) { 2076 $it=""; 2077 #print "\\rm\n"; 2078 next; 2079 } 2080 2081 # }}} 2082 # {{{ Comment 2083 if (/{c:.*}/ or /{comment:.*}/) { 2084 s/\173[^:]*: *//; s/\175//; # 173 is octal left curly brace 175 is right 2085 s/&/\\&/g; 2086 2087 # {{{ Care about previous block 2088 if ($previous_block!=0) { 2089 print "<br>\n" if ($previous_block==1); 2090 print "<br><br>\n" if ($previous_block==2); 2091 $previous_block=0; 2092 } 2093 # }}} 2094 2095 print "<i>$_</i><br>\n"; 2096 $previous_line=1; #Comment is close to ordinary text 2097 next; 2098 } 2099 2100 # }}} 2101 # {{{ Other command 2102 if (/{.*}/) {next;} 2103 # }}} 2104 2105 # {{{ Comment (programmer's kind of) 2106 if (/^\043/) { # 043 is octal of hash 2107 next; } 2108 # }}} 2109 # {{{ Chord instructions 2110 2111 if (/\[[^:]/) { 2112 $_.=" "; 2113 2114 # {{{ Care about previous block 2115 if ($previous_block!=0) { 2116 print "<br><br>\n" if ($previous_block==1); 2117 print "<br><br><br>\n" if ($previous_block==2); 2118 $previous_block=0; 2119 } 2120 # }}} 2121 # {{{ Ensure chords contain no spaces 2122 if (/\[[^\x5d]* [^\x5d]*\]/) { 2123 warning "\nSetchord: Chords cannot contain spaces.\n"; 2124 warning "This was broken at file $ARGV:\n"; 2125 warning $_; 2126 exit; } 2127 # }}} 2128 2129 s/&/&/g; #care about html-dangerous characters 2130 2131 s/\]\[/\] \[/g; #no chords tightly follow 2132 2133 s/\] /\] /g; #chord is preshifted to the left of the text 2134 2135 my @text = find_text($_); 2136 my @chords = find_chords($_); 2137 2138 # {{{ Print tab stops for chords and chords 2139 2140 my $chord_line="<tr><td>"; 2141 my $text_line="<tr><td>$it$text[0]"; 2142 my $textpos=1; 2143 for (@chords) { 2144 $crd = set_one_chord_html("$_"); 2145 $chord_line.="</td><td>$crd"; 2146 $text_line.="</td><td>$it$text[$textpos]"; 2147 2148 $textpos++; 2149 } 2150 $chord_line.="</td></tr>\n"; 2151 $text_line.="</td></tr>\n"; 2152 2153 2154 print "<table border=0 cellpadding=0 cellspacing=0>\n"; 2155 print "$chord_line"; 2156 print "$text_line"; 2157 # }}} 2158 2159 print "</table>\n"; 2160 $previous_line=2; 2161 next; } 2162 # }}} 2163 2164 # {{{ Spaces only 2165 if (/^ *$/) { 2166 $previous_block=$previous_line if ($previous_line!=0); 2167 $previous_line=0; 2168 next; } 2169 # }}} 2170 # {{{ Text without chords 2171 do { 2172 # {{{ Care about previous block 2173 if ($previous_block!=0) { 2174 print "<br>\n" if ($previous_block==1); 2175 print "<br><br>\n" if ($previous_block==2); 2176 $previous_block=0; } 2177 # }}} 2178 2179 print "$_<br>\n"; 2180 $previous_line=1; } 2181 # }}} 2182 } 2183 2184 print "</html>\n"; 2185 exit; } 2186# }}} 2187# {{{ transpose 2188 2189if ($task eq "transpose") { 2190 $transposition=shift @ARGV; 2191 @tpose=<>; 2192 2193 transpose($transposition); 2194 2195 for (@tpose) { 2196 print; } 2197 exit; } 2198 2199# }}} 2200# {{{ unknown 2201print STDERR "Task \"$task\" is unknown.\n".$help_message; 2202exit; 2203# }}} 2204 2205if ($stdout_opened) { 2206 close (STDOUT); } 2207 2208# {{{ emacs 2209# 2210# Local Variables: 2211# compile-command:"chordpack tex chordpack-testing-song.pro >testing.tex" 2212# compile-function:(save-excursion (compile compile-command)(sleep-for 2)(to-buffer "testing.tex")(TeX-compile-to-ps)) 2213# end: 2214# 2215# }}} 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230