Make colour export dialog only appear when in multiselect mode

Updates #630
shawnlaffan · Jan 2, 2017 · d2bae1a · d2bae1a
1 parent ecaf53a
commit d2bae1a
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 14 deletions.
diff --git a/lib/Biodiverse/GUI/Tabs/Tab.pm b/lib/Biodiverse/GUI/Tabs/Tab.pm
@@ -969,20 +969,36 @@ sub do_export {
     my %args_hash;
 
     my $selected_format = $args->[1] // '';
-
 
-    # ask whether they want to include colours
-    # TODO: check if colours have actually been changed/selected
+    $args_hash{ export_colours  } 
+       = $self->export_colours_dialog(output_ref => $self->{output_ref});
+
+    $args_hash{ selected_format } = $selected_format;    
+
+
+    Biodiverse::GUI::Export::Run($self->{output_ref}, %args_hash);
+}
+
+
+
+sub export_colours_dialog {
+    # ask whether they want to include colours 
+    my ($self, %args) = @_;
+    my $output_ref = $args{output_ref};
+
+    # check if we are in multiselect mode first
+    if(!($self->{dendrogram}->get_cluster_colour_mode() eq 'multiselect')) {
+        return 0;
+    }
+
+    # TODO: allow choice of colour format for compatibility with other
+    # packages.
     my $response = Biodiverse::GUI::YesNoCancel->run({
         header => "Export colours?",
         hide_cancel => 1,
     });
 
-
-    $args_hash{ export_colours  } = ($response eq 'yes');
-    $args_hash{ selected_format } = $selected_format;    
-
-    Biodiverse::GUI::Export::Run($self->{output_ref}, %args_hash);
+    return $response eq 'yes';
 }
 
 

diff --git a/lib/Biodiverse/TreeNode.pm b/lib/Biodiverse/TreeNode.pm
@@ -1601,6 +1601,7 @@ sub get_colour_string {
 sub to_table {
     my $self = shift;
     my %args = @_;
+    my $export_colours = $args{export_colours};
     my $treename = $args{name} || "TREE";
 
     #  assign unique ID numbers if not already done
@@ -1620,8 +1621,11 @@ sub to_table {
     );  #  may need to specify some other params
 
 
-    my @header = qw /TREENAME NODE_NUMBER PARENTNODE LENGTHTOPARENT NAME COLOUR/;
-
+    my @header = qw /TREENAME NODE_NUMBER PARENTNODE LENGTHTOPARENT NAME/;
+    if( $export_colours ) {
+        push @header, "COLOUR";
+    }
+
 
     my ($parent_num, $taxon_name);
 
@@ -1644,12 +1648,18 @@ sub to_table {
         my $number = $node->get_value ('NODE_NUMBER');
         my %data;
 
-        my $colour = $node->get_colour()->to_string();
+        my $colour = $node->get_colour_string();
 
         #  add to the basestruct object
-        @data{@header} = ($treename, $number, $parent_num, 
-                          $node->get_length || 0, $taxon_name, $colour);
-
+        if( $export_colours ) {
+            @data{@header} = ($treename, $number, $parent_num, 
+                              $node->get_length || 0, $taxon_name, $colour);
+        }
+        else {
+            @data{@header} = ($treename, $number, $parent_num, 
+                              $node->get_length || 0, $taxon_name);
+        }
+
         #  get the additional list data if requested
         if (defined $args{sub_list} && $args{sub_list} !~ /(no list)/) {
             my $sub_list_ref = $node->get_list_ref (list => $args{sub_list});