File Coverage

blib/lib/Audio/Nama/Graphical.pm
Criterion Covered Total %
statement 21 608 3.4
branch 0 152 0.0
condition 0 16 0.0
subroutine 7 96 7.2
pod 0 3 0.0
total 28 875 3.2


line stmt bran cond sub pod time code
1             # ------------ Graphical User Interface ------------
2              
3             package Audio::Nama::Graphical; ## gui routines
4 1     1   5 use Modern::Perl; use Carp;
  1     1   2  
  1         5  
  1         102  
  1         1  
  1         64  
5             our $VERSION = 1.071;
6 1     1   5 use Audio::Nama::Globals qw($text);
  1         1  
  1         77  
7              
8 1     1   5 use Module::Load::Conditional qw(can_load);
  1         11  
  1         49  
9 1     1   5 use Audio::Nama::Assign qw(:all);
  1         2  
  1         197  
10 1     1   5 use Audio::Nama::Util qw(colonize);
  1         3  
  1         56  
11 1     1   5 no warnings 'uninitialized';
  1         2  
  1         12450  
12              
13             our @ISA = 'Audio::Nama'; ## default to root class
14             # widgets
15              
16             ## The following methods belong to the Graphical interface class
17              
18 0     0 0   sub hello {"make a window";}
19             sub loop {
20             package Audio::Nama;
21 0     0 0   $text->{term_attribs}->{already_prompted} = 0;
22 0           $text->{term}->tkRunning(1);
23 0           while (1) {
24 0           my ($user_input) = $text->{term}->readline($prompt) ;
25 0           Audio::Nama::process_line( $user_input );
26             }
27             }
28              
29 0     0 0   sub initialize_tk { can_load( modules => { Tk => undef } ) }
30              
31             # the following graphical methods are placed in the root namespace
32             # allowing access to root namespace variables
33             # with a package path
34              
35             package Audio::Nama;
36             # gui handling
37              
38             # in the $gui variable, keys with leading _underscore
39             # indicate variables
40             #
41             # $gui->{_project_name} # scalar/array/hash var
42             # $gui->{mw} # Tk objects (widgets, frames, etc.)
43              
44             sub init_gui {
45              
46 0     0     logsub("&init_gui");
47              
48 0           init_palettefields(); # keys only
49              
50              
51             ### Tk root window
52              
53             # Tk main window
54 0           $gui->{mw} = MainWindow->new;
55 0           get_saved_colors();
56 0           $gui->{mw}->optionAdd('*font', 'Helvetica 12');
57 0           $gui->{mw}->optionAdd('*BorderWidth' => 1);
58 0           $gui->{mw}->title("Ecasound/Nama");
59 0           $gui->{mw}->deiconify;
60              
61             ### init effect window
62              
63 0           $gui->{ew} = $gui->{mw}->Toplevel;
64 0           $gui->{ew}->title("Effect Window");
65 0           $gui->{ew}->deiconify;
66             # $gui->{ew}->withdraw;
67              
68             ### Exit via Ctrl-C
69              
70 0     0     $gui->{mw}->bind('' => sub { exit } );
  0            
71 0     0     $gui->{ew}->bind('' => sub { exit } );
  0            
72              
73             ## Press SPACE to start/stop transport
74              
75 0           $gui->{mw}->bind('' => \&toggle_transport);
76 0           $gui->{ew}->bind('' => \&toggle_transport);
77            
78 0           $gui->{canvas} = $gui->{ew}->Scrolled('Canvas')->pack;
79             $gui->{canvas}->configure(
80 0           scrollregion =>[2,2,10000,10000],
81             -width => 1200,
82             -height => 700,
83             );
84 0           $gui->{fx_frame} = $gui->{canvas}->Frame;
85             my $id = $gui->{canvas}->createWindow(30,30, -window => $gui->{fx_frame},
86 0           -anchor => 'nw');
87              
88 0           $gui->{project_head} = $gui->{mw}->Label->pack(-fill => 'both');
89              
90             $gui->{time_frame} = $gui->{mw}->Frame(
91             # -borderwidth => 20,
92             # -relief => 'groove',
93 0           )->pack(
94             -side => 'bottom',
95             -fill => 'both',
96             );
97             $gui->{mark_frame} = $gui->{time_frame}->Frame->pack(
98 0           -side => 'bottom',
99             -fill => 'both');
100             $gui->{seek_frame} = $gui->{time_frame}->Frame->pack(
101 0           -side => 'bottom',
102             -fill => 'both');
103 0           $gui->{transport_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
104             # $oid_frame = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
105 0           $gui->{clock_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
106             #$gui->{group_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
107 0           my $track_canvas = $gui->{mw}->Scrolled('Canvas')->pack(-side => 'bottom', -fill => 'both');
108 0           $track_canvas->configure(
109             -scrollregion =>[2,2,400,9600],
110             -width => 400,
111             -height => 400,
112             );
113 0           $gui->{track_frame} = $track_canvas->Frame; # ->pack(-fill => 'both');
114             #$gui->{track_frame} = $gui->{mw}->Frame;
115             my $id2 = $track_canvas->createWindow(0,0,
116             -window => $gui->{track_frame},
117 0           -anchor => 'nw');
118             #$gui->{group_label} = $gui->{group_frame}->Menubutton(-text => "GROUP",
119             # -tearoff => 0,
120             # -width => 13)->pack(-side => 'left');
121            
122 0           $gui->{add_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
123 0           $gui->{perl_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
124 0           $gui->{iam_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
125 0           $gui->{load_frame} = $gui->{mw}->Frame->pack(-side => 'bottom', -fill => 'both');
126             # my $blank = $gui->{mw}->Label->pack(-side => 'left');
127              
128              
129              
130             $gui->{project_label} = $gui->{load_frame}->Label(
131 0           -text => " Project name: "
132             )->pack(-side => 'left');
133             $gui->{project_entry} = $gui->{load_frame}->Entry(
134             -textvariable => \$gui->{_project_name},
135 0           -width => 25
136             )->pack(-side => 'left');
137              
138 0           $gui->{load_project} = $gui->{load_frame}->Button->pack(-side => 'left');;
139 0           $gui->{new_project} = $gui->{load_frame}->Button->pack(-side => 'left');;
140 0           $gui->{quit} = $gui->{load_frame}->Button->pack(-side => 'left');
141 0           $gui->{save_project} = $gui->{load_frame}->Button->pack(-side => 'left');
142             $gui->{savefile_entry} = $gui->{load_frame}->Entry(
143             -textvariable => \$gui->{_save_id},
144 0           -width => 15
145             )->pack(-side => 'left');
146 0           $gui->{load_savefile} = $gui->{load_frame}->Button->pack(-side => 'left');
147 0           $gui->{palette} = $gui->{load_frame}->Menubutton(-tearoff => 0)
148             ->pack( -side => 'left');
149 0           $gui->{nama_palette} = $gui->{load_frame}->Menubutton(-tearoff => 0)
150             ->pack( -side => 'left');
151             $gui->{add_track}->{label} = $gui->{add_frame}->Label(
152 0           -text => "New track name: ")->pack(-side => 'left');
153             $gui->{add_track}->{text_entry} = $gui->{add_frame}->Entry(
154             -textvariable => \$gui->{_track_name},
155 0           -width => 12
156             )->pack(-side => 'left');
157             $gui->{add_track}->{rec_label} = $gui->{add_frame}->Label(
158 0           -text => "Input channel or client:"
159             )->pack(-side => 'left');
160             $gui->{add_track}->{rec_text} = $gui->{add_frame}->Entry(
161             -textvariable => \$gui->{_chr},
162 0           -width => 10
163             )->pack(-side => 'left');
164 0           $gui->{add_track}->{add_mono} = $gui->{add_frame}->Button->pack(-side => 'left');;
165 0           $gui->{add_track}->{add_stereo} = $gui->{add_frame}->Button->pack(-side => 'left');;
166              
167             $gui->{load_project}->configure(
168             -text => 'Load',
169             -command => sub{ load_project(
170 0     0     name => remove_spaces($gui->{_project_name}),
171 0           )});
172             $gui->{new_project}->configure(
173             -text => 'Create',
174             -command => sub{ load_project(
175 0     0     name => remove_spaces($gui->{_project_name}),
176 0           create => 1)});
177             $gui->{save_project}->configure(
178             -text => 'Save settings',
179             -command => #sub { print "save_id: $gui->{_save_id}\n" });
180 0     0     sub {save_state($gui->{_save_id}) });
  0            
181             $gui->{load_savefile}->configure(
182             -text => 'Recall settings',
183             -command => sub {load_project (name => $project->{name}, # current project
184 0     0     settings => $gui->{_save_id})},
185 0           );
186             $gui->{quit}->configure(-text => "Quit",
187             -command => sub {
188 0 0   0     return if transport_running();
189 0           save_state($gui->{_save_id});
190 0           pager("Exiting... \n");
191             #$text->{term}->tkRunning(0);
192             #$gui->{ew}->destroy;
193             #$gui->{mw}->destroy;
194             #Audio::Nama::process_command('quit');
195 0           exit;
196 0           });
197             $gui->{palette}->configure(
198 0           -text => 'Palette',
199             -relief => 'raised',
200             );
201             $gui->{nama_palette}->configure(
202 0           -text => 'Nama palette',
203             -relief => 'raised',
204             );
205              
206 0           my @color_items = map { [ 'command' => $_,
207             -command => colorset('mw', $_ ) ]
208 0           } @{$gui->{_palette_fields}};
  0            
209 0           $gui->{palette}->AddItems( @color_items);
210              
211 0           @color_items = map { [ 'command' => $_,
212             -command => namaset( $_ ) ]
213 0           } @{$gui->{_nama_fields}};
  0            
214              
215             $gui->{add_track}->{add_mono}->configure(
216             -text => 'Add Mono Track',
217             -command => sub {
218 0 0   0     return if $gui->{_track_name} =~ /^\s*$/;
219 0           add_track(remove_spaces($gui->{_track_name})) }
220 0           );
221             $gui->{add_track}->{add_stereo}->configure(
222             -text => 'Add Stereo Track',
223             -command => sub {
224 0 0   0     return if $gui->{_track_name} =~ /^\s*$/;
225 0           add_track(remove_spaces($gui->{_track_name}));
226 0           process_command('stereo');
227 0           });
228              
229 0           my @labels =
230             qw(Track Name Version Status Source Send Volume Mute Unity Pan Center Effects);
231 0           my @widgets;
232 0           map{ push @widgets, $gui->{track_frame}->Label(-text => $_) } @labels;
  0            
233 0           $widgets[0]->grid(@widgets[1..$#widgets]);
234              
235              
236             }
237              
238             sub transport_gui {
239 0     0     my $ui = shift;
240 0           logsub("&transport_gui");
241              
242             $gui->{engine_label} = $gui->{transport_frame}->Label(
243 0           -text => 'TRANSPORT',
244             -width => 12,
245             )->pack(-side => 'left');;
246 0           $gui->{engine_start} = $gui->{transport_frame}->Button->pack(-side => 'left');
247 0           $gui->{engine_stop} = $gui->{transport_frame}->Button->pack(-side => 'left');
248              
249             $gui->{engine_stop}->configure(-text => "Stop",
250             -command => sub {
251 0     0     stop_transport();
252             }
253 0           );
254             $gui->{engine_start}->configure(
255             -text => "Start",
256             -command => sub {
257 0 0   0     return if transport_running();
258 0           my $color = engine_mode_color();
259 0           $ui->project_label_configure(-background => $color);
260 0           start_transport();
261 0           });
262              
263             #preview_button();
264             #mastering_button();
265              
266             }
267             sub time_gui {
268 0     0     my $ui = shift;
269 0           logsub("&time_gui");
270              
271             my $time_label = $gui->{clock_frame}->Label(
272 0           -text => 'TIME',
273             -width => 12);
274             #print "bg: $gui->{_nama_palette}->{ClockBackground}, fg:$gui->{_nama_palette}->{ClockForeground}\n";
275             $gui->{clock} = $gui->{clock_frame}->Label(
276             -text => '0:00',
277             -width => 8,
278             -background => $gui->{_nama_palette}->{ClockBackground},
279             -foreground => $gui->{_nama_palette}->{ClockForeground},
280 0           );
281             my $length_label = $gui->{clock_frame}->Label(
282 0           -text => 'LENGTH',
283             -width => 10,
284             );
285             $gui->{setup_length} = $gui->{clock_frame}->Label(
286             # -width => 8,
287 0           );
288              
289 0           for my $w ($time_label, $gui->{clock}, $length_label, $gui->{setup_length}) {
290 0           $w->pack(-side => 'left');
291             }
292              
293             $gui->{mark_frame} = $gui->{time_frame}->Frame->pack(
294 0           -side => 'bottom',
295             -fill => 'both');
296             $gui->{seek_frame} = $gui->{time_frame}->Frame->pack(
297 0           -side => 'bottom',
298             -fill => 'both');
299             # jump
300              
301 0           my $jump_label = $gui->{seek_frame}->Label(-text => q(JUMP), -width => 12);
302 0           my @pluses = (1, 5, 10, 30, 60);
303 0           my @minuses = map{ - $_ } reverse @pluses;
  0            
304 0           my @fw = map{ my $d = $_; $gui->{seek_frame}->Button(
  0            
305             -text => $d,
306 0     0     -command => sub { jump($d) },
307             )
308 0           } @pluses ;
309 0           my @rew = map{ my $d = $_; $gui->{seek_frame}->Button(
  0            
310             -text => $d,
311 0     0     -command => sub { jump($d) },
312             )
313 0           } @minuses ;
314             my $beg = $gui->{seek_frame}->Button(
315 0           -text => 'Beg',
316             -command => \&to_start,
317             );
318             my $end = $gui->{seek_frame}->Button(
319 0           -text => 'End',
320             -command => \&to_end,
321             );
322              
323             $gui->{seek_unit} = $gui->{seek_frame}->Button(
324 0           -text => 'Sec',
325             );
326 0           for my $w($jump_label, @rew, $beg, $gui->{seek_unit}, $end, @fw){
327 0           $w->pack(-side => 'left')
328             }
329              
330 0     0     $gui->{seek_unit}->configure (-command => sub { &toggle_unit; &show_unit });
  0            
  0            
331              
332             # Marks
333            
334             my $mark_label = $gui->{mark_frame}->Label(
335 0           -text => q(MARK),
336             -width => 12,
337             )->pack(-side => 'left');
338            
339             my $drop_mark = $gui->{mark_frame}->Button(
340 0           -text => 'Place',
341             -command => \&drop_mark,
342             )->pack(-side => 'left');
343            
344             $gui->{mark_remove} = $gui->{mark_frame}->Button(
345 0           -text => 'Remove',
346             -command => \&arm_mark_toggle,
347             )->pack(-side => 'left');
348              
349             }
350             sub toggle_unit {
351 0 0   0     if ($gui->{_seek_unit} == 1){
352 0           $gui->{_seek_unit} = 60;
353            
354 0           } else{ $gui->{_seek_unit} = 1; }
355             }
356             sub show_unit { $gui->{seek_unit}->configure(
357 0 0   0     -text => ($gui->{_seek_unit} == 1 ? 'Sec' : 'Min')
358             )}
359              
360             sub paint_button {
361 0     0     my $ui = shift;
362 0           my ($button, $color) = @_;
363 0           $button->configure(-background => $color,
364             -activebackground => $color);
365             }
366              
367             sub engine_mode_color {
368 0 0   0     if ( user_rec_tracks() ){
    0          
    0          
369             $gui->{_nama_palette}->{RecBackground} # live recording
370 0           } elsif ( Audio::Nama::ChainSetup::really_recording() ){
371             $gui->{_nama_palette}->{Mixdown} # mixdown only
372 0           } elsif ( user_mon_tracks() ){
373 0           $gui->{_nama_palette}->{Play}; # just playback
374 0           } else { $gui->{_old_bg} }
375             }
376 0     0     sub user_rec_tracks { some_user_tracks(REC) }
377 0     0     sub user_mon_tracks { some_user_tracks(PLAY) }
378              
379             sub some_user_tracks {
380 0     0     my $which = shift;
381 0           my @user_tracks = Audio::Nama::audio_tracks();
382 0           splice @user_tracks, 0, 2; # drop Master and Mixdown tracks
383 0 0         return unless @user_tracks;
384 0           my @selected_user_tracks = grep { $_->rec_status eq $which } @user_tracks;
  0            
385 0 0         return unless @selected_user_tracks;
386 0           map{ $_->n } @selected_user_tracks;
  0            
387             }
388              
389             sub flash_ready {
390              
391 0     0     my $color = engine_mode_color();
392 0           logpkg(__FILE__,__LINE__,'debug', "flash color: $color");
393 0           $ui->length_display(-background => $color);
394 0 0         $ui->project_label_configure(-background => $color) unless $mode->{preview};
395 0           $project->{events}->{heartbeat} = AE::timer(5, 0, \&reset_engine_mode_color_display);
396             }
397             sub reset_engine_mode_color_display { $ui->project_label_configure(
398             -background => $gui->{_nama_palette}->{OffBackground} )
399 0     0     }
400 0     0     sub set_engine_mode_color_display { $ui->project_label_configure(-background => engine_mode_color()) }
401             sub group_gui {
402 0     0     my $ui = shift;
403 0           my $group = $bn{Main};
404 0           my $dummy = $gui->{track_frame}->Label(-text => ' ');
405             $gui->{group_label} = $gui->{track_frame}->Label(
406             -text => "G R O U P",
407             -foreground => $gui->{_nama_palette}->{GroupForeground},
408             -background => $gui->{_nama_palette}->{GroupBackground},
409              
410 0           );
411             $gui->{group_version} = $gui->{track_frame}->Menubutton(
412             -text => q( ),
413             -tearoff => 0,
414             -foreground => $gui->{_nama_palette}->{GroupForeground},
415             -background => $gui->{_nama_palette}->{GroupBackground},
416 0           );
417             $gui->{group_rw} = $gui->{track_frame}->Menubutton(
418             -text => $group->rw,
419             -tearoff => 0,
420             -foreground => $gui->{_nama_palette}->{GroupForeground},
421             -background => $gui->{_nama_palette}->{GroupBackground},
422 0           );
423              
424              
425            
426             $gui->{group_rw}->AddItems([
427             'command' => MON,
428             -background => $gui->{_old_bg},
429             -command => sub {
430 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
431 0           $group->set(rw => MON);
432 0           $gui->{group_rw}->configure(-text => MON);
433 0           refresh();
434 0           Audio::Nama::reconfigure_engine()
435             }
436             ],[
437             'command' => OFF,
438             -background => $gui->{_old_bg},
439             -command => sub {
440 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
441 0           $group->set(rw => OFF);
442 0           $gui->{group_rw}->configure(-text => OFF);
443 0           refresh();
444 0           Audio::Nama::reconfigure_engine()
445             }
446 0           ]);
447 0           $dummy->grid($gui->{group_label}, $gui->{group_version}, $gui->{group_rw});
448             #$ui->global_version_buttons;
449              
450             }
451             sub global_version_buttons {
452 0     0     my $version = $gui->{group_version};
453 0 0         $version and map { $_->destroy } $version->children;
  0            
454            
455             logpkg(__FILE__,__LINE__,'debug', "making global version buttons range: " ,
456 0           join ' ',1..$bn{Main}->last);
457              
458             $version->radiobutton(
459              
460             -label => (''),
461             -value => 0,
462             -command => sub {
463 0     0     $bn{Main}->set(version => 0);
464 0           $version->configure(-text => " ");
465 0           Audio::Nama::reconfigure_engine();
466 0           refresh();
467             }
468 0           );
469              
470 0           for my $v (1..$bn{Main}->last) {
471              
472             # the highest version number of all tracks in the
473             # $bn{Main} group
474            
475 0           my @user_track_indices = grep { $_ > 2 } map {$_->n} Audio::Nama::audio_tracks();
  0            
  0            
476            
477 0 0         next unless grep{ grep{ $v == $_ } @{ $ti{$_}->versions } }
  0            
  0            
  0            
478             @user_track_indices;
479            
480              
481             $version->radiobutton(
482              
483             -label => ($v ? $v : ''),
484             -value => $v,
485             -command => sub {
486 0     0     $bn{Main}->set(version => $v);
487 0           $version->configure(-text => $v);
488 0           Audio::Nama::reconfigure_engine();
489 0           refresh();
490             }
491              
492 0 0         );
493             }
494             }
495             sub track_gui {
496 0     0     logsub("&track_gui");
497 0           my $ui = shift;
498 0           my $n = shift;
499             pager("track_gui already generated"), return
500 0 0         if defined $gui->{tracks}->{$n} ;
501 0 0         return if $ti{$n}->hide;
502            
503 0           logpkg(__FILE__,__LINE__,'debug', "found index: $n");
504             my @rw_items = @_ ? @_ : (
505             [ 'command' => "REC",
506             -foreground => 'red',
507             -command => sub {
508 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
509 0           $ti{$n}->set(rw => "REC");
510            
511 0           $ui->refresh_track($n);
512             #refresh_group();
513 0           Audio::Nama::reconfigure_engine();
514             }],
515             [ 'command' => "PLAY",
516             -command => sub {
517 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
518 0           $ti{$n}->set(rw => "PLAY");
519 0           $ui->refresh_track($n);
520             #refresh_group();
521 0           Audio::Nama::reconfigure_engine();
522             }],
523             [ 'command' => "MON",
524             -foreground => 'red',
525             -command => sub {
526 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
527 0           $ti{$n}->set(rw => "MON");
528            
529 0           $ui->refresh_track($n);
530             #refresh_group();
531 0           Audio::Nama::reconfigure_engine();
532             }],
533             [ 'command' => "OFF",
534             -command => sub {
535 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
536 0           $ti{$n}->set(rw => "OFF");
537 0           $ui->refresh_track($n);
538             #refresh_group();
539 0           Audio::Nama::reconfigure_engine();
540 0 0         }],
541             );
542 0           my ($number, $name, $version, $rw, $ch_r, $ch_m, $vol, $mute, $solo, $unity, $pan, $center);
543 0           $number = $gui->{track_frame}->Label(-text => $n,
544             -justify => 'left');
545 0           my $stub = " ";
546 0           $stub .= $ti{$n}->version;
547             $name = $gui->{track_frame}->Label(
548 0           -text => $ti{$n}->name,
549             -justify => 'left');
550             $version = $gui->{track_frame}->Menubutton(
551 0           -text => $stub,
552             # -relief => 'sunken',
553             -tearoff => 0);
554 0           my @versions = '';
555             #push @versions, @{$ti{$n}->versions} if @{$ti{$n}->versions};
556 0           my $ref = ref $ti{$n}->versions ;
557             $ref =~ /ARRAY/ and
558 0 0 0       push (@versions, @{$ti{$n}->versions}) or
  0            
559             croak "chain $n, found unexpectedly $ref\n";;
560 0           my $indicator;
561 0           for my $v (@versions) {
562             $version->radiobutton(
563             -label => $v,
564             -value => $v,
565             -variable => \$indicator,
566             -command =>
567             sub {
568 0     0     $ti{$n}->set( version => $v );
569 0 0         return if $ti{$n}->rec_status eq "REC";
570 0           $version->configure( -text=> $ti{$n}->current_version );
571 0           Audio::Nama::reconfigure_engine();
572             }
573 0           );
574             }
575              
576             $ch_r = $gui->{track_frame}->Menubutton(
577             # -relief => 'groove',
578 0           -tearoff => 0,
579             );
580 0           my @range;
581 0 0         push @range, 1..$config->{soundcard_channels} if $n > 2; # exclude Master/Mixdown
582            
583 0           for my $v (@range) {
584             $ch_r->radiobutton(
585             -label => $v,
586             -value => $v,
587             -command => sub {
588 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
589             # $ti{$n}->set(rw => REC);
590 0           $ti{$n}->source($v);
591 0           $ui->refresh_track($n) }
592             )
593 0           }
594 0           @range = ();
595              
596 0 0         push @range, "off" if $n > 2;
597 0 0         push @range, 1..$config->{soundcard_channels} if $n != 2; # exclude Mixdown
598              
599             $ch_m = $gui->{track_frame}->Menubutton(
600 0           -tearoff => 0,
601             # -relief => 'groove',
602             );
603 0           for my $v (@range) {
604             $ch_m->radiobutton(
605             -label => $v,
606             -value => $v,
607             -command => sub {
608 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
609 0           local $this_track = $ti{$n};
610 0 0         if( $v eq 'off' )
611 0           { process_command('nosend') }
612 0           else { $this_track->set_send($v) }
613 0           $ui->refresh_track($n);
614 0           Audio::Nama::reconfigure_engine();
615             }
616             )
617 0           }
618             $rw = $gui->{track_frame}->Menubutton(
619 0           -text => $ti{$n}->rw,
620             -tearoff => 0,
621             # -relief => 'groove',
622             );
623 0           map{$rw->AddItems($_)} @rw_items;
  0            
624              
625            
626 0           my $p_num = 0; # needed when using parameter controllers
627             # Volume
628            
629 0 0         if ( Audio::Nama::need_vol_pan($ti{$n}->name, "vol") ){
630              
631 0           my $vol_id = $ti{$n}->vol;
632              
633 0           logpkg(__FILE__,__LINE__,'debug', "vol effect_id: $vol_id");
634             my %p = ( parent => \$gui->{track_frame},
635 0           chain => $n,
636             type => 'ea',
637             id => $vol_id,
638             p_num => $p_num,
639             length => 300,
640             );
641              
642              
643 0     0     logpkg(__FILE__,__LINE__,'debug',sub{my %q = %p; delete $q{parent}; print
  0            
  0            
644 0           "=============\n%p\n",json_out(\%q)});
645              
646 0           $vol = make_scale ( \%p );
647             # Mute
648              
649             $mute = $gui->{track_frame}->Button(
650             -command => sub {
651 0     0     my $FX = fxn($vol_id);
652 0 0 0       if ( $FX->params->[0] != $config->{mute_level}->{$FX->type}
653             and $FX->params->[0] != $config->{fade_out_level}->{$FX->type}
654             ) { # non-zero volume
655 0           $ti{$n}->mute;
656 0           $mute->configure(-background => $gui->{_nama_palette}->{Mute});
657             }
658             else {
659 0           $ti{$n}->unmute;
660             $mute->configure(-background => $gui->{_nama_palette}->{OffBackground})
661 0           }
662             }
663 0           );
664              
665             # Unity
666              
667             $unity = $gui->{track_frame}->Button(
668             -command => sub {
669 0     0     my $FX = fxn($vol_id);
670             Audio::Nama::update_effect(
671             $vol_id,
672             0,
673 0           $config->{unity_level}->{$FX->type});
674             }
675 0           );
676             } else {
677              
678 0           $vol = $gui->{track_frame}->Label;
679 0           $mute = $gui->{track_frame}->Label;
680 0           $unity = $gui->{track_frame}->Label;
681              
682             }
683              
684 0 0         if ( Audio::Nama::need_vol_pan($ti{$n}->name, "pan") ){
685            
686             # Pan
687            
688 0           my $pan_id = $ti{$n}->pan;
689            
690 0           logpkg(__FILE__,__LINE__,'debug', "pan effect_id: $pan_id");
691 0           $p_num = 0; # first parameter
692             my %q = ( parent => \$gui->{track_frame},
693 0           chain => $n,
694             type => 'epp',
695             id => $pan_id,
696             p_num => $p_num,
697             );
698             # logpkg(__FILE__,__LINE__,'debug',sub{ my %q = %p; delete $q{parent}; print "x=============\n%p\n",json_out(\%q) });
699 0           $pan = make_scale ( \%q );
700              
701             # Center
702              
703             $center = $gui->{track_frame}->Button(
704             -command => sub {
705 0     0     Audio::Nama::update_effect($pan_id, 0, 50);
706             }
707 0           );
708             } else {
709              
710 0           $pan = $gui->{track_frame}->Label;
711 0           $center = $gui->{track_frame}->Label;
712             }
713            
714 0           my $effects = $gui->{fx_frame}->Frame->pack(-fill => 'both');;
715              
716             # effects, held by track_widget->n->effects is the frame for
717             # all effects of the track
718              
719 0           @{ $gui->{tracks}->{$n} }{qw(name version rw ch_r ch_m mute effects)}
  0            
720             = ($name, $version, $rw, $ch_r, $ch_m, $mute, \$effects);#a ref to the object
721             #logpkg(__FILE__,__LINE__,'debug', "=============$gui->{tracks}\n",sub{json_out($gui->{tracks})});
722             my $independent_effects_frame
723 0           = ${ $gui->{tracks}->{$n}->{effects} }->Frame->pack(-fill => 'x');
  0            
724              
725              
726             my $controllers_frame
727 0           = ${ $gui->{tracks}->{$n}->{effects} }->Frame->pack(-fill => 'x');
  0            
728            
729             # parents are the independent effects
730             # children are controllers for various paramters
731              
732 0           $gui->{tracks}->{$n}->{parents} = $independent_effects_frame;
733              
734 0           $gui->{tracks}->{$n}->{children} = $controllers_frame;
735            
736             $independent_effects_frame
737 0           ->Label(-text => uc $ti{$n}->name )->pack(-side => 'left');
738              
739             #logpkg(__FILE__,__LINE__,'debug',"Number: $n"),MainLoop if $n == 2;
740 0           my @tags = qw( EF P1 P2 L1 L2 L3 L4 );
741             my @starts = ( $fx_cache->{split}->{cop}{a},
742             $fx_cache->{split}->{preset}{a},
743             $fx_cache->{split}->{preset}{b},
744             $fx_cache->{split}->{ladspa}{a},
745             $fx_cache->{split}->{ladspa}{b},
746             $fx_cache->{split}->{ladspa}{c},
747             $fx_cache->{split}->{ladspa}{d},
748 0           );
749             my @ends = ( $fx_cache->{split}->{cop}{z},
750             $fx_cache->{split}->{preset}{b},
751             $fx_cache->{split}->{preset}{z},
752             $fx_cache->{split}->{ladspa}{b}-1,
753             $fx_cache->{split}->{ladspa}{c}-1,
754             $fx_cache->{split}->{ladspa}{d}-1,
755             $fx_cache->{split}->{ladspa}{z},
756 0           );
757 0           my @add_effect;
758              
759 0           map{push @add_effect, effect_button($n, shift @tags, shift @starts, shift @ends)} 1..@tags;
  0            
760            
761 0           $number->grid($name, $version, $rw, $ch_r, $ch_m, $vol, $mute, $unity, $pan, $center, @add_effect);
762              
763             $gui->{tracks_remove}->{$n} = [
764 0           grep{ $_ } (
  0            
765             $number,
766             $name,
767             $version,
768             $rw,
769             $ch_r,
770             $ch_m,
771             $vol,
772             $mute,
773             $unity,
774             $pan,
775             $center,
776             @add_effect,
777             $effects,
778             )
779             ];
780              
781 0           $ui->refresh_track($n);
782              
783             }
784              
785             sub remove_track_gui {
786 0     0     my $ui = shift;
787 0           my $n = shift;
788 0           logsub("&remove_track_gui");
789 0 0         return unless $gui->{tracks_remove}->{$n};
790 0           map {$_->destroy } @{ $gui->{tracks_remove}->{$n} };
  0            
  0            
791 0           delete $gui->{tracks_remove}->{$n};
792 0           delete $gui->{tracks}->{$n};
793             }
794              
795             sub paint_mute_buttons {
796             map{ $gui->{tracks}->{$_}{mute}->configure(
797             -background => $gui->{_nama_palette}->{Mute},
798              
799 0           )} grep { $ti{$_}->old_vol_level}# muted tracks
  0            
800 0     0     map { $_->n } Audio::Nama::audio_tracks(); # track numbers
  0            
801             }
802              
803             sub create_master_and_mix_tracks {
804 0     0     logsub("&create_master_and_mix_tracks");
805              
806              
807             my @rw_items = (
808             [ 'command' => "MON",
809             -command => sub {
810 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
811 0           $tn{Master}->set(rw => "MON");
812 0           $ui->refresh_track($tn{Master}->n);
813             }],
814             [ 'command' => "OFF",
815             -command => sub {
816 0 0   0     return if Audio::Nama::eval_iam("engine-status") eq 'running';
817 0           $tn{Master}->set(rw => "OFF");
818 0           $ui->refresh_track($tn{Master}->n);
819 0           }],
820             );
821              
822 0           $ui->track_gui( $tn{Master}->n, @rw_items );
823              
824 0           $ui->track_gui( $tn{Mixdown}->n);
825              
826             #$ui->group_gui('Main');
827             }
828              
829             sub update_version_button {
830 0     0     my $ui = shift;
831 0           my ($n, $v) = @_;
832 0 0         carp ("no version provided \n") if ! $v;
833 0           my $w = $gui->{tracks}->{$n}->{version};
834             $w->radiobutton(
835             -label => $v,
836             -value => $v,
837             -command =>
838             sub { $gui->{tracks}->{$n}->{version}->configure(-text=>$v)
839 0 0   0     unless $ti{$n}->rec_status eq "REC" }
840 0           );
841             }
842              
843             sub add_effect_gui {
844 0     0     logsub("&add_effect_gui");
845 0           my $ui = shift;
846 0           my %p = %{shift()};
  0            
847             my ($n,$code,$id,$parent,$parameter) =
848 0           @p{qw(chain type id parent parameter)};
849 0           my $i = $fx_cache->{full_label_to_index}->{$code};
850 0           my $FX = fxn($id);
851              
852 0     0     logpkg(__FILE__,__LINE__,'debug', sub{json_out(\%p)});
  0            
853              
854 0           logpkg(__FILE__,__LINE__,'debug', "id: $id, parent: $parent");
855             # $id is determined by effect_init, which will return the
856             # existing id if supplied
857              
858             # check display format, may be 'scale' 'field' or 'hidden'
859            
860 0           my $display_type = $FX->display; # individual setting
861 0 0         defined $display_type or $display_type = $fx_cache->{registry}->[$i]->{display}; # template
862 0           logpkg(__FILE__,__LINE__,'debug', "display type: $display_type");
863              
864 0 0         return if $display_type eq q(hidden);
865              
866 0           my $frame ;
867 0 0         if ( ! $parent ){ # independent effect
868             $frame = $gui->{tracks}->{$n}->{parents}->Frame->pack(
869 0           -side => 'left',
870             -anchor => 'nw',)
871             } else { # controller
872             $frame = $gui->{tracks}->{$n}->{children}->Frame->pack(
873 0           -side => 'top',
874             -anchor => 'nw')
875             }
876              
877 0           $gui->{fx}->{$id} = $frame;
878             # we need a separate frame so title can be long
879              
880             # here add menu items for Add Controller, and Remove
881              
882             my $parentage = $fx_cache->{registry}->[
883             $fx_cache->{full_label_to_index}->{$FX->type}
884 0           ]->{name};
885 0 0         $parentage and $parentage .= " - ";
886 0           logpkg(__FILE__,__LINE__,'debug', "parentage: $parentage");
887             my $eff = $frame->Menubutton(
888 0           -text => $parentage. $fx_cache->{registry}->[$i]->{name}, -tearoff => 0,);
889              
890             $eff->AddItems([
891             'command' => "Remove",
892 0     0     -command => sub { remove_effect($id) }
893 0           ]);
894 0           $eff->grid();
895 0           my @labels;
896             my @sliders;
897              
898             # make widgets
899              
900 0           for my $p (0..$fx_cache->{registry}->[$i]->{count} - 1 ) {
901 0           my @items;
902             #logpkg(__FILE__,__LINE__,'debug', "p_first: $p_first, p_last: $p_last");
903 0           for my $j ($fx_cache->{split}->{ctrl}{a}..$fx_cache->{split}->{ctrl}{z}) {
904             push @items,
905             [ 'command' => $fx_cache->{registry}->[$j]->{name},
906             -command => sub { add_effect({
907             parent => $id,
908             chain => $n,
909             params => [ $p + 1 ],
910 0     0     type => $fx_cache->{registry}->[$j]->{code} }) }
911 0           ];
912              
913             }
914             push @labels, $frame->Menubutton(
915             -text => $fx_cache->{registry}->[$i]->{params}->[$p]->{name},
916 0           -menuitems => [@items],
917             -tearoff => 0,
918             );
919             logpkg(__FILE__,__LINE__,'debug', "parameter name: ",
920 0           $fx_cache->{registry}->[$i]->{params}->[$p]->{name});
921 0           my $v = # for argument vector
922             { parent => \$frame,
923             id => $id,
924             p_num => $p,
925             };
926 0           push @sliders,make_scale($v);
927             }
928              
929 0 0         if (@sliders) {
930              
931 0           $sliders[0]->grid(@sliders[1..$#sliders]);
932 0           $labels[0]->grid(@labels[1..$#labels]);
933             }
934             }
935              
936              
937             sub project_label_configure{
938 0     0     my $ui = shift;
939 0           $gui->{project_head}->configure( @_ ) }
940              
941             sub length_display{
942 0     0     my $ui = shift;
943 0           $gui->{setup_length}->configure(@_)};
944              
945             sub clock_config {
946 0     0     my $ui = shift;
947 0           $gui->{clock}->configure( @_ )}
948              
949 0     0     sub manifest { $gui->{ew}->deiconify() }
950              
951             sub destroy_widgets {
952              
953 0     0     map{ $_->destroy } map{ $_->children } $gui->{fx_frame};
  0            
  0            
954             #my @children = $gui->{group_frame}->children;
955             #map{ $_->destroy } @children[1..$#children];
956 0           my @children = $gui->{track_frame}->children;
957             # leave field labels (first row)
958 0           map{ $_->destroy } @children[11..$#children]; # fragile
  0            
959 0 0         %{$gui->{marks}} and map{ $_->destroy } values %{$gui->{marks}};
  0            
  0            
  0            
960             }
961             sub remove_effect_gui {
962 0     0     my $ui = shift;
963 0           logsub("&remove_effect_gui");
964 0           my $id = shift;
965 0           my $FX = fxn($id);
966 0           my $n = $FX->chain;
967 0           logpkg(__FILE__,__LINE__,'debug', "id: $id, chain: $n");
968              
969 0           logpkg(__FILE__,__LINE__,'debug', "i have widgets for these ids: ", join " ",keys %{$gui->{fx}});
  0            
970 0           logpkg(__FILE__,__LINE__,'debug', "preparing to destroy: $id");
971 0 0         return unless defined $gui->{fx}->{$id};
972 0           $gui->{fx}->{$id}->destroy();
973 0           delete $gui->{fx}->{$id};
974              
975             }
976              
977             sub effect_button {
978 0     0     logsub("&effect_button");
979 0           my ($n, $label, $start, $end) = @_;
980 0           logpkg(__FILE__,__LINE__,'debug', "chain $n label $label start $start end $end");
981 0           my @items;
982             my $widget;
983 0           my @indices = ($start..$end);
984 0 0 0       if ($start >= $fx_cache->{split}->{ladspa}{a} and $start <= $fx_cache->{split}->{ladspa}{z}){
985 0           @indices = ();
986 0           @indices = @{$fx_cache->{ladspa_sorted}}[$start..$end];
  0            
987 0           logpkg(__FILE__,__LINE__,'debug', "length sorted indices list: ",scalar @indices );
988 0           logpkg(__FILE__,__LINE__,'debug', "Indices: @indices");
989             }
990            
991 0           for my $j (@indices) {
992             push @items,
993             [ 'command' => "$fx_cache->{registry}->[$j]->{count} $fx_cache->{registry}->[$j]->{name}" ,
994             -command => sub {
995 0     0     add_effect( {chain => $n, type => $fx_cache->{registry}->[$j]->{code} } );
996 0           $gui->{ew}->deiconify; # display effects window
997             }
998 0           ];
999             }
1000             $widget = $gui->{track_frame}->Menubutton(
1001 0           -text => $label,
1002             -tearoff =>0,
1003             # -relief => 'raised',
1004             -menuitems => [@items],
1005             );
1006 0           $widget;
1007             }
1008              
1009             sub make_scale {
1010            
1011 0     0     logsub("&make_scale");
1012 0           my $ref = shift;
1013 0           my %p = %{$ref};
  0            
1014             # %p contains following:
1015             # id => operator id
1016             # parent => parent widget, i.e. the frame
1017             # p_num => parameter number, starting at 0
1018             # length => length widget # optional
1019 0           my $id = $p{id};
1020 0           my $FX = fxn($id);
1021 0           my $n = $FX->chain;
1022 0           my $code = $FX->type;
1023 0           my $p = $p{p_num};
1024 0           my $i = $fx_cache->{full_label_to_index}->{$code};
1025              
1026 0           logpkg(__FILE__,__LINE__,'debug', "id: $id code: $code");
1027            
1028              
1029             # check display format, may be text-field or hidden,
1030              
1031 0           logpkg(__FILE__,__LINE__,'debug',"i: $i code: $fx_cache->{registry}->[$i]->{code} display: $fx_cache->{registry}->[$i]->{display}");
1032 0           my $display_type = $FX->display;
1033 0 0         defined $display_type or $display_type = $fx_cache->{registry}->[$i]->{display};
1034 0           logpkg(__FILE__,__LINE__,'debug', "display type: $display_type");
1035 0 0         return if $display_type eq q(hidden);
1036              
1037              
1038 0           logpkg(__FILE__,__LINE__,'debug', "to: ", $fx_cache->{registry}->[$i]->{params}->[$p]->{end}) ;
1039 0           logpkg(__FILE__,__LINE__,'debug', "p: $p code: $code");
1040 0           logpkg(__FILE__,__LINE__,'debug', "is_log_scale: ".is_log_scale($i,$p));
1041              
1042             # set display type to individually specified value if it exists
1043             # otherwise to the default for the controller class
1044              
1045              
1046            
1047 0 0         if ($display_type eq q(scale) ) {
    0          
1048              
1049             # return scale type controller widgets
1050 0           my $frame = ${ $p{parent} }->Frame;
  0            
1051            
1052              
1053             #return ${ $p{parent} }->Scale(
1054            
1055 0           my $log_display;
1056            
1057             my $controller = $frame->Scale(
1058             -variable => \$FX->{params}->[$p],
1059             -orient => 'horizontal',
1060             -from => $fx_cache->{registry}->[$i]->{params}->[$p]->{begin},
1061             -to => $fx_cache->{registry}->[$i]->{params}->[$p]->{end},
1062             -resolution => resolution($i, $p),
1063             -width => 12,
1064             -length => $p{length} ? $p{length} : 100,
1065 0     0     -command => sub { Audio::Nama::_update_effect($id, $p, $FX->params->[$p]) },
1066 0 0         -state => $FX->is_read_only($p) ? 'disabled' : 'normal',
    0          
1067             );
1068              
1069             # auxiliary field for logarithmic display
1070 0 0         if ( is_log_scale($i, $p) )
1071             # or $code eq 'ea')
1072             {
1073             my $log_display = $frame->Label(
1074             -text => exp $fx_cache->{registry}->[$i]->{params}->[$p]->{default},
1075 0           -width => 5,
1076             );
1077             $controller->configure(
1078             -variable => \$FX->{params_log}->[$p],
1079             -command => sub {
1080 0     0     $FX->params->[$p] = exp $FX->params_log->[$p];
1081 0           Audio::Nama::_update_effect($id, $p, $FX->params->[$p]);
1082             $log_display->configure(
1083             -text =>
1084 0 0         $fx_cache->{registry}->[$i]->{params}->[$p]->{name} =~ /hz|frequency/i
1085             ? int $FX->params->[$p]
1086             : dn($FX->params->[$p], 1)
1087             );
1088             }
1089 0           );
1090 0           $log_display->grid($controller);
1091             }
1092 0           else { $controller->grid; }
1093              
1094 0           return $frame;
1095              
1096             }
1097              
1098             elsif ($display_type eq q(field) ){
1099              
1100             # then return field type controller widget
1101              
1102 0           return ${ $p{parent} }->Entry(
  0            
1103             -textvariable =>\$FX->params->[$p],
1104             -width => 6,
1105             # -command => sub { Audio::Nama::_update_effect($id, $p, $FX->params->[$p]) },
1106             # doesn't work with Entry widget
1107             );
1108              
1109             }
1110 0           else { croak "missing or unexpected display type: $display_type" }
1111              
1112             }
1113              
1114             sub is_log_scale {
1115 0     0     my ($i, $p) = @_;
1116 0           $fx_cache->{registry}->[$i]->{params}->[$p]->{hint} =~ /logarithm/
1117             }
1118             sub resolution {
1119 0     0     my ($i, $p) = @_;
1120 0           my $res = $fx_cache->{registry}->[$i]->{params}->[$p]->{resolution};
1121 0 0         return $res if $res;
1122 0           my $end = $fx_cache->{registry}->[$i]->{params}->[$p]->{end};
1123 0           my $beg = $fx_cache->{registry}->[$i]->{params}->[$p]->{begin};
1124 0 0         return 1 if abs($end - $beg) > 30;
1125 0           return abs($end - $beg)/100
1126             }
1127              
1128             sub arm_mark_toggle {
1129 0 0   0     if ($gui->{_markers_armed}) {
1130 0           $gui->{_markers_armed} = 0;
1131 0           $gui->{mark_remove}->configure( -background => $gui->{_nama_palette}->{OffBackground});
1132             } else{
1133 0           $gui->{_markers_armed} = 1;
1134 0           $gui->{mark_remove}->configure( -background => $gui->{_nama_palette}->{MarkArmed});
1135             }
1136             }
1137             sub marker {
1138 0     0     my $ui = shift;
1139 0           my $mark = shift; # Mark
1140 0           logpkg(__FILE__,__LINE__,'debug',"mark is ", ref $mark);
1141 0           my $pos = $mark->time;
1142 0           logpkg(__FILE__,__LINE__,'debug',$pos, " ", int $pos);
1143             $gui->{marks}->{$pos} = $gui->{mark_frame}->Button(
1144             -text => (join " ", colonize( int $pos ), $mark->name),
1145             -background => $gui->{_nama_palette}->{OffBackground},
1146 0     0     -command => sub { Audio::Nama::mark($mark) },
1147 0           )->pack(-side => 'left');
1148             }
1149              
1150             sub restore_time_marks {
1151 0     0     my $ui = shift;
1152 0           map{ $ui->marker($_) } Audio::Nama::Mark::all() ;
  0            
1153 0 0         $gui->{seek_unit}->configure( -text => $gui->{_seek_unit} == 1 ? q(Sec) : q(Min) )
1154             }
1155             sub destroy_marker {
1156 0     0     my $ui = shift;
1157 0           my $pos = shift;
1158 0           $gui->{marks}->{$pos}->destroy;
1159             }
1160              
1161              
1162             sub get_saved_colors {
1163 0     0     logsub("&get_saved_colors");
1164              
1165             # aliases
1166            
1167 0           $gui->{_old_bg} = $gui->{_palette}{mw}{background};
1168 0           $gui->{_old_abg} = $gui->{_palette}{mw}{activeBackground};
1169 0   0       $gui->{_old_bg} //= '#d915cc1bc3cf';
1170             #print "pb: $gui->{_palette}{mw}{background}\n";
1171              
1172              
1173 0           my $pal = $file->gui_palette;
1174 0 0         $pal .= '.json' unless $pal =~ /\.json$/;
1175 0           pager("pal $pal");
1176 0 0         $pal = -f $pal
1177             ? scalar read_file($pal)
1178             : get_data_section('default_palette_json');
1179 0           my $ref = decode($pal, 'json');
1180             #say "palette file",json_out($ref);
1181              
1182 0           assign_singletons({ data => $ref });
1183            
1184 0           $gui->{_old_abg} = $gui->{_palette}->{mw}{activeBackground};
1185 0 0         $gui->{_old_abg} = $gui->{project_head}->cget('-activebackground') unless $gui->{_old_abg};
1186             #print "1palette: \n", json_out( $gui->{_palette} );
1187             #print "\n1namapalette: \n", json_out($gui->{_nama_palette});
1188 0           my %setformat;
1189 0 0         map{ $setformat{$_} = $gui->{_palette}->{mw}{$_} if $gui->{_palette}->{mw}{$_} }
1190 0           keys %{$gui->{_palette}->{mw}};
  0            
1191             #print "\nsetformat: \n", json_out(\%setformat);
1192 0           $gui->{mw}->setPalette( %setformat );
1193             }
1194             sub colorset {
1195 0     0     my ($widgetid, $field) = @_;
1196             sub {
1197 0     0     my $widget = $gui->{$widgetid};
1198             #print "ancestor: $widgetid\n";
1199 0           my $new_color = colorchooser($field,$widget->cget("-$field"));
1200 0 0         if( defined $new_color ){
1201            
1202             # install color in palette listing
1203 0           $gui->{_palette}->{$widgetid}{$field} = $new_color;
1204              
1205             # set the color
1206 0           my @fields = ($field => $new_color);
1207 0 0         push (@fields, 'background', $widget->cget('-background'))
1208             unless $field eq 'background';
1209             #print "fields: @fields\n";
1210 0           $widget->setPalette( @fields );
1211             }
1212 0           };
1213             }
1214              
1215             sub namaset {
1216 0     0     my ($field) = @_;
1217             sub {
1218             #print "f: $field np: $gui->{_nama_palette}->{$field}\n";
1219 0     0     my $color = colorchooser($field,$gui->{_nama_palette}->{$field});
1220 0 0         if ($color){
1221             # install color in palette listing
1222 0           $gui->{_nama_palette}->{$field} = $color;
1223              
1224             # set those objects who are not
1225             # handled by refresh
1226 0           *rec = \$gui->{_nama_palette}->{RecBackground};
1227 0           *mon = \$gui->{_nama_palette}->{MonBackground};
1228 0           *off = \$gui->{_nama_palette}->{OffBackground};
1229              
1230             $gui->{clock}->configure(
1231             -background => $gui->{_nama_palette}->{ClockBackground},
1232             -foreground => $gui->{_nama_palette}->{ClockForeground},
1233 0           );
1234             $gui->{group_label}->configure(
1235             -background => $gui->{_nama_palette}->{GroupBackground},
1236             -foreground => $gui->{_nama_palette}->{GroupForeground},
1237 0           );
1238 0           refresh();
1239             }
1240             }
1241              
1242 0           }
1243              
1244             sub colorchooser {
1245 0     0     logsub("&colorchooser");
1246 0           my ($field, $initialcolor) = @_;
1247 0           logpkg(__FILE__,__LINE__,'debug', "field: $field, initial color: $initialcolor");
1248             my $new_color = $gui->{mw}->chooseColor(
1249 0           -title => $field,
1250             -initialcolor => $initialcolor,
1251             );
1252             #print "new color: $new_color\n";
1253 0           $new_color;
1254             }
1255             sub init_palettefields {
1256 0     0     @{$gui->{_palette_fields}} = qw[
  0            
1257             foreground
1258             background
1259             activeForeground
1260             activeBackground
1261             selectForeground
1262             selectBackground
1263             selectColor
1264             highlightColor
1265             highlightBackground
1266             disabledForeground
1267             insertBackground
1268             troughColor
1269             ];
1270              
1271 0           @{$gui->{_nama_fields}} = qw [
  0            
1272             RecForeground
1273             RecBackground
1274             MonForeground
1275             MonBackground
1276             OffForeground
1277             OffBackground
1278             ClockForeground
1279             ClockBackground
1280             Capture
1281             Play
1282             Mixdown
1283             GroupForeground
1284             GroupBackground
1285             SendForeground
1286             SendBackground
1287             SourceForeground
1288             SourceBackground
1289             Mute
1290             MarkArmed
1291             ];
1292             }
1293              
1294             sub save_palette {
1295 0     0     serialize (
1296             file => $file->gui_palette,
1297             format => 'json',
1298             vars => [ qw( $gui->{_palette} $gui->{_nama_palette} ) ],
1299             class => 'Audio::Nama')
1300             }
1301              
1302             ### end
1303              
1304              
1305              
1306             ## refresh functions
1307              
1308             sub set_widget_color {
1309 0     0     my ($widget, $status) = @_;
1310             my %rw_foreground = ( REC => $gui->{_nama_palette}->{RecForeground},
1311             PLAY => $gui->{_nama_palette}->{MonForeground},
1312             MON => $gui->{_nama_palette}->{MonForeground},
1313             OFF => $gui->{_nama_palette}->{OffForeground},
1314 0           );
1315              
1316             my %rw_background = ( REC => $gui->{_nama_palette}->{RecBackground},
1317             PLAY => $gui->{_nama_palette}->{MonBackground},
1318             MON => $gui->{_nama_palette}->{MonBackground},
1319 0           OFF => $gui->{_nama_palette}->{OffBackground});
1320              
1321 0           $widget->configure( -background => $rw_background{$status} );
1322 0           $widget->configure( -foreground => $rw_foreground{$status} );
1323             }
1324             sub refresh_group {
1325             # main group, in this case we want to skip null group
1326 0     0     logsub("&refresh_group");
1327            
1328            
1329 0           my $status;
1330 0 0         if ( grep{ $_->rec_status eq REC}
  0 0          
1331 0           map{ $tn{$_} }
1332             $bn{Main}->tracks ){
1333              
1334 0           $status = REC
1335              
1336 0           }elsif( grep{ $_->rec_status eq PLAY}
1337 0           map{ $tn{$_} }
1338             $bn{Main}->tracks ){
1339              
1340 0           $status = PLAY
1341              
1342             }else{
1343            
1344 0           $status = OFF }
1345              
1346 0           logit(__LINE__,'Audio::Nama::Refresh','debug', "group status: $status");
1347              
1348 0           set_widget_color($gui->{group_rw}, $status);
1349              
1350              
1351              
1352 0 0         croak "some crazy status |$status|\n" if $status !~ m/rec|mon|off/i;
1353             #logit(__LINE__,'Audio::Nama::Refresh','debug', "attempting to set $status color: ", $take_color{$status});
1354              
1355 0 0         set_widget_color( $gui->{group_rw}, $status) if $gui->{group_rw};
1356             }
1357             sub refresh_track {
1358            
1359 0     0     my $ui = shift;
1360 0           my $n = shift;
1361 0           logsub("&refresh_track");
1362            
1363 0           my $rec_status = $ti{$n}->rec_status;
1364 0           logit(__LINE__,'Audio::Nama::Refresh','debug', "track: $n rec_status: $rec_status");
1365              
1366 0 0         return unless $gui->{tracks}->{$n}; # hidden track
1367            
1368             # set the text for displayed fields
1369              
1370 0           $gui->{tracks}->{$n}->{rw}->configure(-text => $rec_status);
1371             $gui->{tracks}->{$n}->{ch_r}->configure( -text =>
1372             $n > 2
1373 0 0         ? $ti{$n}->source
1374             : q() );
1375 0           $gui->{tracks}->{$n}->{ch_m}->configure( -text => $ti{$n}->send);
1376 0   0       $gui->{tracks}->{$n}->{version}->configure(-text => $ti{$n}->current_version || "");
1377            
1378 0           map{ set_widget_color( $gui->{tracks}->{$n}->{$_},
  0            
1379             $rec_status)
1380             } qw(name rw );
1381            
1382             set_widget_color( $gui->{tracks}->{$n}->{ch_r},
1383            
1384 0 0 0       ($rec_status eq REC
1385             and $n > 2 )
1386             ? REC
1387             : OFF);
1388            
1389             set_widget_color( $gui->{tracks}->{$n}->{ch_m},
1390             $rec_status eq OFF
1391             ? OFF
1392 0 0         : $ti{$n}->send
    0          
1393             ? MON
1394             : OFF);
1395             }
1396              
1397             sub refresh {
1398 0     0     Audio::Nama::remove_riff_header_stubs();
1399             #$ui->refresh_group();
1400             #map{ $ui->refresh_track($_) } map{$_->n} grep{! $_->hide} Audio::Nama::audio_tracks();
1401             #map{ $ui->refresh_track($_) } grep{$remove_track_widget{$_} map{$_->n} Audio::Nama::audio_tracks();
1402 0           map{ $ui->refresh_track($_) } map{$_->n} Audio::Nama::audio_tracks();
  0            
  0            
1403             }
1404             ### end
1405              
1406              
1407             1;
1408              
1409             __END__