App-Music-ChordPro
view release on metacpan or search on metacpan
- Add (experimental) provisions for new HTML backend.
- Improve the macOS GitHub action. The installer kits for both
Intel and ARM can now be built using a GitHub runner.
!Bug Fixes
- Fixed issue #315, #357, #512, #526 (thanks Merijn) #541, #580 and more.
- Fixed issue #630.1.
- Fixed issue #636.
- Fixed issue #640 (col expands to colums instead of columns).
- Fixed issue #647 (image scaling goes wrong with columns).
- Fixed issue #658.
- Several others.
6.090.1 2026-01-03
- Emergency fix for illegal date in PDF.
6.090.0 2025-10-31
lib/ChordPro.pm view on Meta::CPAN
&& ( ( @w == 1 && ! keys(%opts) ) # filename
|| ( @w == 0 && keys(%opts) ) # options
);
for ( qw( title subtitle ) ) {
next unless defined $opts{$_};
$options->{$_} = $opts{$_};
}
for ( qw( filelist dir ) ) {
next unless defined $opts{$_};
$gopts{$_} = $opts{$_} eq "" ? undef : expand_tilde($opts{$_});
}
unless ( @w ) {
progress( msg => $file ) if @ARGV > 1 && $file !~ /^--/;
next;
}
$file = $w[0];
if ( defined($gopts{dir})
&& !fn_is_absolute($file) ) {
$file = fn_catfile( $gopts{dir}, $file );
lib/ChordPro/A2Crd.pm view on Meta::CPAN
? delete($opts->{lines})
: fs_load( @ARGV ? $ARGV[0] : \*STDIN);
return [ a2cho($lines) ];
}
################ Subroutines ################
# Replace tabs with blanks, retaining layout.
my $tabstop;
sub expand {
my ( $line ) = @_;
return $line unless $line;
$tabstop //= $::config->{a2crd}->{tabstop};
return $line unless $tabstop > 0;
my ( @l ) = split( /\t/, $line, -1 );
return $l[0] if @l == 1;
$line = shift(@l);
$line .= " " x ($tabstop-length($line)%$tabstop) . shift(@l) while @l;
lib/ChordPro/A2Crd.pm view on Meta::CPAN
return $line;
}
# API: Produce ChordPro data from AsciiCRD lines.
sub a2cho {
my ( $lines ) = @_;
my $map = "";
my @lines_with_tabs_replaced ;
foreach ( @$lines ) {
if(/\t/) {
$_ = expand($_) ;
}
#s/=20/ /g ; # replace HTML coded space with ascii space, no, MUST LEAVE IN because it can mess up fingering diagrams like A/F#=202220
s/=3D/=/g ; # replace HTML coded equal with ascii =
# s/\s*$// ; # remove all trailing whitespace -- no, MUST LEAVE IN so chords indicated above trailing whitespace will be properly formatted
my $n_ch_chords=0 ;
#An odd format for chords, [ch]Chordname[\ch], possibly from reformated webpage
# need to strip out and consider it to be a chord line
lib/ChordPro/Config.pm view on Meta::CPAN
if ( ref($cfg->{pdf}->{fontdir}) eq 'ARRAY' ) {
@a = @{ $cfg->{pdf}->{fontdir} };
}
else {
@a = ( $cfg->{pdf}->{fontdir} );
}
$cfg->{pdf}->{fontdir} = [];
my $split = $^O =~ /^MS*/ ? qr(;) : qr(:);
foreach ( @a ) {
push( @{ $cfg->{pdf}->{fontdir} },
map { expand_tilde($_) } split( $split, $_ ) );
}
}
else {
$cfg->{pdf}->{fontdir} = [];
}
my @allfonts = keys(%{$cfg->{pdf}->{fonts}});
for my $ff ( @allfonts ) {
# Derived chords can have size or color only. Disable
# this test for now.
lib/ChordPro/Config.pm view on Meta::CPAN
}
return $cfg;
}
# Get the decoded contents of a single config file.
sub get_config ( $file ) {
Carp::confess("FATAL: Undefined config") unless defined $file;
my $verbose = $options->{verbose};
warn("Reading: $file\n") if $verbose > 1;
$file = expand_tilde($file);
if ( $file =~ /\.json$/i ) {
if ( my $lines = fs_load( $file, { split => 1, fail => "soft" } ) ) {
my $new = json_load( join( "\n", @$lines, '' ), $file );
warn("JSON: $file ($ChordPro::Utils::json_last)\n") if $verbose > 1;
precheck( $new, $file );
return __PACKAGE__->new($new);
}
else {
die("Cannot open config $file [$!]\n");
lib/ChordPro/Config.pm view on Meta::CPAN
# Prepend dir of the caller, if needed.
$c = fn_catpath( $vol, $dir, $c );
}
my $cfg = get_config($c);
# Recurse.
push( @res, $cfg->prep_configs($c) );
}
# Push this and return.
$cfg->split_fc_aliases;
$cfg->expand_font_shortcuts;
push( @res, $cfg );
return @res;
}
sub process_config ( $cfg, $file ) {
my $verbose = $options->{verbose};
warn("Process: $file\n") if $verbose > 1;
if ( $cfg->{tuning} ) {
lib/ChordPro/Config.pm view on Meta::CPAN
}
if ( $verbose > 1 ) {
warn( "Processed ", scalar(@$c), " chord entries\n");
warn( "Totals: ",
ChordPro::Chords::chord_stats(), "\n" );
}
$cfg->{_chords} = delete $cfg->{chords};
ChordPro::Chords::pop_parser();
}
$cfg->split_fc_aliases;
$cfg->expand_font_shortcuts;
}
# Expand pdf.fonts.foo: bar to pdf.fonts.foo { description: bar }.
sub expand_font_shortcuts ( $cfg ) {
return unless exists $cfg->{pdf}->{fonts};
for my $f ( keys %{$cfg->{pdf}->{fonts}} ) {
next if ref($cfg->{pdf}->{fonts}->{$f}) eq 'HASH';
for ( $cfg->{pdf}->{fonts}->{$f} ) {
my $v = $_;
$v =~ s/\s*;\s*$//;
my $i = {};
# Break out ;xx=yy properties.
while ( $v =~ s/\s*;\s*(\w+)\s*=\s*(.*?)\s*(;|$)/$3/ ) {
lib/ChordPro/Config.pm view on Meta::CPAN
if ( @k > 1 ) {
# We have aliases. Delete the original.
delete( $fc->{$k} );
# And insert individual entries.
$fc->{$_} = dclone($v) for @k;
}
}
}
}
# Reverse of config_expand_font_shortcuts.
sub simplify_fonts( $cfg ) {
return $cfg unless $cfg->{pdf}->{fonts};
foreach my $font ( keys %{$cfg->{pdf}->{fonts}} ) {
for ( $cfg->{pdf}->{fonts}->{$font} ) {
next unless is_hashref($_);
delete $_->{color}
lib/ChordPro/Config.pm view on Meta::CPAN
$options->{'cfg-print'} = 1;
my $defcfg; # pristine config
my $cfg; # actual config
if ( $default || $delta ) {
local $options->{nosysconfig} = 1;
local $options->{nouserconfig} = 1;
local $options->{noconfig} = 1;
$defcfg = pristine_config();
split_fc_aliases($defcfg);
expand_font_shortcuts($defcfg);
if ( $delta ) {
delete $defcfg->{chords};
delete $defcfg->{include};
}
bless $defcfg => __PACKAGE__;
$cfg = $defcfg if $default;
}
$cfg //= configurator($options);
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
last;
}
# Sanity checks.
croak("No properties $file in " . join(":", @$searchpath)) unless $did;
}
# internal
sub _value {
my ( $self, $value, $ctx, $noexpand ) = @_;
# Single-quoted string.
if ( $value =~ /^'(.*)'\s*$/ ) {
$value = $1;
$value =~ s/\\\\/\x{fdd0}/g;
$value =~ s/\\'/'/g;
$value =~ s/\x{fdd0}/\\/g;
return $value;
}
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
if ( $value =~ /^"(.*)"\s*$/ ) {
$value = $1;
$value =~ s/\\\\/\x{fdd0}/g;
$value =~ s/\\"/"/g;
$value =~ s/\\n/\n/g;
$value =~ s/\\t/\t/g;
$value =~ s/\\([0-7]{1,3})/sprintf("%c",oct($1))/ge;
$value =~ s/\\x([0-9a-f][0-9a-f]?)/sprintf("%c",hex($1))/ge;
$value =~ s/\\x\{([0-9a-f]+)\}/sprintf("%c",hex($1))/ge;
$value =~ s/\x{fdd0}/\\/g;
return $value if $noexpand;
return $self->expand($value, $ctx);
}
return $value if $noexpand;
$self->expand($value, $ctx);
}
sub _parse_lines_internal {
my ( $self, $lines, $filename, $context ) = @_;
my @stack = $context ? ( [$context, undef] ) : ();
my $keypat = qr/[-\w.]+|"[^"]*"|'[^']*'/;
# Process its contents.
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
# key {
# key [
# value
# ]
# }
# foo.bar {
# foo.bar [
# Push a new context.
if ( /^($keypat)\s*([{])$/ ) {
my $c = $self->_value( $1, undef, "noexpand" );
my $i = $2 eq '[' ? 0 : undef;
@stack = ( [ $c, $i ] ), next unless @stack;
unshift( @stack, [ $stack[0]->[0] . "." . $c, $i ] );
next;
}
if ( /^($keypat)\s*[:=]\s*([[])$/ ) {
my $c = $self->_value( $1, undef, "noexpand" );
my $i = $2 eq '[' ? 0 : undef;
@stack = ( [ $c, $i ] ), next unless @stack;
unshift( @stack, [ $stack[0]->[0] . "." . $c, $i ] );
next;
}
# foo.bar = [ val val ]
# foo.bar = [ val
# val ]
# foo.bar = [ val val
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
# BUT NOT
# foo.bar = [
# val val ]
# Create an array
# Add lines, if necessary.
while ( /^($keypat)\s*[=:]\s*\[(.+)$/ && $2 !~ /\]\s*$/ && @$lines ) {
$_ .= " " . shift(@$lines);
$lineno++;
}
if ( /^($keypat)\s*[:=]\s*\[(.*)\]$/ ) {
my $prop = $self->_value( $1, undef, "noexpand" );
$prop = $stack[0]->[0] . "." . $prop if @stack;
my $v = $2;
$v =~ s/^\s+//;
$v =~ s/\s+$//;
my $ix = 0;
for my $value ( parse_line( '\s+', 1, $v ) ) {
$value = $self->_value( $value, $stack[0] );
$self->set_property( $prop . "." . $ix++, $value );
}
$self->set_property( $prop, undef ) unless $ix;
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
unless @stack
&& ( $1 eq defined($stack[0]->[1]) ? ']' : '}' );
shift(@stack);
next;
}
# foo.bar = blech
# foo.bar = "blech"
# foo.bar = 'blech'
# Simple assignment.
# The value is expanded unless single quotes are used.
if ( /^($keypat)\s*[=:]\s*(.*)/ ) {
die("Brace is illegal as a value (use quotes to bypass)\n")
if $2 eq '{';
my $prop = $self->_value( $1, undef, "noexpand" );
my $value = $self->_value( $2, $stack[0] );
# Make a full name.
$prop = $stack[0]->[0] . "." . $prop if @stack;
# Set the property.
$self->set_property($prop, $value);
next;
}
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
If no value can be found, I<default> is used.
In either case, the resultant value is examined for references to
other properties or environment variables. See L<PROPERTY FILES> below.
=cut
sub get_property {
my ($self) = shift;
$self->expand($self->get_property_noexpand(@_));
}
=item get_property_noexpand I<prop> [ , I<default> ]
This is like I<get_property>, but does not do any expansion.
=cut
sub get_property_noexpand {
my ($self, $prop, $default) = @_;
$prop = lc($prop);
my $ctx = $self->{_context};
my $context_only;
if ( ($context_only = $prop =~ s/^\.//) && !$ctx ) {
croak("get_property: no context for $prop");
}
if ( defined($ctx) ) {
$ctx .= "." if $ctx;
if ( exists($self->{_props}->{$ctx.$prop}) ) {
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
given property. The names are unqualified, e.g., when properties
C<foo.bar> and C<foo.blech> exist, C<get_property_keys('foo')> would
return C<['bar', 'blech']>.
=cut
sub get_property_keys {
my ($self, $prop) = @_;
$prop .= '.' if $prop;
$prop .= '@';
$self->get_property_noexpand($prop);
}
=item expand I<value> [ , I<context> ]
Perform the expansion as described with I<get_property>.
=cut
sub expand {
my ($self, $ret, $ctx) = (@_, "");
return $ret unless $ret;
warn("expand($ret,",$ctx//'<undef>',")\n") if $self->{_debug};
my $props = $self->{_props};
$ret =~ s:^~(/|$):$ENV{HOME}$1:g;
return $self->_interpolate( $ret, $ctx );
}
# internal
sub _interpolate {
my ( $self, $tpl, $ctx ) = @_;
( $ctx, my $ix ) = @$ctx if $ctx;
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
else {
my $ret = {};
foreach my $prop ( @$res ) {
$ret->{$prop} = $self->_data_internal($cur.$prop);
}
return $ret;
}
}
else {
my $val = $self->{_props}->{lc($orig)};
$val = $self->expand($val) if defined $val;
return $val;
}
}
sub _check_array {
my ( $i ) = @_;
my @i = @$i;
return unless "@i" =~ /^[\d ]+$/; # quick
my $ref = 0;
for ( @i) {
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
Produces a listing of all properties from a given point in the
hierarchy and write it to the I<stream>.
Without I<stream>, returns a string.
In general, I<stream> should be UTF-8 capable.
=item dumpx [ I<start> [ , I<stream> ] ]
Like dump, but dumps with all values expanded.
=cut
my $dump_expanded;
sub dump {
my ($self, $start, $fh) = ( @_, '' );
my $ret = $self->_dump_internal($start);
print $fh $ret if $fh;
$ret;
}
sub dumpx {
my ($self, $start, $fh) = ( @_, '' );
$dump_expanded = 1;
my $ret = $self->dump( $start, $fh );
$dump_expanded = 0;
$ret;
}
# internal
sub _dump_internal {
my ($self, $cur) = @_;
$cur .= "." if $cur;
my $all = $cur;
$all .= '@';
my $ret = "";
if ( my $res = $self->{_props}->{lc($all)} ) {
$ret .= "# $all = @$res\n" if @$res > 1;
foreach my $prop ( @$res ) {
my $t = $self->_dump_internal($cur.$prop);
$ret .= $t if defined($t) && $t ne '';
my $val = $self->{_props}->{lc($cur.$prop)};
$val = $self->expand($val) if $dump_expanded;
if ( !defined $val ) {
$ret .= "$cur$prop = null\n"
unless defined($t) && $t ne '';
}
elsif ( $val =~ /[\n\t]/ ) {
$val =~ s/(["\\])/\\$1/g;
$val =~ s/\n/\\n/g;
$val =~ s/\t/\\t/g;
$ret .= "$cur$prop = \"$val\"\n";
}
lib/ChordPro/Config/Properties.pm view on Meta::CPAN
foo {
include "myprops.prp"
}
will enter all the properties from the file with an additional C<foo.>
prefix.
=head2 Expansion
Property values can be anything. The value will be I<expanded> before
being assigned to the property unless it is placed between single
quotes C<''>.
Expansion means:
=over
=item *
A tilde C<~> in what looks like a file name will be replaced by the
lib/ChordPro/Output/ChordPro.pm view on Meta::CPAN
$lyrics_only = 2 * $::config->{settings}->{'lyrics-only'};
}
sub generate_song ( $s ) {
my $tidy = $options->{'backend-option'}->{tidy};
my $structured = ( $options->{'backend-option'}->{structure} // '' ) eq 'structured';
# $s->structurize if ++$structured;
$variant = $options->{'backend-option'}->{variant} || 'cho';
my $seq = $options->{'backend-option'}->{seq};
my $expand = $options->{'backend-option'}->{expand};
my $msp = $variant eq "msp";
my $movable = ChordPro::Chords::Parser->get_parser($s->{system})->movable;
upd_config();
my @s;
my %imgs;
if ( $s->{preamble} ) {
@s = @{ $s->{preamble} };
}
lib/ChordPro/Output/ChordPro.pm view on Meta::CPAN
push(@s, "") if $tidy;
push(@s, "{start_of_tab}");
push(@s, @{$elt->{body}});
push(@s, "{end_of_tab}");
push(@s, "") if $tidy;
next;
}
if ( $elt->{type} =~ /^comment(?:_italic|_box)?$/ ) {
my $type = $elt->{type};
my $text = $expand ? $elt->{text} : $elt->{orig};
if ( $msp ) {
$type = $type eq 'comment'
? 'highlight'
: $type eq 'comment_italic'
? 'comment'
: $type;
}
# Flatten chords/phrases.
if ( $elt->{chords} ) {
$text = "";
lib/ChordPro/Output/PDF.pm view on Meta::CPAN
# if ( $pagectrl->{dual_pages} && is_odd($page_offset) ) {
# warn("Warning: Specifying an even start page when ".
# "pdf.odd-even-pages is in effect may yield surprising results.\n");
# }
# If there is back matter, and it has even pages, force
# alignment of the final song as well.
my $back_matter;
my $force_align;
if ( $pagectrl->{back_matter} ) {
$back_matter = $pdfapi->open( expand_tilde($pagectrl->{back_matter}) );
die("Missing back matter: ", $pagectrl->{back_matter}, "\n")
unless $back_matter;
$force_align =
!( is_even($page_offset) xor is_even($back_matter->pages))
if $pagectrl->{align_songs_extend};
}
for my $songindex ( 1 .. @{$sb->{songs}} ) {
my $song = $sb->{songs}->[$songindex-1];
local $pagectrl->{align_songs_spread} = $pagectrl->{align_songs_spread};
lib/ChordPro/Output/PDF.pm view on Meta::CPAN
$pr->{pdf}->openpage($page)) if $pages;
$page += $pages;
# warn("TOC $toc $page\n");
}
$pages_of{toc} = $page - 1;
$start_of{$_} += $page - 1 for qw( songbook back );
}
if ( $pagectrl->{front_matter} ) {
$page = 1;
my $matter = $pdfapi->open( expand_tilde($pagectrl->{front_matter}) );
die("Missing front matter: ", $pagectrl->{front_matter}, "\n") unless $matter;
return unless progress( msg => "Front matter" );
for ( 1 .. $matter->pages ) {
$pr->{pdf}->import_page( $matter, $_, $_ );
$page++;
}
$pages_of{front} = $matter->pages;
$start_of{$_} += $page - 1 for qw( toc songbook back );
}
lib/ChordPro/Output/PDF.pm view on Meta::CPAN
songindex => 0,
numsongs => 1,
pagectrl => $pagectrl,
} );
$page += $p;
$start_of{$_} += $p for qw( songbook front toc back );
}
$pages_of{cover} = $page - 1;
}
elsif ( defined( $pagectrl->{cover} ) ) {
my $cover = $pdfapi->open( expand_tilde($pagectrl->{cover}) );
die("Missing cover: ", $pagectrl->{cover}, "\n") unless $cover;
$page = 0;
return unless progress( msg => "Cover" );
for ( 1 .. $cover->pages ) {
$page++;
$pr->{pdf}->import_page( $cover, $_, $page );
}
$pages_of{cover} = $page;
$start_of{$_} += $page for qw( songbook front toc back );
}
lib/ChordPro/Output/PDF/Writer.pm view on Meta::CPAN
use strict;
use warnings;
use Text::Layout;
use IO::String;
use Carp;
use utf8;
use ChordPro::Files;
use ChordPro::Paths;
use ChordPro::Utils qw( expand_tilde demarkup min is_corefont maybe is_true is_odd );
use ChordPro::Output::Common qw( fmt_subst prep_outlines );
use Ref::Util qw( is_arrayref is_hashref );
use feature 'state';
use Unicode::Collate;
use Unicode::Normalize;
# For regression testing, run perl with PERL_HASH_SEED set to zero.
# This eliminates the arbitrary order of font definitions and triggers
# us to pinpoint some other data that would otherwise be varying.
my $regtest = defined($ENV{PERL_HASH_SEED}) && $ENV{PERL_HASH_SEED} == 0;
lib/ChordPro/Output/PDF/Writer.pm view on Meta::CPAN
return 0 unless $pagectrl->{dual_pages}; # no alignment
return 0 unless $pagectrl->{align_songs}; # no alignment
use List::Util 'shuffle';
my $ps = $self->{ps};
my $bg;
my $ffile;
my $filler;
if ( ($bg = $ps->{formats}->{filler}->{background})
&&
( $ffile = expand_tilde($bg) )
&&
( $filler = $self->{pdfapi}->open($ffile) )
) {
state $file = "";
state @pages;
if ( $file ne $ffile || !@pages ) {
$file = $ffile;
# Try to make it reproducible.
local $ENV{PERL_HASH_SEED} = 0x12a02ab;
srand();
lib/ChordPro/Output/PDF/Writer.pm view on Meta::CPAN
my $fc = Text::Layout::FontConfig->new( debug => $config->{debug}->{fonts} > 1 );
# Add font dirs.
my @dirs;
my @d = ( @{$ps->{fontdir}}, @{ CP->findresdirs("fonts") }, $ENV{FONTDIR} );
# Avoid rsc result if dummy.
splice( @d, -2, 1 ) if $d[-2] eq "fonts/";
for my $fontdir ( @d ) {
next unless $fontdir;
$fontdir = expand_tilde($fontdir);
if ( fs_test( d => $fontdir ) ) {
$self->{pdfapi}->can("addFontDirs")->($fontdir);
$fc->add_fontdirs($fontdir);
push( @dirs, $fontdir );
}
else {
warn("PDF: Ignoring fontdir $fontdir [$!]\n");
undef $fontdir;
}
}
lib/ChordPro/Output/PDF/Writer.pm view on Meta::CPAN
}
sub init_filefont {
my ( $self, $ff ) = @_;
my $ps = $self->{ps};
my $font = $ps->{fonts}->{$ff};
my $fc = Text::Layout::FontConfig->new( debug => $config->{debug}->{fonts} > 1 );
eval {
my $t = $fc->from_filename(expand_tilde($font->{file}));
$t->get_font($self->{layout}); # force load
$t->{font}->{Name}->{val} =~ s/~.*/~$faketime/ if $regtest;
$t->{_ff} = $ff;
$font->{fd} = $t;
};
$font->{fd};
}
sub init_corefont {
my ( $self, $ff ) = @_;
lib/ChordPro/Paths.pm view on Meta::CPAN
fn_is_absolute( $p );
}
# Is bare (no volume/dir).
method is_here ( $p ) {
my ( $v, $d, $f ) = fn_splitpath($p);
$v eq '' && ( $d eq '' || $d =~ /^\.[\\\/]/ );
}
# Normalize - full path, forward slashes, ~ expanded.
method normalize ( $p, %opts ) {
$p = $home . "/$1" if $p =~ /~[\\\/](.*)/;
realpath($p)
}
# This is only used in ::runtimeinfo for display purposes.
method display ( $p ) {
return "<undef>" unless defined $p;
lib/ChordPro/Song.pm view on Meta::CPAN
if ( $found ) {
$uri = $found;
}
else {
do_warn("Missing image for \"$uri\"");
return;
}
}
# Do not affect URIs and base64 data strings.
elsif ( $uri !~ /^(data:|\w+:\/\/)/ ) {
$uri = expand_tilde($uri);
}
}
if ( $chord ) {
if ( $chord =~ /^\[(.*)\]$/ ) { # transposable
my $info = $self->parse_chord($1);
$chord = $info->{name} if $info;
}
$uri = "chord:$chord";
}
lib/ChordPro/Utils.pm view on Meta::CPAN
# Derived from Path::ExpandTilde.
use constant BSD_GLOB_FLAGS => GLOB_NOCHECK | GLOB_QUOTE | GLOB_TILDE | GLOB_ERR
# add GLOB_NOCASE as in File::Glob
| ($^O =~ m/\A(?:MSWin32|VMS|os2|dos|riscos)\z/ ? GLOB_NOCASE : 0);
# File::Glob did not try %USERPROFILE% (set in Windows NT derivatives) for ~ before 5.16
use constant WINDOWS_USERPROFILE => is_msw && $] < 5.016;
sub expand_tilde ( $dir ) {
return undef unless defined $dir;
return fn_canonpath($dir) unless $dir =~ m/^~/;
# Parse path into segments.
my ( $volume, $directories, $file ) = fn_splitpath( $dir, 1 );
my @parts = fn_splitdir($directories);
my $first = shift( @parts );
return fn_canonpath($dir) unless defined $first;
# Expand first segment.
my $expanded;
if ( WINDOWS_USERPROFILE and $first eq '~' ) {
$expanded = $ENV{HOME} || $ENV{USERPROFILE};
}
else {
( my $pattern = $first ) =~ s/([\\*?{[])/\\$1/g;
($expanded) = bsd_glob( $pattern, BSD_GLOB_FLAGS );
croak( "Failed to expand $first: $!") if GLOB_ERROR;
}
return fn_canonpath($dir)
if !defined $expanded or $expanded eq $first;
# Replace first segment with new path.
( $volume, $directories ) = fn_splitpath( $expanded, 1 );
$directories = fn_catdir( $directories, @parts );
return fn_catpath($volume, $directories, $file);
}
push( @EXPORT, 'expand_tilde' );
sub sys ( @cmd ) {
warn("+ @cmd\n") if $::options->{trace};
# Use outer defined subroutine, depends on Wx or not.
my $res = ::sys(@cmd);
warn( sprintf("=%02x=> @cmd", $res), "\n" ) if $res;
return $res;
}
push( @EXPORT, 'sys' );
lib/ChordPro/Utils.pm view on Meta::CPAN
# use DDP; p($value, as => "Value ->");
}
# Note that ':' is not oficially supported by RRJson.
my @keys = split( /[:.]/, $key );
my $lastkey = pop(@keys);
# Handle pdf.fonts.xxx shortcuts.
if ( join( ".", @keys ) eq "pdf.fonts" ) {
my $s = { pdf => { fonts => { $lastkey => $value } } };
ChordPro::Config::expand_font_shortcuts($s);
$value = $s->{pdf}{fonts}{$lastkey};
}
my $cur = \$cfg; # current pointer in struct
my $errkey = ""; # error trail
if ( $keys[0] eq "chords" ) {
# Chords are not in the config, but elsewhere.
$cur = \ChordPro::Chords::config_chords();
$errkey = "chords.";
shift(@keys);
lib/ChordPro/lib/JSON/Relaxed.pm view on Meta::CPAN
use JSON::Relaxed::Parser; our $VERSION = $JSON::Relaxed::Parser::VERSION;
=encoding UTF-8
=head1 NAME
JSON::Relaxed -- An extension of JSON that allows for better human-readability
=head1 Relaxed JSON?
There's been increasing support for the idea of expanding JSON to improve
human-readability.
"Relaxed" JSON (RJSON) is a term that has been used to describe a
JSON-ish format that has some human-friendly features that JSON doesn't.
Most notably, RJSON allows the use of JavaScript-like comments and
eliminates the need to quote all keys and values.
An (official) specification can be found on
L<RelaxedJSON.org|https://www.relaxedjson.org>.
I<Note that by definition every valid JSON document is also a valid
RJSON document.>
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
staff_d[st] = -o[0] * 7
} else {
staff_d[st] = 0
}
}
if (staff_d[st])
sym_ott(s, staff_d[st])
}
}
// expand the multi-rests as needed
function mrest_expand() {
var s, s2
// expand a multi-rest into a set of rest + bar
function mexp(s) {
var bar, s3, s4, tim, nbar,
nb = s.nmes,
dur = s.dur / nb,
s2 = s.next
// get the bar (there may be some other symbols before the bar)
while (s2 && !s2.bar_type)
s2 = s2.next
if (!s2)
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
}
if (!s2.seqst) {
while (s.type == C.MREST) {
mexp(s)
s = s.ts_next
}
} else {
s = s2.ts_prev
}
}
} // mrest_expand()
// set the clefs (treble or bass) in a 'auto clef' sequence
// return the starting clef type
function set_auto_clef(st, s_start, clef_type_start) {
var s, time, s2, s3,
max = 14, // "A,"
min = 18 // "E"
/* get the max and min pitches in the sequence */
for (s = s_start; s; s = s.ts_next) {
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
p_voice.ckey = p_voice.key // starting key
// (test removed because v.second may change after %%staves)
// if (!p_voice.second && !p_voice.norepbra)
set_rb(p_voice)
}
/* set the staff of the floating voices */
if (nv > 1) {
set_float()
// expand the multi-rests as needed
if (glovar.mrest_p)
mrest_expand()
}
if (glovar.ottava && cfmt.sound != "play")
set_ottava();
// set the clefs and adjust the pitches of all symbol
set_clefs();
self.set_pitch(null)
}
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
gene.st_print = non_empty_gl
}
/* -- position the symbols along the staff -- */
// (possible hook)
Abc.prototype.set_sym_glue = function(width) {
var g, x, some_grace, stretch,
cnt = 4,
xmin = 0, // sigma shrink = minimum spacing
xx = 0, // sigma natural spacing
xs = 0, // sigma unexpandable elements with no space
xse = 0, // sigma unexpandable elements with space
ll = !tsnext || // last line? yes
(tsnext.type == C.BLOCK // no, but followed by %%command
&& !tsnext.play)
|| blocks.length, // (abcm2ps compatibility)
s = tsfirst,
spf = 1, // spacing factor
xx0 = 0
/* calculate the whole space of the symbols */
for ( ; s; s = s.ts_next) {
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
n += 7;
c += ','
}
while (n >= 14) {
n -= 7;
c += "'"
}
return ntb[n] + c
} // n2n()
// expand a transposing macro
function expand(m, b) {
if (b == undefined) // if static macro
return m
var c, i,
r = "", // result
n = m.length
for (i = 0; i < n; i++) {
c = m[i]
if (c >= 'h' && c <= 'z') {
r += n2n(b + c.charCodeAt(0) - 'n'.charCodeAt(0))
} else {
r += c
}
}
return r
} // expand()
// parse a macro
function parse_mac(k, m, b) {
var te, ti, curv, s,
line_sav = line,
istart_sav = parse.istart;
parse.line = line = new scanBuf;
parse.istart += line_sav.index;
lib/ChordPro/res/abc/abc2svg/abc2svg-1.js view on Meta::CPAN
par_sy.voices[curvoice.v] = {
st: curv.st,
second: true,
range: curvoice.v
}
}
curvoice.time = ti
s = curvoice.last_sym
parse.line = line = new scanBuf
parse.istart += line_sav.index
line.buffer = expand(m, b)
parse_seq(true)
if (curvoice.time != te)
syntax(1, "Bad length of the macro sequence")
if (!s)
s = curvoice.sym
for ( ; s; s = s.next)
s.invis = s.play = true
curvoice = curv
} else {
line.buffer = expand(m, b)
parse_seq(true)
}
parse.line = line = line_sav
parse.istart = istart_sav
} // parse_mac()
// parse a music sequence
function parse_seq(in_mac) {
var c, idx, type, k, s, dcn, i, n, text, note
lib/ChordPro/res/abc/abc2svg/gamelan-1.js view on Meta::CPAN
C = abc2svg.C,
abc = this,
cur_sy = abc.get_cur_sy(),
voice_tb = abc.get_voice_tb()
if (!abc.cfmt().gamelan) {
of()
return
}
// expand dots and long notes/rests
function slice(s) {
var m, n, s2, s3, d, d_orig
if (s.dur <= C.BLEN * 3 / 8) {
if ((s.dur_orig / 9 | 0) * 9 != s.dur_orig)
return
d = s.dur / 3
d_orig = s.dur_orig / 3
s.dur -= d
s.dur_orig -= d_orig
lib/ChordPro/res/abc/abc2svg/jianpu-1.js view on Meta::CPAN
if (s.next)
s.next.prev = s
s.prev = s2
s2.next = s
s.ts_next = s2.ts_next
s.ts_next.ts_prev = s
s.ts_prev = s2
s2.ts_next = s
} // set head()
// expand a long note/rest
function slice(s) {
var n, s2, s3,
jn = s.type == C.REST ? 0 : 8 // '0' or '-'
if (s.dur >= C.BLEN)
n = 3
else if (s.dur == C.BLEN / 2)
n = 1
else
n = 2
script/rrjson.pl view on Meta::CPAN
else {
my $ret = @$res > 1 ? { " key order " => $res } : {};
foreach my $prop ( @$res ) {
$ret->{$prop} = $self->_data_internal($cur.$prop);
}
return $ret;
}
}
else {
my $val = $self->{_props}->{lc($orig)};
$val = $self->expand($val) if defined $val;
return $val;
}
}
} # Data::Properties
################ Subroutines ################
sub dumper($data, %opts) {
if ( $mode eq "dump" || %opts ) {
t/174_transpose.t view on Meta::CPAN
my $data1 = <<EOD;
{title: Transpose}
{key: D}
{C: | D | %{key.print} | %{key.sound} | [D] | }
EOD
my @argv = ( "--no-default-configs",
"--generate", "Text",
"--define", "keys.flats=1",
"--backend-option", "expand=1" );
sub test {
my $t = shift;
my $decapo = ( $t & 0x01 ) ? 1 : 0;
my $capo = ( $t & 0x02 ) ? 2 : 0;
my $xpose = ( $t & 0x04 ) ? 2 : 0; # local
my $transpose = ( $t & 0x08 ) ? 2 : 0; # global
return if $decapo && !$capo;
t/212_config.t view on Meta::CPAN
{ pdf =>
{ fonts =>
{ ape => { file => 'tim.ttf', size => 12 },
nut => 'sans 12',
mice => 'serif 12',
wime => 'serif 14',
yet => 'Times-Roman 12',
}}},
"simplify fonts" );
$config->expand_font_shortcuts;
is_deeply( $config,
{ pdf =>
{ fonts =>
{ ape => { file => 'tim.ttf', size => 12 },
nut => { description => 'sans 12' },
mice => { description => 'serif 12' },
wime => { description => 'serif 14' },
yet => { name => 'Times-Roman', size => 12 },
}}},
"expand fonts 1" );
$config->{pdf}->{fonts}->{ape} = "tim.ttf 12";
$config->expand_font_shortcuts;
is_deeply( $config,
{ pdf =>
{ fonts =>
{ ape => { file => 'tim.ttf', size => 12 },
nut => { description => 'sans 12' },
mice => { description => 'serif 12' },
wime => { description => 'serif 14' },
yet => { name => 'Times-Roman', size => 12 },
}}},
"expand fonts 2" );
t/710_cho.t view on Meta::CPAN
#$options->{fragment} = 1;
foreach my $file ( sort @files ) {
$test++;
$file = "cho/$file";
#diag("Testing: $file");
( my $out = $file ) =~ s/\.cho/.out/;
( my $ref = $file ) =~ s/\.cho/.ref/;
@ARGV = ( "--no-default-configs",
"--generate", "ChordPro",
"--backend-option", "expand=1",
"--output", $out,
$file );
if ( $file =~ /n\./ ) {
splice( @ARGV, -1, 0, "--transcode", "nashville",
"--define", "diagrams.show=false",
);
}
elsif ( $file =~ /r\./ ) {
splice( @ARGV, -1, 0, "--transcode", "roman",
"--define", "diagrams.show=false",
( run in 1.625 second using v1.01-cache-2.11-cpan-5b529ec07f3 )