view release on metacpan or  search on metacpan

lib/ChordPro/Wx/Config.pm  view on Meta::CPAN

#! perl

use v5.26;
use Object::Pad;

class ChordPro::Wx::Config;

our %state;
our %preferences;

use Ref::Util qw( is_hashref is_arrayref );
use List::Util qw( uniq any first );

use Exporter 'import';
our @EXPORT = qw( %state %preferences );

my $cb;

use Wx qw(:everything);
use Wx::Locale gettext => '_T';
use ChordPro::Files;
use ChordPro::Paths;
use ChordPro::Utils qw( plural json_load is_true );

use constant FONTSIZE => 12;
use constant SETTINGS_VERSION => 3;

use Encode qw( decode_utf8 );

# Legacy font numbers.
my @fonts =
  ( # Monospace
    Wx::Font->new( FONTSIZE, wxFONTFAMILY_TELETYPE,
		   wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL ),
    # Serif
    Wx::Font->new( FONTSIZE, wxFONTFAMILY_ROMAN,
		   wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL ),

    # Sans serif
    Wx::Font->new( FONTSIZE, wxFONTFAMILY_SWISS,
		   wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL ),
    # Modern
    Wx::Font->new( FONTSIZE, wxFONTFAMILY_MODERN,
		   wxFONTSTYLE_NORMAL, wxFONTWEIGHT_NORMAL ),
  );

my %prefs =
  (
   # (Old) config version.
   settings_version => SETTINGS_VERSION - 1,

   # Skip default (system, user, song) configs.
   skipstdcfg  => 1,
   # Skip legacy (un-classified) configs.
   skipoldcfg  => 0,

   # Presets.
   # Title as defined by or derived from the JSON file.
   # When multiple presets are possible, a list of titles separated by TABs
   # (which are imported as a []).
   # Note it is always a [] even when there's only one.
   # Every preset_xxx is a list of entries from $state{preset}{xxx}.
   preset_instruments => [],	# single
   preset_styles      => [],	# single
   preset_stylemods   => [],
   preset_notations   => [],	# single
   preset_tasks       => [],	# not used

   # This one is slightly different, since it does not have configs associated.
   preset_xcodes      => [],	# single

   # Custom config file.
   enable_configfile => 0,
   configfile        => "",

   # Custom library.
   enable_customlib => 0,	# defined($ENV{CHORDPRO_LIB}),
   customlib        => "",	# $ENV{CHORDPRO_LIB},

   # New song template.
   enable_tmplfile => 0,
   tmplfile        => "",

   # Editor.
   editfont	   => 0,	# inital, later "Monospace 10" etc.
   editsize	   => FONTSIZE,
   editortheme	   => "auto",

   # Mostly for STC. TextCtrl fallback uses fg and bg only.
   editcolour_light_fg	   => "#000000",
   editcolour_light_bg	   => "#ffffff",
   editcolour_light_s1	   => "#b1b1b1",
   editcolour_light_s2	   => "#b1b1b1",
   editcolour_light_s3	   => "#b1b1b1",
   editcolour_light_s4	   => "#ff3c31",
   editcolour_light_s5	   => "#0068d0",
   editcolour_light_s6	   => "#ef6c2a",
   editcolour_light_annfg  => "#ff0000",
   editcolour_light_annbg  => "#ffffa0",
   editcolour_light_numfg  => "#303030",
   editcolour_light_numbg  => "#e8e8e8",
   editcolour_dark_fg	   => "#ffffff",
   editcolour_dark_bg	   => "#000000",
   editcolour_dark_s1	   => "#b1b1b1",
   editcolour_dark_s2	   => "#b1b1b1",
   editcolour_dark_s3	   => "#b1b1b1",
   editcolour_dark_s4	   => "#ff3c31",

lib/ChordPro/Wx/Config.pm  view on Meta::CPAN

    if ( $options->{config} ) {
	Wx::ConfigBase::Set
	    ( $cb = Wx::FileConfig->new
	     ( "WxChordPro",
	       "ChordPro_ORG",
	       $options->{config},
	       '',
	       wxCONFIG_USE_LOCAL_FILE,
	     ));
    }
    elsif ( $^O =~ /^mswin/i ) {
	$cb = Wx::ConfigBase::Get;
	$config_root = "/wxchordpro";
	$cb->SetPath($config_root);
    }
    else {
	my $file;
	if ( $ENV{XDG_CONFIG_HOME} && fs_test( d => $ENV{XDG_CONFIG_HOME} ) ) {
	    $file =
	      $ENV{XDG_CONFIG_HOME} . "/wxchordpro/wxchordpro";
	}
	elsif ( -d "$ENV{HOME}/.config" ) {
	    $file = "$ENV{HOME}/.config/wxchordpro/wxchordpro";
	    mkdir("$ENV{HOME}/.config/wxchordpro");
	}
	else {
	    $file = "$ENV{HOME}/.wxchordpro";
	}
	unless ( fs_test( f => $file ) ) {
	    my $fd = fs_open( $file, '>' );
	}
	Wx::ConfigBase::Set
	    ( $cb = Wx::FileConfig->new
	     ( "WxChordPro",
	       "ChordPro_ORG",
	       $file,
	       '',
	       wxCONFIG_USE_LOCAL_FILE,
	     ));
    }

    unless ( $cb->Exists("preferences") ) { # new
	$cb->Write("/preferences/settings_version", SETTINGS_VERSION );
    }
}

method Ok :common {
    $preferences{settings_version} == SETTINGS_VERSION;
}
method SetOk :common {
    $preferences{settings_version} = SETTINGS_VERSION;
}

# Load all data from the persistent data store into %state.
# Adds information collected from the environment (e.g. config files).
# Try to compensate for incompatibilities (legacy).

method Load :common {
    use Hash::Util qw( lock_keys unlock_keys );
    unlock_keys(%preferences);
    %preferences = ( %prefs );
    while ( my ( $k, $v ) = each %prefs ) {
	next unless $k =~ /^(editcolour)_(\w+)_(\w+)/;
	$preferences{$1}{$2}{$3} = $v;
    }
    while ( my ( $k, $v ) = each %preferences ) {
	delete $preferences{$k} if $k =~ /^(editcolour)_/;
    }
    %state = ( preferences => \%preferences,
	       recents => [],
	     );

    $cb->SetPath($config_root);
    my ( $ggoon, $group, $gindex ) = $cb->GetFirstGroup;
    my %pp = $ggoon ? %prefs : ();
    while ( $ggoon ) {
	my $cp = $cb->GetPath;
	$cb->SetPath($group);

	$state{$group} = [] if $group eq "recents";

	my ( $goon, $entry, $index ) = $cb->GetFirstEntry;
	while ( $goon ) {
	    my $value = $cb->Read($entry);
	    # printf STDERR ( "$group.$entry:\t%s\n", $value );
	    if ( $group eq "preferences" ) {
		my $o;
		if ( exists $pp{$entry} ) {
		    $o = delete $pp{$entry};
		}
		else {
		    warn("Preferences: unknown key: $entry");
		    $cb->DeleteEntry($entry);
		    next;
		}

		# These are always returned as lists of hashes.
		if ( $entry =~ m/^preset_(instruments|styles|stylemods|notations|tasks|xcodes)/ ) {
		    $preferences{$entry} =
		      [ map { +{ title => lc($_) } } split( /\t+/, $value ) ];
		}

		elsif ( $entry eq "editcolours" ) {
		    my @c = split( /,\s*/, $value );
		    if ( @c <= 1 ) {
			...;
		    }
		    else {
			$preferences{editcolour}{light}{fg} = $c[0];
			$preferences{editcolour}{light}{bg} = $c[1];
			$preferences{editcolour}{light}{s1} = $c[2];
			$preferences{editcolour}{light}{s2} = $c[3];
			$preferences{editcolour}{light}{s3} = $c[4];
			$preferences{editcolour}{light}{s4} = $c[5];
			$preferences{editcolour}{light}{s5} = $c[6];
			$preferences{editcolour}{light}{annbg} = $c[7];
			$preferences{editcolour}{light}{annfg} = "#ff0000";
			$preferences{editcolour}{light}{numbg} =
			  $preferences{editcolour}{dark}{numfg} = "#e8e8e8";
			$preferences{editcolour}{light}{numfg} =
			  $preferences{editcolour}{dark}{numbg} = "#303030";
		    }
		}
		elsif ( $entry =~ /^(editcolour)_(\w+)_(\w+)$/ ) {
		    $cb->DeleteEntry($entry), next if $2 eq "auto";
		    $preferences{$1}{$2}{$3} = $value;
		}
		else {
		    $preferences{$entry} = $value;
		}
	    }
	    elsif ( $group eq "recents" ) {
		push( @{$state{$group}}, $value )
		  if fs_test( 's', $value );
	    }