App-Music-ChordPro
view release on metacpan or search on metacpan
lib/ChordPro/Config.pm view on Meta::CPAN
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}
if $_->{color} && $_->{color} eq "foreground";
delete $_->{background}
lib/ChordPro/Config.pm view on Meta::CPAN
$path =~ s/\.$//;
if ( $self eq $orig ) {
warn("I: $path\n") if DEBUG;
return 'I';
}
warn("M $path $self\n") if DEBUG;
return 'M';
}
sub hmerge( $left, $right, $path = "" ) {
# Merge hashes. Right takes precedence.
# Based on Hash::Merge::Simple by Robert Krimen.
my %res = %$left;
for my $key ( keys(%$right) ) {
warn("Config error: unknown item $path$key\n")
unless exists $res{$key}
lib/ChordPro/Delegate/ABC.pm view on Meta::CPAN
use feature 'state';
use Encode 'decode_utf8';
use ChordPro::Paths;
use ChordPro::Utils;
use Text::ParseWords qw(shellwords);
use constant { QUICKJS => "QuickJS",
QUICKJSXS => "QuickJS_XS" };
sub DEBUG() { $config->{debug}->{abc} }
# ABC processing using abc2svg and custom SVG processor.
# See info() below how the method is determined.
# Song and PDF module uses 'can' to get at this.
sub can( $class, $method ) {
if ( $method eq "options" ) {
return \&options;
}
# abc2svg handlers are sorted out by info().
return \&abc2svg;
}
# Default entry point.
sub abc2svg( $song, %args ) {
my $abc2svg = info();
if ( DEBUG() ) {
::dump($abc2svg);
}
state $cfg_checked;
unless ( $cfg_checked++ ) {
if ( ($config->{delegates}{abc}{config} // "default") ne "default" ) {
lib/ChordPro/Delegate/ABC.pm view on Meta::CPAN
$info->{handler} = $handler;
$info->{method} = CP->display($exe);
$info->{info} = $info->{method};
$info->{command} = [ $exe ];
}
return $info;
}
# Pre-scan.
sub options( $data ) {
my @pre;
my @data = @$data;
while ( @data ) {
last if $data[0] =~ /^([A-Z]:|\%)/;
push( @pre, shift(@data) );
}
@pre = () if @pre && !@data; # no data found
my $kv = {};
$kv = parse_kvm( @pre ) if @pre;
lib/ChordPro/Delegate/Lilypond.pm view on Meta::CPAN
no warnings "experimental::signatures";
use utf8;
use File::Spec;
use File::Temp ();
use File::LoadLines;
use feature 'state';
use ChordPro::Utils;
use Text::ParseWords qw(shellwords);
sub DEBUG() { $config->{debug}->{ly} }
sub ly2svg( $self, %args ) {
my ( $elt, $pw ) = @args{qw(elt pagewidth)};
state $imgcnt = 0;
state $td = File::Temp::tempdir( CLEANUP => !$config->{debug}->{ly} );
$imgcnt++;
my $src = File::Spec->catfile( $td, "tmp${imgcnt}.ly" );
my $svg = File::Spec->catfile( $td, "tmp${imgcnt}.svg" );
my $fd;
lib/ChordPro/Delegate/Lilypond.pm view on Meta::CPAN
subtype => "svg",
uri => "$im1.cropped.svg",
opts => { maybe id => $kv->{id},
maybe align => $kv->{align},
maybe spread => $kv->{spread},
maybe scale => $scale,
maybe design_scale => $design_scale,
} };
}
sub ly2image( $s, $pw, $elt ) {
croak("Lilypond: Please adjust your delegate config to use handler \"ly2svg\" instead of \"ly2image\"");
}
# Pre-scan.
sub options( $data ) {
my @pre;
my @data = @$data;
while ( @$data ) {
last if $data[0] =~ /^[%\\]/; # LP data
push( @pre, shift(@data) );
}
@pre = () if @pre && !@$data; # no LP found
my $kv = {};
$kv = parse_kvm( @pre ) if @pre;
lib/ChordPro/Delegate/SVG.pm view on Meta::CPAN
use strict;
use warnings;
use feature qw( signatures );
no warnings "experimental::signatures";
use utf8;
package ChordPro::Delegate::SVG;
use ChordPro::Utils;
sub DEBUG() { $::config->{debug}->{svg} }
sub svg2svg( $self, %args ) {
my $elt = $args{elt};
my @data = @{ $elt->{data} };
my @pre;
while ( $data[0] !~ /<svg/ ) {
push( @pre, shift(@data) );
}
my $kv = parse_kvm( @pre ) if @pre;
$kv->{split} //= 1; # less overhead. really.
lib/ChordPro/Delegate/SVG.pm view on Meta::CPAN
return
{ type => "image",
subtype => "svg",
line => $elt->{line},
data => \@data,
opts => { %$kv, %{$elt->{opts}//{}} },
};
}
# Pre-scan.
sub options( $data ) {
my @pre;
while ( $data->[0] !~ /<svg/ ) {
push( @pre, shift(@$data) );
}
my $kv = parse_kvm( @pre ) if @pre;
$kv;
}
lib/ChordPro/Delegate/TextBlock.pm view on Meta::CPAN
# background: Background color of the object.
#
# Common attributes:
#
# id: Make asset instead of image.
# align: Image alignment (left, center, right)
# border: Draw border around the image.
use ChordPro::Utils;
sub DEBUG() { $::config->{debug}->{txtblk} }
sub txt2xform( $self, %args ) {
my $elt = $args{elt};
my $ps = $self->{_ps};
my $pr = $ps->{pr};
my $opts = { %{$elt->{opts}} };
# Text style must be one of the known styles (text, chord, comment, ...).
my $style = delete($opts->{textstyle}) // "text";
unless ( defined($ps->{fonts}->{$style} ) ) {
warn("TextBlock: Unknown font style \"$style\", using \"text\"\n");
lib/ChordPro/Delegate/TextBlock.pm view on Meta::CPAN
subtype => "xoform",
line => $elt->{line},
data => $xo,
width => $width + 2*$padding,
height => $height + 2*$padding,
opts => { align => "left", %$opts },
};
}
# Pre-scan.
sub options( $data ) { {} }
1;
lib/ChordPro/Dumper.pm view on Meta::CPAN
return ref($ref) . " [@bb]";
} },
{ 'PDF::API2::Resource::XObject::Image' => sub ( $ref, $ddp ) {
return join( "", ref($ref),
" [", $ref->width, "x", $ref->height, "]",
);
} },
];
sub ddp( $ref, %options ) {
my %o = ( filters => $filters, %options );
if ( $o{as} =~ /^(.*)\n\Z/s ) {
$o{as} = $1;
$o{caller_message_newline} = 1;
}
defined(wantarray)
? np( $ref, %o )
: ( -t STDERR )
? p( $ref, %o )
: warn( np( $ref, %o ), "\n" );
lib/ChordPro/Output/Common.pm view on Meta::CPAN
# Copyright (c) 1995 OZAWA Sakuro. All rights reserved. This program
# is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself.
our %roman2arabic = qw(I 1 V 5 X 10 L 50 C 100 D 500 M 1000);
my %roman_digit = qw(1 IV 10 XL 100 CD 1000 MMMMMM);
my @figure = reverse sort keys %roman_digit;
#my %roman_digit;
$roman_digit{$_} = [split(//, $roman_digit{$_}, 2)] foreach @figure;
sub isroman($) {
my $arg = shift;
$arg ne '' and
$arg =~ /^(?: M{0,3})
(?: D?C{0,3} | C[DM])
(?: L?X{0,3} | X[LC])
(?: V?I{0,3} | I[VX])$/ix;
}
push( @EXPORT_OK, 'isroman' );
sub arabic($) {
my $arg = shift;
isroman $arg or return undef;
my($last_digit) = 1000;
my($arabic);
foreach (split(//, uc $arg)) {
my($digit) = $roman2arabic{$_};
$arabic -= 2 * $last_digit if $last_digit < $digit;
$arabic += ($last_digit = $digit);
}
$arabic;
}
push( @EXPORT_OK, 'arabic' );
sub Roman($) {
my $arg = shift;
0 < $arg and $arg < 4000 or return undef;
my($x, $roman);
foreach (@figure) {
my($digit, $i, $v) = (int($arg / $_), @{$roman_digit{$_}});
if (1 <= $digit and $digit <= 3) {
$roman .= $i x $digit;
} elsif ($digit == 4) {
$roman .= "$i$v";
} elsif ($digit == 5) {
lib/ChordPro/Output/Common.pm view on Meta::CPAN
} elsif ($digit == 9) {
$roman .= "$i$x";
}
$arg -= $digit * $_;
$x = $i;
}
$roman;
}
push( @EXPORT_OK, 'Roman' );
sub roman($) {
lc( Roman(shift) );
}
push( @EXPORT_OK, 'roman' );
# Prepare outlines.
# This mainly untangles alternative names when being sorted on.
# Returns a book array where each element consists of the sort items,
# and the song.
#sub PODBG() { $config->{debug}->{x1} }
sub PODBG() { 0 }
# Suppress toc entry.
sub _suppresstoc {
my ( $meta ) = @_;
return !is_true($meta->{_TOC}->[0]) if exists($meta->{_TOC});
# return unless exists($meta->{sorttitle});
# my $st = $meta->{sorttitle};
# defined($st) && ( $st->[0] eq "" || $st->[0] eq '""' );
return;
}
lib/ChordPro/Output/PDF/Grid.pm view on Meta::CPAN
package ChordPro::Output::PDF::Grid;
use strict;
use warnings;
use Carp;
use feature 'state';
use feature 'signatures';
no warnings 'experimental::signatures';
sub gridline( $elt, $x, $y, $cellwidth, $barwidth, $margin, $ps, %opts ) {
# Grid context.
my $pr = $ps->{pr};
my $fonts = $ps->{fonts};
# Use the chords font for the chords, and for the symbols size.
my $fchord = { %{ $fonts->{grid} || $fonts->{chord} } };
delete($fchord->{background});
$y -= font_bl($fchord);
lib/ChordPro/Output/PDF/Grid.pm view on Meta::CPAN
if ( $t->{chords} ) {
$t->{text} = "";
for ( 0..$#{ $t->{chords} } ) {
$t->{text} .= $t->{chords}->[$_]->chord_display . $t->{phrases}->[$_];
}
}
$pr->text( " " . $t->{text}, $x, $y, $fonts->{grid_margin} );
}
}
sub is_bar( $elt ) {
exists( $elt->{class} ) && $elt->{class} eq "bar";
}
sub pr_cellline( $x, $y, $lcr, $sz, $w, $col, $pr ) {
$x -= $w / 2 * ($lcr + 1);
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
}
sub pr_barline( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = $w
$x -= $w / 2 * ($lcr + 1);
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
}
sub pr_dbarline( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = 3 * $w
$x -= 1.5 * $w * ($lcr + 1);
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
$x += 2 * $w;
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
}
sub pr_rptstart( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = 3 * $w
$x -= 1.5 * $w * ($lcr + 1);
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
$x += 2 * $w;
$y += 0.55 * $sz;
$pr->line( $x, $y, $x, $y+$w, $w, $col );
$y -= 0.4 * $sz;
$pr->line( $x, $y, $x, $y+$w, $w, $col );
}
sub pr_rptvolta( $x, $y, $lcr, $sz, $symcol, $pr, $token ) {
my $w = $sz / 10; # glyph width = 3 * $w
my $col = $pr->{ps}->{grids}->{volta}->{color};
my $ret = $x -= 1.5 * $w * ($lcr + 1);
$pr->vline( $x, $y+0.9*$sz, $sz, $w, $col );
$x += 2 * $w;
my $font = $pr->{ps}->{fonts}->{grid};
$pr->setfont($font);
$pr->text( "<span color='$col'><sup>" . $token->{volta} . "</sup></span>",
$x-$w/2, $y, $font );
$ret;
}
sub pr_voltafinish( $x, $y, $width, $sz, $symcol, $pr ) {
my $w = $sz / 10; # glyph width = 3 * $w
my ( $col, $span ) = @{$pr->{ps}->{grids}->{volta}}{qw(color span)};
$pr->hline( $x, $y+0.9*$sz+$w/4, $width*$span, $w/2, $col );
}
sub pr_rptend( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = 3 * $w
$x -= 1.5 * $w * ($lcr + 1);
$pr->vline( $x + 2*$w, $y+0.9*$sz, $sz, $w, $col );
$y += 0.55 * $sz;
$pr->line( $x, $y, $x, $y+$w, $w, $col );
$y -= 0.4 * $sz;
$pr->line( $x, $y, $x, $y+$w, $w, $col );
}
sub pr_rptendstart( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = 5 * $w
$x -= 2.5 * $w * ($lcr + 1);
$pr->vline( $x + 2*$w, $y+0.9*$sz, $sz, $w, $col );
$y += 0.55 * $sz;
$pr->line( $x, $y, $x , $y+$w, $w, $col );
$pr->line( $x+4*$w, $y, $x+4*$w, $y+$w, $w, $col );
$y -= 0.4 * $sz;
$pr->line( $x, $y, $x, $y+$w, $w, $col );
$pr->line( $x+4*$w, $y, $x+4*$w, $y+$w, $w, $col );
}
sub pr_repeat( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 3; # glyph width = 3 * $w
$x -= 1.5 * $w * ($lcr + 1);
my $lw = $sz / 10;
$x -= $w / 2;
$pr->line( $x, $y+0.2*$sz, $x + $w, $y+0.7*$sz, $lw );
$pr->line( $x, $y+0.6*$sz, $x + 0.07*$sz , $y+0.7*$sz, $lw );
$x += $w;
$pr->line( $x - 0.05*$sz, $y+0.2*$sz, $x + 0.02*$sz, $y+0.3*$sz, $lw );
}
sub pr_endline( $x, $y, $lcr, $sz, $col, $pr ) {
my $w = $sz / 10; # glyph width = 2 * $w
$x -= 0.75 * $w * ($lcr + 1);
$pr->vline( $x, $y+0.85*$sz, 0.9*$sz, 2*$w );
}
################ Hooks ################
*font_bl = *ChordPro::Output::PDF::font_bl;
*pr_label_maybe = *ChordPro::Output::PDF::pr_label_maybe;
lib/ChordPro/Paths.pm view on Meta::CPAN
class ChordPro::Paths;
my $instance;
# Work around Object::Pad 0.817 breakage.
#method get :common ( $reset = 0 ) {
# undef $instance if $reset;
# $instance //= $class->new;
#}
sub get( $class, $reset = 0 ) {
undef $instance if $reset;
$instance //= $class->new;
}
use Cwd qw(realpath);
use File::Spec::Functions qw( catfile catdir splitpath catpath file_name_is_absolute );
use File::HomeDir;
field $home :reader; # dir
field $configdir :reader; # dir
lib/ChordPro/Paths.pm view on Meta::CPAN
$ENV{uc($packager)."_PACKAGED"};
}
################ Export ################
# For convenience.
use Exporter 'import';
our @EXPORT;
sub CP() { __PACKAGE__->get }
push( @EXPORT, 'CP' );
1;
lib/ChordPro/Utils.pm view on Meta::CPAN
return "" if $suppressundef;
$val = "<undef>"
}
defined wantarray ? $label.$val : warn($label.$val."\n");
}
push( @EXPORT, 'pv' );
# Processing JSON.
sub json_load( $json, $source = "<builtin>" ) {
my $info = json_parser();
if ( $info->{parser} eq "JSON::Relaxed" ) {
state $pp = JSON::Relaxed::Parser->new( croak_on_error => 0,
strict => 0,
prp => 1 );
my $data = $pp->decode($json);
return $data unless $pp->is_error;
$source .= ": " if $source;
die("${source}JSON error: " . $pp->err_msg . "\n");
}
lib/ChordPro/Utils.pm view on Meta::CPAN
# Glue lines, so we have at lease some relaxation.
$json =~ s/"\s*\\\n\s*"//g;
$pp->relaxed if $info->{relaxed};
$pp->decode($json);
}
}
# JSON parser, what and how (also used by runtimeinfo().
sub json_parser() {
my $relax = $ENV{CHORDPRO_JSON_RELAXED} // 2;
if ( $relax > 1 ) {
require JSON::Relaxed;
return { parser => "JSON::Relaxed",
version => $JSON::Relaxed::VERSION }
}
else {
require JSON::PP;
return { parser => "JSON::PP",
relaxed => $relax,
lib/ChordPro/Utils.pm view on Meta::CPAN
}
push( @EXPORT, "maybe" );
# Min/Max.
sub min { $_[0] < $_[1] ? $_[0] : $_[1] }
sub max { $_[0] > $_[1] ? $_[0] : $_[1] }
push( @EXPORT, "min", "max" );
# Plural
sub plural( $n, $tag, $plural=undef ) {
$plural //= $tag . "s";
( $n || "no" ) . ( $n == 1 ? $tag : $plural );
}
push( @EXPORT, "plural" );
# Dimensions.
# Fontsize allows typical font units, and defaults to ref 12.
sub fontsize( $size, $ref=12 ) {
if ( $size && $size =~ /^([.\d]+)(%|e[mx]|p[tx])$/ ) {
return $ref/100 * $1 if $2 eq '%';
return $ref * $1 if $2 eq 'em';
return $ref/2 * $1 if $2 eq 'ex';
return $1 if $2 eq 'pt';
return $1 * 0.75 if $2 eq 'px';
}
$size || $ref;
}
push( @EXPORT, "fontsize" );
# Dimension allows arbitrary units, and defaults to ref 12.
sub dimension( $size, %sz ) {
return unless defined $size;
my $ref;
if ( ( $ref = $sz{fsize} )
&& $size =~ /^([.\d]+)(%|e[mx])$/ ) {
return $ref/100 * $1 if $2 eq '%';
return $ref * $1 if $2 eq 'em';
return $ref/2 * $1 if $2 eq 'ex';
}
if ( ( $ref = $sz{width} )
&& $size =~ /^([.\d]+)(%)$/ ) {
lib/ChordPro/Utils.pm view on Meta::CPAN
}
push( @EXPORT, "is_corefont" );
# Progress reporting.
use Ref::Util qw(is_coderef);
# Progress can return a false result to allow caller to stop.
sub progress(%args) {
state $callback;
state $phase = "";
state $index = 0;
state $total = '';
unless ( %args ) { # reset
undef $callback;
$phase = "";
$index = 0;
return;
}
lib/ChordPro/Utils.pm view on Meta::CPAN
warn( $msg, "\n" ) if $msg;
}
return $ret;
}
push( @EXPORT, "progress" );
# Common items for property directives ({textsize} etc.).
sub propitems() {
qw( chord chorus diagrams footer grid label tab text title toc );
}
sub propitems_re() {
my $re = join( '|', propitems() );
qr/(?:$re)/;
}
push( @EXPORT, "propitems_re" );
push( @EXPORT_OK, "propitems" );
1;
lib/ChordPro/Wx/Config.pm view on Meta::CPAN
dumpstate => 0,
expert => 0,
);
use constant MAXRECENTS => 10;
# Establish a connection with the persistent data store.
#method Setup :common ($options) {
sub Setup( $class, $options ) {
if ( $options->{config} ) {
Wx::ConfigBase::Set
( $cb = Wx::FileConfig->new
( "WxChordPro",
"ChordPro_ORG",
$options->{config},
'',
wxCONFIG_USE_LOCAL_FILE,
));
lib/ChordPro/Wx/Editor.pm view on Meta::CPAN
no warnings 'experimental::signatures';
use utf8;
use Wx ':everything';
package ChordPro::Wx::Editor;
use ChordPro::Wx::Config;
use ChordPro::Wx::Utils;
sub new( $class, $parent, $id ) {
my $widget;
$::options->{stc} //= 1;
if ( $::options->{stc} && eval { require Wx::STC; 1 } ) {
# if ( $::options->{stc} && eval { require Wx::Scintilla; 1 } ) {
$widget = Wx::StyledTextCtrl->new($parent);
# $widget = Wx::Scintilla::TextCtrl->new($parent);
$state{have_stc} = 1;
return bless $widget => 'ChordPro::Wx::STCEditor';
}
lib/ChordPro/Wx/Editor.pm view on Meta::CPAN
package ChordPro::Wx::STCEditor;
use parent qw( -norequire Wx::StyledTextCtrl );
#use parent qw( -norequire Wx::Scintilla::TextCtrl );
use Wx ':everything';
use ChordPro::Wx::Config;
use ChordPro::Wx::Utils;
sub refresh( $self, $prefs = undef ) {
my $stc = $self;
$prefs //= \%preferences;
# RTI loading is currently too slow.
# $state{rti} = ChordPro::runtime_info();
$state{rti}->{directive_abbrevs} = ChordPro::Song::_directive_abbrevs();
$stc->SetLexer(wxSTC_LEX_CONTAINER);
$stc->SetKeyWords(0,
lib/ChordPro/Wx/Editor.pm view on Meta::CPAN
$stc->SetWrapMode(0); # wxSTC_WRAP_NONE );
}
$self->style_text;
# Expert...
$stc->SetViewEOL( $state{vieweol} );
$stc->SetViewWhiteSpace( $state{viewws} );
}
sub style_text( $self ) {
my $stc = $self;
# Scintilla uses byte indices.
use Encode;
my $text = Encode::encode_utf8($stc->GetText);
my $style = sub {
my ( $re, @styles ) = @_;
pos($text) = 0;
while ( $text =~ m/$re/g ) {
lib/ChordPro/Wx/Editor.pm view on Meta::CPAN
# Comments/
$style->( qr/^(#.*)/m, 1 );
# Directives.
$style->( qr/^([ \t]*)(\{)([-\w!]+)(.*)(\})/m, 7, 3, 5, 6, 3 );
$style->( qr/^([ \t]*)(\{)([-\w!]+)([: ])(.*)(\})/m, 7, 3, 5, 3, 6, 3 );
# Chords.
$style->( qr/(\[)([^\[\]\s]*)(\])/m, 3, 4, 3 );
}
sub prepare_annotations( $self ) {
return unless $state{have_stc};
my $stc = $self;
$stc->AnnotationClearAll;
$stc->AnnotationSetVisible(wxSTC_ANNOTATION_BOXED);
if ( $stc->can("StyleGetSizeFractional") ) { # Wx 3.002
$stc->StyleSetSizeFractional # size * 100
( $self->{astyle},
( $stc->StyleGetSizeFractional
( wxSTC_STYLE_DEFAULT ) * 4 ) / 5 );
}
return 1;
}
sub add_annotation( $self, $line, $message ) {
return unless $state{have_stc};
my $stc = $self;
$stc->AnnotationSetText( $line, $message );
$stc->AnnotationSetStyle( $line, $self->{astyle} );
}
unless ( __PACKAGE__->can("IsModified") ) {
*IsModified = sub($self) {
$self->{_modified} || $self->CanUndo;
};
}
unless ( __PACKAGE__->can("DiscardEdits") ) {
*DiscardEdits = sub($self) {
$self->EmptyUndoBuffer;
$self->{_modified} = 0;
};
}
sub SetModified( $self, $mod ) {
if ( $mod ) {
$self->{_modified} = 1;
}
else {
$self->DiscardEdits;
}
}
sub SetFont( $self, $font ) {
die("XXX\n") unless $font->IsOk;
$self->StyleSetFont( $_, $font ) for 0..7;
$self->{font} = $font;
}
sub GetFont( $self ) {
$self->{font} // $self->StyleGetFont(0);
}
sub OSXDisableAllSmartSubstitutions( $self ) {
}
sub OnStyleNeeded( $self, $event ) { # scintilla
$self->style_text;
}
sub Replace( $self, $from=-1, $to=-1, $text="" ) {
# We will only call this to replace the selection.
$self->ReplaceSelection($text);
}
################ Methods ################
package ChordPro::Wx::TextEditor;
use parent qw( -norequire Wx::TextCtrl );
use Wx ':everything';
use ChordPro::Wx::Config;
use ChordPro::Wx::Utils;
use ChordPro::Utils qw( is_macos );
sub new( $class, $parent, $id=undef ) {
my $self = $class->SUPER::new( $parent, wxID_ANY, "",
wxDefaultPosition, wxDefaultSize,
wxHSCROLL|wxTE_MULTILINE );
return $self;
}
sub refresh( $self, $prefs = undef ) {
my $ctrl = $self;
$prefs //= \%preferences;
my $mod = $self->IsModified;
# TextCtrl only supports background colour and font.
my $theme = $prefs->{editortheme};
my $c = $prefs->{editcolour}{$theme};
my $bgcol = Wx::Colour->new( $c->{bg} );
my $fgcol = Wx::Colour->new( $c->{fg} );
$ctrl->SetBackgroundColour($bgcol);
$ctrl->SetStyle( 0, $ctrl->GetLastPosition,
Wx::TextAttr->new( $fgcol, $bgcol ) );
$ctrl->SetFont( Wx::Font->new($prefs->{editfont}) );
$ctrl->SetModified($mod);
}
sub AddText( $self, $text ) {
$self->WriteText($text);
}
sub GetLineCount( $self ) {
$self->GetNumberOfLines;
}
sub GetSelectedText( $self ) {
$self->GetStringSelection;
}
sub GetText( $self ) {
$self->GetValue;
}
sub SetText( $self, $text ) {
$self->SetValue($text);
}
sub SetColour( $self, $colour ) {
$self->SetStyle( 0, $self->GetLastPosition,
Wx::TextAttr->new( Wx::Colour->new($colour) ) );
}
sub EmptyUndoBuffer($self) {
}
sub OSXDisableAllSmartSubstitutions( $self ) {
return unless is_macos;
$self->SUPER::OSXDisableAllSmartSubstitutions;
}
################
1;
lib/ChordPro/Wx/EditorPanel.pm view on Meta::CPAN
use ChordPro::Wx::Utils;
use ChordPro::Utils qw( max demarkup is_macos is_msw plural );
use ChordPro::Paths;
use File::Basename;
# WhoamI
field $panel :accessor = "editor";
# Just fill in the defaults.
sub BUILDARGS( $class, $parent=undef, $id=wxID_ANY,
$pos=wxDefaultPosition, $size=wxDefaultSize,
$style=0, $name="" ) {
return( $parent, $id, $pos, $size, $style, $name );
}
BUILD {
# By default the TextCtrl on MacOS substitutes smart quotes and dashes.
# Note that OSXDisableAllSmartSubstitutions requires an augmented
# version of wxPerl.
$self->{t_editor}->OSXDisableAllSmartSubstitutions;
lib/ChordPro/Wx/Main.pm view on Meta::CPAN
package ChordPro::Wx::WxChordPro;
use parent qw( Wx::App ChordPro::Wx::Main );
use ChordPro::Paths;
use ChordPro::Wx::Config;
use Wx qw( wxACCEL_CTRL WXK_CONTROL_Q wxID_EXIT );
sub run( $self, $opts ) {
$options = $opts;
#### Start ################
ChordPro::Wx::WxChordPro->new->MainLoop();
}
sub OnInit( $self ) {
$self->SetAppName("ChordPro");
$self->SetVendorName("ChordPro.ORG");
Wx::InitAllImageHandlers();
ChordPro::Wx::Config->Setup($options);
ChordPro::Wx::Config->Load($options);
my $main = ChordPro::Wx::Main->new;
return 0 unless $main->init($options);
lib/ChordPro/Wx/SongbookExportPanel.pm view on Meta::CPAN
use ChordPro::Wx::Utils;
use Encode qw( decode_utf8 encode_utf8 );
use File::LoadLines;
use File::Basename;
# WhoamI
field $panel :accessor = "sbexport";
# Just fill in the defaults.
sub BUILDARGS( $class, $parent=undef, $id=wxID_ANY,
$pos=wxDefaultPosition, $size=wxDefaultSize,
$style=0, $name="" ) {
return( $parent, $id, $pos, $size, $style, $name );
}
BUILD {
# Setup logger.
$self->setup_logger;
# Setup WebView, if possible.
lib/ChordPro/Wx/Utils.pm view on Meta::CPAN
{ M_ALL => 0xff,
M_MAIN => 0x01,
M_EDITOR => 0x02,
M_SONGBOOK => 0x04,
};
push( @EXPORT, qw( M_MAIN M_EDITOR M_SONGBOOK ) );
my @swingers;
sub update_menubar( $self, $sel ) {
die unless @swingers;
for ( @swingers ) {
my ( $mi, $mask ) = @$_;
$mi->Enable( $mask & $sel );
}
}
sub setup_menubar( $self ) {
state $expert = $ChordPro::Wx::Config::state{preferences}{expert};
state $ctl =
[ [ wxID_FILE,
[ [ wxID_HOME, M_EDITOR|M_SONGBOOK, "Start Screen",
"Return to the Start Screen.", "OnStart" ],
[],
[ wxID_NEW, M_ALL, "",
"Create another ChordPro document", "OnNew" ],
lib/ChordPro/Wx/Utils.pm view on Meta::CPAN
# Add menu bar.
$target->SetMenuBar($mb);
return $mb;
}
push( @EXPORT, "setup_menubar", "update_menubar" );
################ ################
sub savewinpos( $win, $name ) {
return unless $name eq "main";
$ChordPro::Wx::Config::state{windows}->{$name} =
join( " ", $win->GetPositionXY, $win->GetSizeWH );
}
sub restorewinpos( $win, $name ) {
return unless $name eq "main";
$win = $Wx::wxTheApp->GetTopWindow;
my $t = $ChordPro::Wx::Config::state{windows}->{$name};
if ( $t ) {
my @a = split( ' ', $t );
if ( is_msw || is_macos ) {
$win->SetSizeXYWHF( $a[0],$a[1],$a[2],$a[3], 0 );
}
else {
# Linux WM usually prevent placement.
$win->SetSize( $a[2],$a[3] );
}
}
}
push( @EXPORT, 'savewinpos', 'restorewinpos' );
################ ################
sub panels() {
my @panels = qw( p_editor p_sbexport );
wantarray ? @panels : \@panels;
}
push( @EXPORT, 'panels' );
################ ################
sub ellipsize( $widget, %opts ) {
my $text = $opts{text} // $widget->GetText;
my $home = ChordPro::Paths->get->home;
$text =~ s/^\Q$home\E\/*/~\//;
my $width = ($widget->GetSizeWH)[0];
$text = Wx::Control::Ellipsize( $text, Wx::ClientDC->new($widget),
$opts{type} // wxELLIPSIZE_END(),
$width-10, wxELLIPSIZE_FLAGS_DEFAULT() )
if Wx::Control->can("Ellipsize");
# Change w/o triggering a EVT_TEXT event.
$widget->ChangeValue($text);
}
push( @EXPORT, "ellipsize" );
################ ################
sub kbdkey( $key ) {
$key =~ s/Shift-/⇧/;
$key =~ s/Alt-/⎇/;
$key =~ s/Option-/⌥/;
my $c = is_macos ? "⌘" : "Ctrl-";
$key =~ s/Ctrl-/$c/;
return $key;
}
push( @EXPORT, "kbdkey" );
use Storable();
################ ################
sub clone( $struct ) { Storable::dclone($struct) }
push( @EXPORT, "clone" );
################ ################
sub Wx::ColourPickerCtrl::GetAsHTML( $self ) {
$self->GetColour->GetAsString(wxC2S_HTML_SYNTAX);
}
################ ################
lib/ChordPro/Wx/Utils.pm view on Meta::CPAN
$rest[0] = ChordPro::Paths->get->findres( basename($rest[0]),
class => "icons" );
$rest[0] ||= ChordPro::Paths->get->findres( "missing.png",
class => "icons" );
$::wxbitmapnew->($self, @rest);
};
}
################ ################
sub has_appearance() {
Wx::SystemSettings->can("GetAppearance");
}
push( @EXPORT, 'has_appearance' );
################ ################
lib/ChordPro/lib/JSON/Relaxed/Parser.pm view on Meta::CPAN
$s =~ s/^\n*//s;
$s .= "\n" if $s !~ /\n$/;
}
return $s;
}
################ Subroutines ################
# resolve processes $ref, allOf etc nodes.
sub resolve( $d, $schema ) {
if ( is_hash($d) ) {
while ( my ($k,$v) = each %$d ) {
if ( $k eq 'allOf' ) {
delete $d->{$k}; # yes, safe to do
$d = merge( resolve( $_, $schema ), $d ) for @$v;
}
elsif ( $k eq 'oneOf' || $k eq 'anyOf' ) {
delete $d->{$k}; # yes, safe to do
$d = merge( resolve( $v->[0], $schema ), $d );
lib/ChordPro/lib/JSON/Relaxed/Parser.pm view on Meta::CPAN
}
elsif ( is_array($d) ) {
$d = [ map { resolve( $_, $schema ) } @$d ];
}
else {
}
return $d;
}
sub is_hash($o) { UNIVERSAL::isa( $o, 'HASH' ) }
sub is_array($o) { UNIVERSAL::isa( $o, 'ARRAY' ) }
sub merge ( $left, $right ) {
return $left unless $right;
my %merged = %$left;
for my $key ( keys %$right ) {
my ($hr, $hl) = map { is_hash($_->{$key}) } $right, $left;
lib/ChordPro/lib/SVGPDF.pm view on Meta::CPAN
" (initial)");
$xo->stroke_color( $_ eq 'currentColor' ? 'black' : $_ );
}
$svg->traverse;
$svg->css_pop;
$self->_dbg( "==== end ", $e->{name}, " ====" );
}
sub min( $a, $b ) { $a < $b ? $a : $b }
sub max( $a, $b ) { $a > $b ? $a : $b }
method combine_svg( $forms, %opts ) {
my $type = $opts{type} // "stacked";
return $forms if $type eq "none";
my ( $xmin, $ymin, $xmax, $ymax );
my $y = 0;
my $x = 0;
my $sep = $opts{sep} || 0;
my $nx;
t/410_prp.t view on Meta::CPAN
is_deeply( prpadd2cfg( [qw(x y z)], "<1" => "a" ), [qw(x a y z)], "<1" );
is_deeply( prpadd2cfg( [qw(x y z)], "<-1" => "a" ), [qw(x y a z)], "<-1" );
is_deeply( prpadd2cfg( [qw(x y z a)], "/" => "" ), [qw(x y z)], "/" );
is_deeply( prpadd2cfg( [qw(x y z a)], "/0" => "" ), [qw(y z a)], "/0" );
is_deeply( prpadd2cfg( [qw(x y z a)], "/-1" => "" ), [qw(x y z)], "/-1" );
################ Helpers ################
# use DDP;
sub testit( $struct, @delta ) {
# p($struct, as => "before" );
prpadd2cfg( $struct, @delta );
# p($struct, as => "after" );
}
sub struct {
{ a => [ "b", ["c"], { f => "g" } ] }
}
( run in 1.191 second using v1.01-cache-2.11-cpan-65fba6d93b7 )