OpenCores
URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [perl_gui/] [lib/] [perl/] [widget2.pl] - Blame information for rev 48

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 48 alirezamon
use constant::boolean;
2
#use Gtk2 '-init';
3
use strict;
4
use warnings;
5
 
6
use Data::Dumper;
7
use Gtk2::SourceView2;
8
use Consts;
9
 
10
require "common.pl";
11
 
12
use FindBin;
13
use lib $FindBin::Bin;
14
use IO::CaptureOutput qw(capture qxx qxy);
15
 
16
use ColorButton;
17
use HexSpin2;
18
 
19
 
20
use Gtk2::Pango;
21
#use Tk::Animation;
22
 
23
our $FONT_SIZE;
24
our $ICON_SIZE;
25
 
26
##############
27
# combo box
28
#############
29
sub gen_combo{
30
        my ($combo_list, $combo_active_pos)= @_;
31
        my $combo = Gtk2::ComboBox->new_text;
32
 
33
        combo_set_names($combo,$combo_list);
34
        $combo->set_active($combo_active_pos) if(defined $combo_active_pos);
35
 
36
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
37
        #$combo->modify_font($font);
38
 
39
 
40
        return $combo;
41
}
42
 
43
 
44
sub combo_set_names {
45
        my ( $combo, $list_ref ) = @_;
46
        my @list=@{$list_ref};
47
        #print "$list[0]\n";
48
        for my $item (@list){$combo->append_text($item);}
49
}
50
 
51
 
52
sub gen_combo_help {
53
        my ($help, @combo_list, $pos)= @_;
54
        my $box = def_hbox(FALSE, 0);
55
        my $combo= gen_combo(@combo_list, $pos);
56
        my $button=def_image_button("icons/help.png");
57
 
58
        $button->signal_connect("clicked" => sub {message_dialog($help);});
59
 
60
        $box->pack_start( $combo, FALSE, FALSE, 3);
61
        $box->pack_start( $button, FALSE, FALSE, 3);
62
        $box->show_all;
63
 
64
        return ($box,$combo);
65
}
66
 
67
 
68
sub def_h_labeled_combo{
69
                my ($label_name,$combo_list,$combo_active_pos)=@_;
70
                my $box = def_hbox(TRUE,0);
71
                my $label= gen_label_in_left($label_name);
72
                my $combo= gen_combo($combo_list, $combo_active_pos);
73
                $box->pack_start( $label, FALSE, FALSE, 3);
74
                $box->pack_start( $combo, FALSE, TRUE, 3);
75
                return ($box,$combo);
76
}
77
 
78
sub def_h_labeled_combo_scaled{
79
                my ($label_name,$combo_list,$combo_active_pos,$label_w,$comb_w)=@_;
80
                my $table= def_table(1,3,TRUE);
81
                my $label= gen_label_in_left($label_name);
82
                my $combo= gen_combo($combo_list, $combo_active_pos);
83
                $table->attach_defaults ($label, 0, $label_w, 0, 1);
84
                $table->attach_defaults ($combo, 1, $label_w+$comb_w, 0, 1);
85
                return ($table,$combo);
86
}
87
 
88
 
89
sub gen_combo_model{
90
        my $ref=shift;
91
        my %inputs=%{$ref};
92
        my $store = Gtk2::TreeStore->new('Glib::String');
93
         for my $i (sort { $a cmp $b} keys %inputs ) {
94
                my $iter = $store->append(undef);
95
 
96
                $store->set($iter, 0, $i);
97
                for my $capital (sort { $a cmp $b} keys %{$inputs{$i}}) {
98
                        my $iter2 = $store->append($iter);
99
                        $store->set($iter2, 0, $capital);
100
                }
101
        }
102
        return $store;
103
 
104
}
105
 
106
sub gen_tree_combo{
107
        my $model=shift;
108
        my $combo = Gtk2::ComboBox->new_with_model($model);
109
        my $renderer = Gtk2::CellRendererText->new();
110
        $combo->pack_start($renderer, TRUE);
111
        $combo->set_attributes($renderer, "text", 0);
112
        $combo->set_cell_data_func($renderer, \&is_capital_sensitive);
113
        return $combo;
114
 
115
}
116
 
117
 
118
sub TreePath_new_from_indices {
119
         my @indices =@_;
120
         my $path = Gtk2::TreePath->new_from_indices(@indices);
121
         return $path;
122
 
123
}
124
 
125
 
126
##############
127
# spin button
128
#############
129
sub gen_spin{
130
        my ($min,$max,$step,$digit)= @_;
131
 
132
        return Gtk2::SpinButton->new_with_range ($min, $max, $step);
133
         if(!defined $digit){
134
                my $d1 = get_float_precision($min);
135
                my $d2 = get_float_precision($max);
136
                my $d3 = get_float_precision($step);
137
                $digit = ($d1 >$d2)? $d1 : $d2;
138
                $digit = $d3 if($d3>$digit);
139
        }
140
        print "($min,$max,$step,$digit)\n";
141
        return Gtk2::SpinButton->new_with_range ($min, $max, $step) if($digit ==0);
142
    return gen_spin_float($min,$max,$step,$digit);
143
}
144
 
145
sub get_float_precision{
146
        my $num=shift;
147
        my $digit = length(($num =~ /\.(.*)/)[0]);
148
        $digit=0 if(!defined $digit);
149
        return $digit;
150
}
151
 
152
sub gen_spin_float{
153
        my ($min,$max,$step,$digit)= @_;
154
        #$page_inc = ($max - $min)/ 
155
        my $adj = Gtk2::Adjustment->new (0, $min, $max, $step,3.1, 0);
156
        my $spinner = Gtk2::SpinButton->new ($adj, 1.0,$digit);
157
        return $spinner;
158
}
159
 
160
 
161
sub gen_spin_help {
162
        my ($help, $min,$max,$step,$digit)= @_;
163
        my $box = def_hbox(FALSE, 0);
164
        my $spin= gen_spin($min,$max,$step,$digit);
165
        my $button=def_image_button("icons/help.png");
166
 
167
        $button->signal_connect("clicked" => sub {message_dialog($help);});
168
 
169
        $box->pack_start( $spin, FALSE, FALSE, 3);
170
        $box->pack_start( $button, FALSE, FALSE, 3);
171
        $box->show_all;
172
 
173
        return ($box,$spin);
174
}
175
 
176
 
177
#############
178
#  entry
179
#############
180
sub gen_entry{
181
        my ($initial) = @_;
182
        my $entry = Gtk2::Entry->new;
183
        if(defined $initial){ $entry->set_text($initial)};
184
        return $entry;
185
}
186
 
187
 
188
sub gen_entry_new_with_max_length{
189
        my ($n,$initial) = @_;
190
        my $entry = Gtk2::Entry->new_with_max_length ($n);
191
        if(defined $initial){ $entry->set_text($initial)};
192
        return $entry;
193
}
194
 
195
 
196
 
197
sub gen_entry_help{
198
        my ($help, $init)= @_;
199
        my $box = def_hbox(FALSE, 0);
200
        my $entry= gen_entry ($init);
201
        my $button=def_image_button("icons/help.png");
202
 
203
        $button->signal_connect("clicked" => sub {message_dialog($help);});
204
 
205
        $box->pack_start( $entry, FALSE, FALSE, 3);
206
        $box->pack_start( $button, FALSE, FALSE, 3);
207
        $box->show_all;
208
 
209
        return ($box,$entry);
210
}
211
 
212
sub def_h_labeled_entry{
213
        my ($label_name,$initial)=@_;
214
        my $box = def_hbox(TRUE,0);
215
        my $label= gen_label_in_left($label_name);
216
        my $entry =gen_entry($initial);
217
        $box->pack_start( $label, FALSE, FALSE, 3);
218
        $box->pack_start( $entry, FALSE, FALSE, 3);
219
        return ($box,$entry);
220
 
221
}
222
 
223
sub def_h_labeled_entry_help{
224
        my ($help,$label_name,$initial)=@_;
225
        my $box = def_hbox(TRUE,0);
226
        my $label= gen_label_in_left($label_name);
227
        my ($b,$entry) =gen_entry_help($help,$initial);
228
        $box->pack_start( $label, FALSE, FALSE, 3);
229
        $box->pack_start( $b, FALSE, FALSE, 3);
230
        return ($box,$entry);
231
 
232
}
233
 
234
 
235
##############
236
# ComboBoxEntry
237
##############
238
 
239
sub gen_combo_entry{
240
        my ($list_ref,$pos)=@_;
241
        my @list=@{$list_ref};
242
 
243
        my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
244
        foreach my $p (@list){
245
                $combo_box_entry->append_text($p);
246
        }
247
        $pos=0 if(! defined $pos );
248
        $combo_box_entry->set_active($pos);
249
        return $combo_box_entry;
250
}
251
 
252
 
253
sub combo_entry_get_chiled{
254
        my $combentry =shift;
255
        return  $combentry->child;
256
}
257
 
258
 
259
 
260
 
261
sub update_combo_entry_content {
262
        my ($self,$content,$pos)=@_;
263
        my @combo_list=split(/\s*,\s*/,$content) if(defined $content);
264
        foreach my $p (@combo_list){
265
                $self->append_text($p);
266
        }
267
        $pos=0 if(! defined $pos );
268
        $self->set_active($pos);
269
}
270
 
271
###########
272
# checkbutton
273
###########
274
 
275
sub def_h_labeled_checkbutton{
276
        my ($label_name)=@_;
277
        my $box = def_hbox(TRUE,0);
278
        my $label= gen_label_in_left($label_name) if (defined $label_name);
279
        my $check= Gtk2::CheckButton->new;
280
        #if($status==1) $check->
281
        $box->pack_start( $label, FALSE, FALSE, 3) if (defined $label_name);
282
        $box->pack_start( $check, FALSE, FALSE, 3);
283
        return ($box,$check);
284
 
285
}
286
 
287
sub gen_checkbutton{
288
        my $label=shift;
289
        return Gtk2::CheckButton->new($label) if (defined $label);
290
        return Gtk2::CheckButton->new;
291
}
292
 
293
 
294
#############
295
#  label
296
############
297
 
298
sub gen_label_in_left{
299
        my ($data)=@_;
300
        my $label   = Gtk2::Label->new($data);
301
        $label->set_alignment( 0, 0.5 );
302
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
303
        #$label->modify_font($font);
304
        return $label;
305
}
306
 
307
 
308
sub gen_label_in_center{
309
        my ($data)=@_;
310
        my $label   = Gtk2::Label->new($data);
311
        return $label;
312
}
313
 
314
sub def_label{
315
        my @data=@_;
316
        my $label   = Gtk2::Label->new(@data);
317
        $label->set_alignment( 0, 0.5 );
318
        return $label;
319
 
320
}
321
 
322
 
323
sub box_label{
324
        my( $homogeneous, $spacing, $name)=@_;
325
        my $box=def_hbox($homogeneous, $spacing);
326
        my $label= def_label($name);
327
        $box->pack_start( $label, FALSE, FALSE, 3);
328
        return $box;
329
}
330
 
331
 
332
sub def_title_box{
333
        my( $homogeneous, $spacing, @labels)=@_;
334
        my $box=def_hbox($homogeneous, $spacing);
335
        foreach my $label (@labels){
336
                my $labelbox=box_label($homogeneous, $spacing, $label);
337
                $box->pack_start( $labelbox, FALSE, FALSE, 3);
338
        }
339
        return $box;
340
}
341
 
342
 
343
sub gen_label_help {
344
        my ($help, $label_name)= @_;
345
        my $box = def_hbox(FALSE, 0);
346
        my $label= gen_label_in_left($label_name);
347
        my $button=def_image_button("icons/help.png");
348
        $button->signal_connect("clicked" => sub {message_dialog($help);});
349
        $box->pack_start( $label, FALSE, FALSE, 0);
350
        $box->pack_start( $button, FALSE, FALSE, 0);
351
        $box->set_spacing (0);
352
        $box->show_all;
353
        return $box;
354
}
355
 
356
sub gen_label_with_mnemonic {
357
        my $name=shift;
358
        Gtk2::Label->new_with_mnemonic($name);
359
 
360
}
361
 
362
##############
363
# button
364
#############
365
 
366
sub button_box{
367
# create a new button
368
        my $label=@_;
369
        my $button = Gtk2::Button->new_from_stock($label);
370
        my $box=def_hbox(TRUE,5);
371
        $box->pack_start($button,   FALSE, FALSE,0);
372
 
373
        return ($box,$button);
374
 
375
}
376
 
377
 
378
sub get_icon_pixbuff{
379
    my $icon_file=shift;
380
        my $size;
381
    if ($ICON_SIZE eq 'default'){
382
                my $font_size=get_defualt_font_size();
383
                $size=($font_size *2.5);
384
    }else{
385
        $size = int ($ICON_SIZE);
386
    }
387
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($icon_file,$size,$size,FALSE);
388
        return $pixbuf;
389
}
390
 
391
 
392
 
393
sub def_icon{
394
        my $icon_file=shift;
395
        return Gtk2::Image->new_from_pixbuf(get_icon_pixbuff($icon_file));
396
}
397
 
398
sub call_gtk_drag_finish{
399
        my ($context,$a,$b,$time)=@_;
400
        $context->finish (0, 0, $time);
401
}
402
 
403
 
404
 
405
sub add_drag_dest_set{
406
        my ($widget,$a,$b,$c) = @_;
407
        #Create a target table to receive drops
408
        my @target_table = (
409
        {'target' => $a,       'flags' => $b, 'info' => $c  },
410
        );
411
        $widget->drag_dest_set('all', ['copy'], @target_table);
412
}
413
 
414
sub add_drag_source {
415
        my ($widget,$a,$b,$c) = @_;
416
        $widget->drag_source_set (
417
                                ['button1_mask', 'button3_mask'],
418
                                ['copy'],
419
                                {
420
                                    'target' => $a,
421
                                    'flags' => $b,
422
                                    'info' => $c,
423
                                },
424
                        );
425
}
426
 
427
sub drag_set_icon_pixbuf {
428
        my ($icon_view,$icon_pixbuf)=@_;
429
        $icon_view->drag_source_set_icon_pixbuf ($icon_pixbuf);
430
}
431
 
432
sub gen_iconview {
433
        my ($tree_model,$marc_col,$pix_con)=@_;
434
        my $icon_view = Gtk2::IconView->new_with_model($tree_model);
435
    $icon_view->set_markup_column($marc_col);
436
    $icon_view->set_pixbuf_column($pix_con);
437
        return $icon_view;
438
}
439
 
440
 
441
sub add_frame_to_image{
442
        my $image=shift;
443
        my $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
444
        my $frame = Gtk2::Frame->new;
445
        $frame->set_shadow_type ('in');
446
        # Animation
447
        $frame->add ($image);
448
        $align->add ($frame);
449
        return $align;
450
}
451
 
452
sub gen_frame {
453
        return  Gtk2::Frame->new;
454
}
455
 
456
 
457
 
458
sub new_image_from_file{
459
        return  Gtk2::Image->new_from_file (@_);
460
}
461
 
462
 
463
sub gen_pixbuf{
464
        my $file=shift;
465
        return Gtk2::Gdk::Pixbuf->new_from_file($file);
466
}
467
 
468
sub open_image{
469
        my ($image_file,$x,$y,$unit)=@_;
470
        if(defined $unit){
471
                my($width,$hight)=max_win_size();
472
                if($unit eq 'percent'){
473
                        $x= ($x * $width)/100;
474
                        $y= ($y * $hight)/100;
475
                } # else its pixels
476
 
477
        }
478
        $image_file ="icons/blank.png"  unless(-f $image_file);
479
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$x,$y,TRUE);
480
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
481
        return $image;
482
}
483
 
484
sub open_inline_image{
485
        my ($image_string,$x,$y,$unit)=@_;
486
        if(defined $unit){
487
                my($width,$hight)=max_win_size();
488
                if($unit eq 'percent'){
489
                        $x= ($x * $width)/100;
490
                        $y= ($y * $hight)/100;
491
                } # else its pixels
492
 
493
        }
494
        my $pixbuf = do {
495
        my $loader = Gtk2::Gdk::PixbufLoader->new();
496
        $loader->set_size(  $x,$y ) if (defined $y);
497
        $loader->write(  $image_string );
498
        $loader->close();
499
        $loader->get_pixbuf();
500
    };
501
 
502
 
503
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
504
 
505
        return $image;
506
}
507
 
508
sub find_icon{
509
        my $file =shift;
510
        return $file if(-f $file); #called from perl_gui
511
        return "../../$file"; #called from lib/perl             
512
}
513
 
514
sub def_image_button{
515
        my ($image_file, $label_text, $homogeneous, $mnemonic)=@_;
516
        # create box for image and label 
517
        $homogeneous = FALSE if(!defined $homogeneous);
518
        my $box = def_hbox($homogeneous,0);
519
        my $image;
520
        $image_file = find_icon( $image_file);
521
        $image = def_icon($image_file) if(-f $image_file);
522
 
523
        # now on to the image stuff
524
        #my $image = Gtk2::Image->new_from_file($image_file);
525
        $box->pack_start($image, FALSE, FALSE, 0) if(defined  $image);
526
        $box->set_border_width(0);
527
        $box->set_spacing (0);
528
        # Create a label for the button
529
        if(defined $label_text ) {
530
                my $label;
531
                $label = Gtk2::Label->new("  $label_text") unless (defined $mnemonic);
532
                $label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
533
                $box->pack_start($label, FALSE, FALSE, 0);
534
        }
535
 
536
        my $button = Gtk2::Button->new();
537
        $button->add($box);
538
        $button->set_border_width(0);
539
        $button->show_all;
540
        return $button;
541
}
542
 
543
sub def_button{
544
        my ($label_text)=@_;
545
        my $label = Gtk2::Label->new("$label_text") if (defined $label_text);
546
        my $button= Gtk2::Button->new();
547
        $button->add($label) if (defined $label_text);
548
        return $button;
549
}
550
 
551
 
552
sub def_image_label{
553
        my ($image_file, $label_text,$mnemonic)=@_;
554
        # create box for image and label 
555
        my $box = def_hbox(FALSE,1);
556
        # now on to the image stuff
557
        my $image = def_icon($image_file);
558
        $box->pack_start($image, TRUE, FALSE, 0);
559
        # Create a label for the button
560
        if(defined $label_text ) {
561
                my $label;
562
                $label = Gtk2::Label->new("  $label_text") unless (defined $mnemonic);
563
                $label = Gtk2::Label->new_with_mnemonic (" $label_text") if (defined $mnemonic);
564
                $box->pack_start($label, TRUE, FALSE, 0);
565
        }
566
 
567
        return $box;
568
 
569
}
570
 
571
 
572
sub gen_button_message {
573
        my ($help, $image_file,$label_name)= @_;
574
        my $box = def_hbox(FALSE, 0);
575
        my $label= gen_label_in_center($label_name) if(defined $label_name);
576
        my $button=def_image_button($image_file);
577
 
578
        if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
579
 
580
        $box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
581
        $box->pack_start( $button, FALSE, FALSE, 0);
582
        $box->set_border_width(0);
583
        $box->set_spacing (0);
584
        $box->show_all;
585
 
586
        return $box;
587
 
588
 
589
}
590
 
591
 
592
sub def_colored_button{
593
        my ($label_text,$color_num)=@_;
594
        # create box for image and label 
595
        my $box = def_hbox(FALSE,0);
596
        my $font_size=get_defualt_font_size();
597
 
598
        my ($red,$green,$blue) = get_color($color_num);
599
        my $button = ColorButton->new (red => $red, green => $green, blue => $blue, label=>"$label_text");
600
 
601
        $button->set_border_width(0);
602
        $button->show_all;
603
        return $button;
604
}
605
 
606
 
607
 
608
 
609
 
610
sub entry_set_text_color {
611
        my ($entry,$color_num)=@_;
612
        my ($red,$green,$blue) = get_color($color_num);
613
        my $color = Gtk2::Gdk::Color->new ($red,$green,$blue);
614
        $entry->modify_text('normal' , $color);
615
}
616
 
617
 
618
 
619
 
620
 
621
 
622
 
623
 
624
sub show_gif{
625
        my $gif = shift;
626
        $gif=find_icon( $gif);
627
        my $vbox = Gtk2::HBox->new (TRUE, 8);
628
    my $filename;
629
      eval {
630
          $filename = main::demo_find_file ($gif);
631
      };
632
    my $image = Gtk2::Image->new_from_file ($gif);
633
    $vbox->set_border_width (4);
634
    my   $align = Gtk2::Alignment->new (0.5, 0.5, 0, 0);
635
        my $frame = Gtk2::Frame->new;
636
        $frame->set_shadow_type ('in');
637
    # Animation
638
    $frame->add ($image);
639
    $align->add ($frame);
640
        $vbox->pack_start ($align, FALSE, FALSE, 0);
641
        return $vbox;
642
}
643
 
644
sub gen_radiobutton {
645
        my ($from,$label,$icon,$tip) =@_;
646
        my $rbtn = (defined $from )? Gtk2::RadioToolButton->new_from_widget($from) : Gtk2::RadioToolButton->new (undef);
647
        $rbtn->set_label ($label) if(defined $label);
648
        $rbtn->set_icon_widget (def_icon($icon)) if(defined $icon);
649
        set_tip($rbtn, $tip) if(defined $tip);
650
        return $rbtn;
651
}
652
 
653
sub gen_colored_label{
654
        my ($label_text, $color_num)=@_;
655
 
656
        my $color_hex = get_color_hex_string($color_num);
657
        my $label   = Gtk2::Label->new($label_text);
658
        $label->set_markup("<span
659
 background= '#$color_hex'
660
 foreground= 'black' ><b>$label_text</b></span>");
661
 
662
        return $label;
663
}
664
 
665
 
666
############
667
#       message_dialog
668
############
669
 
670
sub message_dialog {
671
  my ($message,$type)=@_;
672
  $type = 'info' if (!defined $type);
673
  my $window;
674
  my $dialog = Gtk2::MessageDialog->new ($window,
675
                                   [qw/modal destroy-with-parent/],
676
                                   $type,
677
                                   'ok',
678
                                    $message);
679
  $dialog->run;
680
  $dialog->destroy;
681
 
682
}
683
 
684
 
685
 
686
sub set_tip{
687
        my ($widget,$tip)=@_;
688
        my $tooltips = Gtk2::Tooltips->new;
689
        $tooltips->set_tip($widget,$tip);
690
 
691
 
692
}
693
 
694
 
695
sub yes_no_dialog {
696
        my ($message)=@_;
697
        my $dialog = Gtk2::MessageDialog->new (my $window,
698
                        'destroy-with-parent',
699
                        'question', # message type
700
                        'yes-no', # which set of buttons?
701
                        "$message");
702
        my $response = $dialog->run;
703
        $dialog->destroy;
704
        return $response;
705
}
706
 
707
sub create_dialog {
708
        my ($message_head,$message_body,$icon,@buttons)=@_;
709
        # create a new dialog with some buttons - one stock, one not.
710
        my %hash1;
711
        my %hash2;
712
        my $i=0;
713
        foreach my $b (@buttons){
714
                $hash1{$b}=$i;
715
                $hash2{$i}=$b;
716
                $i++;
717
        }
718
 
719
        my $dialog = Gtk2::Dialog->new (
720
                " ",
721
                Gtk2::Window->new('toplevel'),
722
                [qw/modal destroy-with-parent/],
723
        %hash1
724
    );
725
        my $content = $dialog->get_content_area ();
726
 
727
        my $table = def_table(1,3,TRUE);
728
        $table->attach  (def_icon($icon) , 0, 1,  0, 2,'expand','expand',2,2) if(defined $icon);
729
        if(defined $message_head){
730
                my $hd=gen_label_in_left($message_head);
731
                $hd->set_markup("<span  foreground= 'black' ><b>$message_head</b></span>");
732
                $table->attach  ($hd , 1, 10,  0, 1,'fill','shrink',2,2);
733
        }
734
        if(defined $message_head){
735
                $table->attach  (gen_label_in_left($message_body) , 2, 10,  1, 2,'fill','shrink',2,2);
736
        }
737
 
738
        $content->add ($table);
739
        $content->show_all;
740
 
741
        $dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning                
742
        my $response = $dialog->run;
743
 
744
        $dialog->destroy;
745
        return $hash2{$response};
746
}
747
 
748
 
749
 
750
############
751
# window
752
###########
753
 
754
sub def_win {
755
        my @titel=shift;
756
        my $window = Gtk2::Window->new('toplevel');
757
        $window->set_title(@titel);
758
        $window->set_position("center");
759
        $window->set_default_size(100, 100);
760
        $window->set_border_width(20);
761
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
762
        return $window;
763
 
764
}
765
 
766
 
767
sub def_win_size {
768
        my $x=shift;
769
        my $y=shift;
770
        my @titel=shift;
771
        my $window = Gtk2::Window->new('toplevel');
772
        $window->set_title(@titel);
773
        $window->set_position("center");
774
        $window->set_default_size($x, $y);
775
        $window->set_border_width(20);
776
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
777
        return $window;
778
 
779
}
780
 
781
 
782
sub def_popwin_size {
783
        my ($x,$y,$titel,$unit)=@_;
784
        if(defined $unit){
785
                my($width,$hight)=max_win_size();
786
                if($unit eq 'percent'){
787
                        $x= ($x * $width)/100;
788
                        $y= ($y * $hight)/100;
789
                } # else its pixels
790
 
791
        }
792
        #my $window = Gtk2::Window->new('popup');
793
        my $window = Gtk2::Window->new('toplevel');
794
        $window->set_title($titel);
795
        $window->set_position("center");
796
        $window->set_default_size($x, $y);
797
        $window->set_border_width(20);
798
        #$window->signal_connect (delete_event => sub { $window->destroy });
799
        return $window;
800
 
801
}
802
 
803
 
804
 
805
 
806
 
807
sub def_scrolled_window_box{
808
 
809
        my $window =  def_popwin_size(@_);
810
        my $box=def_vbox(TRUE,5);
811
        my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
812
        $scrolled_window->set_policy( "automatic", "automatic" );
813
        $scrolled_window->add_with_viewport($box);
814
        $window->add($scrolled_window);
815
        $window->show_all;
816
        $box->show_all;
817
        return ($box,$window);
818
 
819
}
820
 
821
 
822
 
823
 
824
 
825
 
826
sub max_win_size{
827
        my $screen =Gtk2::Gdk::Screen->get_default();
828
        my $hight = $screen->get_height();
829
        my $width = $screen->get_width();
830
        return ($width,$hight);
831
}
832
 
833
 
834
sub get_defualt_font_size{
835
        return int($FONT_SIZE) if ($FONT_SIZE ne 'default');
836
 
837
        my($width,$hight)=max_win_size();
838
        #print "($width,$hight)\n";
839
        my $font_size=($width>=1600)? 10:
840
                              ($width>=1400)? 9:
841
                                  ($width>=1200)? 9:
842
                                  ($width>=1000)? 7:6;
843
        #print "$font_size\n";  
844
        return $font_size;
845
}
846
 
847
 
848
sub set_defualt_font_size{
849
        my $font_size=get_defualt_font_size();
850
           #$font_size= int (1.5*$font_size);
851
                Gtk2::Rc->parse_string(<<__);
852
                        style "normal" {
853
                                font_name ="Verdana $font_size"
854
                        }
855
                        widget "*" style "normal"
856
__
857
 
858
}
859
 
860
 
861
 
862
sub add_widget_to_scrolled_win{
863
        my ($widget,$scrolled_win) =@_;
864
        if(! defined $scrolled_win){
865
                $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
866
                $scrolled_win->set_policy( "automatic", "automatic" );
867
        }
868
        $scrolled_win->add_with_viewport($widget) if(defined $widget);
869
        #$scrolled_win->set_shadow_type('in');
870
        #$scrolled_win->show_all;       
871
        return $scrolled_win;
872
}
873
 
874
sub gen_scr_win_with_adjst {
875
        my ($self,$name)=@_;
876
        my $scrolled_win = new Gtk2::ScrolledWindow (undef, undef);
877
        $scrolled_win->set_policy( "automatic", "automatic" );
878
        $scrolled_win->signal_connect("destroy"=> sub{
879
                save_scrolled_win_adj($self,$scrolled_win, $name);
880
 
881
         });
882
         my $adjast=0;
883
         $scrolled_win->signal_connect("size-allocate"=> sub{
884
                if($adjast==0){
885
                        load_scrolled_win_adj($self,$scrolled_win, $name);
886
                        $adjast=1;
887
                }
888
 
889
         });
890
        return $scrolled_win;
891
}
892
 
893
 
894
sub save_scrolled_win_adj {
895
        my ($self,$scrolled_win,$name)=@_;
896
        my $ha= $scrolled_win->get_hadjustment();
897
    my $va =$scrolled_win->get_vadjustment();
898
    return if(!defined $ha);
899
    return if(!defined $va);
900
    save_adj ($self,$ha,$name,"ha");
901
        save_adj ($self,$va,$name,"va");
902
}
903
 
904
 
905
sub load_scrolled_win_adj {
906
        my ($self,$scrolled_win,$name)=@_;
907
        my $ha= $scrolled_win->get_hadjustment();
908
    my $va =$scrolled_win->get_vadjustment();
909
        my $h=load_adj ($self,$ha,$name,"ha");
910
        my $v=load_adj ($self,$va,$name,"va");
911
        #$ha->set_value($h) if(defined $h);
912
    #$va->set_value($v) if(defined $v);    
913
}
914
 
915
 
916
 
917
 
918
sub save_adj {
919
        my ($self,$adjustment,$at1,$at2)=@_;
920
        my $value = $adjustment->value;
921
        $self->object_add_attribute($at1,$at2,$value);
922
}
923
 
924
 
925
sub load_adj {
926
        my ($self,$adjustment,$at1,$at2)=@_;
927
        return if(!defined $at1);
928
    my $value=  $self->object_get_attribute($at1,$at2);
929
    return if(!defined $value);
930
    my $lower =  $adjustment->lower;
931
    my $upper = $adjustment->upper - $adjustment->page_size;
932
    $value=  ($value < $lower || $value > $upper ) ? 0 : $value;
933
 
934
    $adjustment->set_value($value);
935
}
936
 
937
sub set_pronoc_icon{
938
        my $window=shift;
939
    my $navIco = gen_pixbuf("./icons/ProNoC.png");
940
        $window->set_default_icon($navIco);
941
}
942
 
943
##############
944
#       box
945
#############
946
 
947
sub def_hbox {
948
        my( $homogeneous, $spacing)=@_;
949
        my $box = Gtk2::HBox->new($homogeneous, $spacing);
950
        $box->set_border_width(2);
951
        return $box;
952
}
953
 
954
sub def_vbox {
955
        my $box = Gtk2::VBox->new(FALSE, 0);
956
        $box->set_border_width(2);
957
        return $box;
958
}
959
 
960
sub def_pack_hbox{
961
        my( $homogeneous, $spacing , @box_list)=@_;
962
        my $box=def_hbox($homogeneous, $spacing);
963
        foreach my $subbox (@box_list){
964
                $box->pack_start( $subbox, FALSE, FALSE, 3);
965
        }
966
        return $box;
967
 
968
 
969
}
970
 
971
sub def_pack_vbox{
972
        my( $homogeneous, $spacing , @box_list)=@_;
973
        my $box=def_vbox($homogeneous, $spacing);
974
        foreach my $subbox (@box_list){
975
                $box->pack_start( $subbox, FALSE, FALSE, 3);
976
        }
977
        return $box;
978
 
979
}
980
 
981
 
982
##########
983
# Paned
984
#########
985
 
986
 
987
sub gen_vpaned {
988
        my ($w1,$loc,$w2) = @_;
989
        my $vpaned = Gtk2::VPaned -> new;
990
        my($width,$hight)=max_win_size();
991
 
992
        $vpaned -> pack1($w1, TRUE, TRUE);
993
        $vpaned -> set_position ($hight*$loc);
994
        $vpaned -> pack2($w2, TRUE, TRUE);
995
 
996
        return $vpaned;
997
}
998
 
999
 
1000
sub gen_hpaned {
1001
        my ($w1,$loc,$w2) = @_;
1002
        my $hpaned = Gtk2::HPaned -> new;
1003
        my($width,$hight)=max_win_size();
1004
 
1005
 
1006
        $hpaned -> pack1($w1, TRUE, TRUE);
1007
        $hpaned -> set_position ($width*$loc);
1008
        $hpaned -> pack2($w2, TRUE, TRUE);
1009
 
1010
        return $hpaned;
1011
}
1012
 
1013
sub gen_hpaned_adj {
1014
        my ($self,$w1,$loc,$w2,$name) = @_;
1015
        my $hpaned = Gtk2::HPaned -> new;
1016
        $hpaned -> pack1($w1, TRUE, TRUE);
1017
        $hpaned -> pack2($w2, TRUE, TRUE);
1018
 
1019
        $hpaned->signal_connect("destroy"=> sub{
1020
                my $adj = $hpaned->get_position ();
1021
                $self->object_add_attribute("adj",$name,$adj);
1022
         });
1023
 
1024
        my $val =$self->object_get_attribute("adj",$name);
1025
        if(defined $val){
1026
                $hpaned -> set_position ($val);
1027
        } else{
1028
                my($width,$hight)=max_win_size();
1029
                $hpaned -> set_position ($width*$loc);
1030
        }
1031
 
1032
        return $hpaned;
1033
}
1034
 
1035
 
1036
#############
1037
# text_view 
1038
############
1039
 
1040
sub create_txview {
1041
  my $scrolled_window = Gtk2::ScrolledWindow->new;
1042
  $scrolled_window->set_policy ('automatic', 'automatic');
1043
  $scrolled_window->set_shadow_type ('in');
1044
  my $tview = Gtk2::TextView->new();
1045
  $scrolled_window->add ($tview);
1046
  $tview->show_all;
1047
  # Make it a bit nicer for text.
1048
  $tview->set_wrap_mode ('word');
1049
  $tview->set_pixels_above_lines (2);
1050
  $tview->set_pixels_below_lines (2);
1051
  # $scrolled_window->set_placement('bottom_left' );
1052
  add_colors_to_textview($tview);
1053
 
1054
  return ($scrolled_window,$tview);
1055
}
1056
 
1057
 
1058
sub txview_scrol_to_end {
1059
  my $tview =shift;
1060
  my $buffer =  $tview->get_buffer;
1061
  my $end_mark = $buffer->create_mark( 'end', $buffer->get_end_iter, 0 );
1062
  $tview->scroll_to_mark( $end_mark, 0.0,0, 0.0, 1.0 );
1063
}
1064
 
1065
 
1066
 
1067
#################
1068
#       table
1069
################
1070
 
1071
sub def_table{
1072
        my ($row,$col,$homogeneous)=@_;
1073
        my $table = Gtk2::Table->new ($row, $col, $homogeneous);
1074
        $table->set_row_spacings (0);
1075
        $table->set_col_spacings (0);
1076
        return $table;
1077
 
1078
}
1079
 
1080
sub attach_widget_to_table {
1081
        my ($table,$row,$label,$inf_bt,$widget,$column)=@_;
1082
        $column = 0 if(!defined $column);
1083
        #$column *=4;
1084
        #my $tmp=gen_label_in_left(" "); 
1085
        if(defined $label)  {$table->attach  ($label , $column, $column+1,  $row,$row+1,'fill','shrink',2,2);$column++;}
1086
        if(defined $inf_bt) {$table->attach  ($inf_bt , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
1087
        if(defined $widget) {$table->attach  ($widget , $column, $column+1, $row,$row+1,'fill','shrink',2,2);$column++;}
1088
        #$table->attach  ($tmp , $column+3, $column+4, $row,$row+1,'fill','shrink',2,2);
1089
}
1090
 
1091
sub gen_Hsep {
1092
        return Gtk2::HSeparator->new;
1093
}
1094
 
1095
sub gen_Vsep {
1096
        return Gtk2::VSeparator->new;
1097
}
1098
 
1099
 
1100
sub add_Hsep_to_table {
1101
        my($table,$col0,$col1,$row)=@_;
1102
        my $separator = gen_Hsep();
1103
        $table->attach ($separator ,$col0,$col1 , $row, $row+1,'fill','fill',2,2);
1104
}
1105
 
1106
sub add_Vsep_to_table {
1107
        my($table,$col,$row1,$row2)=@_;
1108
        my $separator = gen_Vsep();
1109
        $table->attach ($separator ,$col,$col+1 , $row1, $row2,'fill','fill',2,2);
1110
}
1111
 
1112
 
1113
##################
1114
#       show_info
1115
##################
1116
sub show_info{
1117
        my ($textview,$info)=@_;
1118
        #return;# if(!defined $textview_ref);
1119
        #print "$textview_ref\n";
1120
        my $buffer = $textview->get_buffer();
1121
        $buffer->set_text($info);
1122
        txview_scrol_to_end($textview);
1123
}
1124
 
1125
sub add_info{
1126
        my ($textview,$info)=@_;
1127
        my $buffer = $textview->get_buffer();
1128
        my $textiter = $buffer->get_end_iter();
1129
        #Insert some text into the buffer
1130
        $buffer->insert($textiter,$info);
1131
        txview_scrol_to_end($textview);
1132
 
1133
}
1134
 
1135
 
1136
sub show_colored_info{
1137
        my ($textview,$info,$color)=@_;
1138
        my $buffer = $textview->get_buffer();
1139
        #$buffer->set_text($info);
1140
        my $textiter = $buffer->get_start_iter();
1141
        $buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
1142
        txview_scrol_to_end($textview);
1143
}
1144
 
1145
sub add_colored_info{
1146
        my ($textview,$info,$color)=@_;
1147
        my $buffer = $textview->get_buffer();
1148
        my $textiter = $buffer->get_end_iter();
1149
        $buffer->insert_with_tags_by_name ($textiter, "$info", "${color}_tag");
1150
        txview_scrol_to_end($textview);
1151
 
1152
}
1153
 
1154
sub add_colors_to_textview{
1155
        my $tview= shift;
1156
        add_colored_tag($tview,'red');
1157
        add_colored_tag($tview,'blue');
1158
        add_colored_tag($tview,'brown');
1159
        add_colored_tag($tview,'green');
1160
}
1161
 
1162
 
1163
sub add_colored_tag{
1164
        my ($textview_ref,$color)=@_;
1165
        my $buffer = $textview_ref->get_buffer();
1166
        $buffer->create_tag ("${color}_tag", foreground => $color);
1167
}
1168
 
1169
sub add_color_to_gd{
1170
        foreach (my $i=0;$i<32;$i++ ) {
1171
                my ($red,$green,$blue)=get_color($i);
1172
                add_colour("my_color$i"=>[$red>>8,$green>>8,$blue>>8]);
1173
 
1174
        }
1175
}
1176
 
1177
 
1178
 
1179
############
1180
#       get file folder list
1181
###########
1182
 
1183
sub get_directory_name_widget {
1184
        my ($object,$title,$entry,$attribute1,$attribute2,$status,$timeout)= @_;
1185
        my $browse= def_image_button("icons/browse.png");
1186
 
1187
        $browse->signal_connect("clicked"=> sub{
1188
                my $entry_ref=$_[1];
1189
                my $file;
1190
                $title ='select directory' if(!defined $title);
1191
                my $dialog = Gtk2::FileChooserDialog->new(
1192
                        $title, undef,
1193
                        #               'open',
1194
                        'select-folder',
1195
                        'gtk-cancel' => 'cancel',
1196
                        'gtk-ok'     => 'ok',
1197
                        );
1198
 
1199
 
1200
                        if ( "ok" eq $dialog->run ) {
1201
                        $file = $dialog->get_filename;
1202
                                $$entry_ref->set_text($file);
1203
                                $object->object_add_attribute($attribute1,$attribute2,$file);
1204
                                set_gui_status($object,$status,$timeout) if(defined $status);
1205
                                #check_input_file($file,$socgen,$soc_state,$info);
1206
                                #print "file = $file\n";
1207
                         }
1208
                        $dialog->destroy;
1209
 
1210
 
1211
 
1212
                } , \$entry);
1213
 
1214
        return $browse;
1215
 
1216
}
1217
 
1218
 
1219
sub get_dir_name {
1220
        my ($object,$title,$attribute1,$attribute2,$open_in,$status,$timeout)= @_;
1221
        my $dir;
1222
        $title ='select directory' if(!defined $title);
1223
        my $dialog = Gtk2::FileChooserDialog->new(
1224
                $title, undef,
1225
                #               'open',
1226
                'select-folder',
1227
                'gtk-cancel' => 'cancel',
1228
                'gtk-ok'     => 'ok',
1229
        );
1230
        if(defined  $open_in){
1231
                $dialog->set_current_folder ($open_in);
1232
        }
1233
 
1234
        if ( "ok" eq $dialog->run ) {
1235
                        $dir = $dialog->get_filename;
1236
                                $object->object_add_attribute($attribute1,$attribute2,$dir);
1237
                                set_gui_status($object,$status,$timeout) if(defined $status);
1238
                                $dialog->destroy;
1239
        }
1240
}
1241
 
1242
 
1243
 
1244
sub get_file_name {
1245
        my ($object,$title,$entry,$attribute1,$attribute2,$extension,$label,$open_in)= @_;
1246
        my $browse= def_image_button("icons/browse.png");
1247
 
1248
        $browse->signal_connect("clicked"=> sub{
1249
                my $entry_ref=$_[1];
1250
                my $file;
1251
                $title ='select a file' if(!defined $title);
1252
                my $dialog = Gtk2::FileChooserDialog->new(
1253
                'Select a File', undef,
1254
                'open',
1255
                'gtk-cancel' => 'cancel',
1256
                'gtk-ok'     => 'ok',
1257
                );
1258
         if(defined $extension){
1259
                my $filter = Gtk2::FileFilter->new();
1260
                $filter->set_name($extension);
1261
                $filter->add_pattern("*.$extension");
1262
                $dialog->add_filter ($filter);
1263
         }
1264
          if(defined  $open_in){
1265
                $dialog->set_current_folder ($open_in);
1266
                # print "$open_in\n";
1267
 
1268
        }
1269
 
1270
                        if ( "ok" eq $dialog->run ) {
1271
                        $file = $dialog->get_filename;
1272
                                #remove $project_dir form beginig of each file
1273
                $file =remove_project_dir_from_addr($file);
1274
                                $$entry_ref->set_text($file);
1275
                                $object->object_add_attribute($attribute1,$attribute2,$file) if(defined $object);
1276
                                my ($name,$path,$suffix) = fileparse("$file",qr"\..[^.]*$");
1277
                                if(defined $label){
1278
                                        $label->set_markup("<span  foreground= 'black' ><b>$name$suffix</b></span>");
1279
                                        $label->show;
1280
                                }
1281
 
1282
                                #check_input_file($file,$socgen,$soc_state,$info);
1283
                                #print "file = $file\n";
1284
                         }
1285
                        $dialog->destroy;
1286
 
1287
 
1288
 
1289
                } , \$entry);
1290
 
1291
        return $browse;
1292
 
1293
}
1294
 
1295
sub gen_file_dialog  {
1296
        my ($title, @extension)=@_;
1297
        $title = 'Select a File' if (!defined $title);
1298
 
1299
        my $dialog = Gtk2::FileChooserDialog->new(
1300
                $title, undef,
1301
                'open',
1302
                'gtk-cancel' => 'cancel',
1303
                'gtk-ok'     => 'ok',
1304
     );
1305
 
1306
        foreach my $ext (@extension){
1307
                my $filter = Gtk2::FileFilter->new();
1308
                $filter->set_name("$ext");
1309
                $filter->add_pattern("*.$ext");
1310
                $dialog->add_filter ($filter);
1311
        }
1312
 
1313
        return $dialog;
1314
}
1315
 
1316
 
1317
sub save_file_dialog  {
1318
        my ($title, @extension)=@_;
1319
        $title = 'Select a File' if (!defined $title);
1320
 
1321
        my $dialog = Gtk2::FileChooserDialog->new(
1322
                $title,
1323
                                undef,
1324
                'save',
1325
                'gtk-cancel' => 'cancel',
1326
                'gtk-ok'     => 'ok',
1327
     );
1328
 
1329
        $dialog->set_modal(TRUE);
1330
        $dialog->set_transient_for (Gtk2::Window->new('toplevel'));#just to get rid of transient warning
1331
 
1332
        foreach my $ext (@extension){
1333
                my $filter = Gtk2::FileFilter->new();
1334
                $filter->set_name("$ext");
1335
                $filter->add_pattern("*.$ext");
1336
                $dialog->add_filter ($filter);
1337
        }
1338
 
1339
        return $dialog;
1340
 
1341
}
1342
 
1343
 
1344
 
1345
 
1346
sub gen_folder_dialog  {
1347
        my ($title)=@_;
1348
        $title = 'Select Folder' if (!defined $title);
1349
 
1350
 
1351
 
1352
        my $dialog = Gtk2::FileChooserDialog->new(
1353
                $title,
1354
                undef,
1355
                'select-folder',
1356
                'gtk-cancel' => 'cancel',
1357
                'gtk-ok'     => 'ok',
1358
     );
1359
        $dialog->set_modal(TRUE);
1360
 
1361
        return $dialog;
1362
 
1363
}
1364
 
1365
 
1366
sub get_filenames_from_dialog{
1367
        my $dialog=shift;
1368
        my @files = $dialog->get_filenames;
1369
        return @files;
1370
}
1371
 
1372
 
1373
sub new_dialog_with_buttons {
1374
        my $self =shift;
1375
        return Gtk2::Dialog->new_with_buttons(
1376
                "Goto to line",
1377
                $self->window,
1378
                [ 'modal' ],
1379
                'gtk-cancel' => 'cancel',
1380
                'gtk-ok'     => 'ok',
1381
        );
1382
 
1383
}
1384
 
1385
 
1386
#################
1387
#       widget update object
1388
#################
1389
 
1390
sub gen_entry_object {
1391
        my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
1392
        my $old=$object->object_get_attribute($attribute1,$attribute2);
1393
        my $widget;
1394
        if(defined $old ){
1395
                $widget=gen_entry($old);
1396
        }
1397
        else
1398
        {
1399
                $widget=gen_entry($default);
1400
                $object->object_add_attribute($attribute1,$attribute2,$default);
1401
        }
1402
        $widget-> signal_connect("changed" => sub{
1403
                my $new_param_value=$widget->get_text();
1404
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1405
                set_gui_status($object,$status,$timeout) if (defined $status);
1406
        });
1407
        return $widget;
1408
}
1409
 
1410
 
1411
sub gen_combobox_object {
1412
        my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1413
        my @combo_list=split(/\s*,\s*/,$content);
1414
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1415
        my $pos;
1416
        $pos=get_pos($value, @combo_list) if (defined $value);
1417
        if(!defined $pos && defined $default){
1418
                $object->object_add_attribute($attribute1,$attribute2,$default);
1419
                $pos=get_item_pos($default, @combo_list);
1420
        }
1421
        #print " my $pos=get_item_pos($value, @combo_list);\n";
1422
        my $widget=gen_combo(\@combo_list, $pos);
1423
        $widget-> signal_connect("changed" => sub{
1424
                my $new_param_value=$widget->get_active_text();
1425
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1426
                set_gui_status($object,$status,$timeout) if (defined $status);
1427
         });
1428
        return $widget;
1429
 
1430
 
1431
}
1432
 
1433
 
1434
sub gen_comboentry_object {
1435
        my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1436
        my @combo_list;
1437
        @combo_list=split(/\s*,\s*/,$content) if(defined $content );
1438
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1439
        my $pos;
1440
        $pos=get_pos($value, @combo_list) if (defined $value);
1441
        if(!defined $pos && defined $default){
1442
                $object->object_add_attribute($attribute1,$attribute2,$default);
1443
                $pos=get_item_pos($default, @combo_list);
1444
        }
1445
        #print " my $pos=get_item_pos($value, @combo_list);\n";
1446
 
1447
        my $widget=gen_combo_entry(\@combo_list, $pos);
1448
        ($widget->child)->signal_connect('changed' => sub {
1449
                my ($entry) = @_;
1450
                my $new_param_value=$entry->get_text();
1451
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1452
                set_gui_status($object,$status,$timeout) if (defined $status);
1453
         });
1454
        return $widget;
1455
 
1456
}
1457
 
1458
 
1459
 
1460
sub gen_spin_object {
1461
        my ($object,$attribute1,$attribute2,$content, $default,$status,$timeout)=@_;
1462
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1463
        my ($min,$max,$step,$digit)=split(/\s*,\s*/,$content);
1464
        if(!defined $value){
1465
                $value=$default;
1466
                $object->object_add_attribute($attribute1,$attribute2,$value);
1467
        }
1468
 
1469
        $value=~ s/[^0-9.\-]//g;
1470
        $min=~   s/[^0-9.\-]//g;
1471
        $max=~   s/[^0-9.\-]//g;
1472
        $step=~  s/[^0-9.\-]//g;
1473
        $digit=~ s/[^0-9.\-]//g if (defined $digit);
1474
 
1475
        my $widget=gen_spin($min,$max,$step,$digit);
1476
        $widget->set_value($value);
1477
        $widget-> signal_connect("value_changed" => sub{
1478
                my $new_param_value=$widget->get_value();
1479
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1480
                set_gui_status($object,$status,$timeout) if (defined $status);
1481
        });
1482
        return $widget;
1483
}
1484
 
1485
 
1486
sub gen_check_box_object_array {
1487
                my ($object,$attribute1,$attribute2,$content,$default,$status,$timeout)=@_;
1488
                my $value=$object->object_get_attribute($attribute1,$attribute2);
1489
                $value = $default if (!defined $value);
1490
                my $widget = def_hbox(FALSE,0);
1491
                my @check;
1492
                for (my $i=0;$i<$content;$i++){
1493
                        $check[$i]= Gtk2::CheckButton->new;
1494
                }
1495
                for (my $i=0;$i<$content;$i++){
1496
                        $widget->pack_end(  $check[$i], FALSE, FALSE, 0);
1497
 
1498
                        my @chars = split("",$value);
1499
                        #check if saved value match the size of check box
1500
                        if($chars[0] ne $content ) {
1501
                                $object->object_add_attribute($attribute1,$attribute2,$default);
1502
                                $value=$default;
1503
                                @chars = split("",$value);
1504
                        }
1505
                        #set initial value
1506
 
1507
                        #print "\@chars=@chars\n";
1508
                        for (my $i=0;$i<$content;$i++){
1509
                                my $loc= (scalar @chars) -($i+1);
1510
                                        if( $chars[$loc] eq '1') {$check[$i]->set_active(TRUE);}
1511
                                        else {$check[$i]->set_active(FALSE);}
1512
                        }
1513
 
1514
 
1515
                        #get new value
1516
                        $check[$i]-> signal_connect("toggled" => sub{
1517
                                my $new_val="$content\'b";
1518
 
1519
                                for (my $i=$content-1; $i >= 0; $i--){
1520
                                        if($check[$i]->get_active()) {$new_val="${new_val}1" ;}
1521
                                        else {$new_val="${new_val}0" ;}
1522
                                }
1523
                                $object->object_add_attribute($attribute1,$attribute2,$new_val);
1524
                                #print "\$new_val=$new_val\n";
1525
                                set_gui_status($object,$status,$timeout) if (defined $status);
1526
                        });
1527
        }
1528
        return $widget;
1529
 
1530
}
1531
 
1532
 
1533
 
1534
 
1535
 
1536
sub gen_check_box_object {
1537
                my ($object,$attribute1,$attribute2,$default,$status,$timeout)=@_;
1538
                my $value=$object->object_get_attribute($attribute1,$attribute2);
1539
                if (!defined $value){
1540
                        #set initial value
1541
                        $object->object_add_attribute($attribute1,$attribute2,$default);
1542
                        $value = $default
1543
                }
1544
                my $widget = Gtk2::CheckButton->new;
1545
                if($value == 1) {$widget->set_active(TRUE);}
1546
                else {$widget->set_active(FALSE);}
1547
 
1548
                #get new value
1549
                $widget-> signal_connect("toggled" => sub{
1550
                        my $new_val;
1551
                        if($widget->get_active()) {$new_val=1;}
1552
                        else {$new_val=0;}
1553
                        $object->object_add_attribute($attribute1,$attribute2,$new_val);
1554
                        #print "\$new_val=$new_val\n";
1555
                        set_gui_status($object,$status,$timeout) if (defined $status);
1556
                });
1557
 
1558
        return $widget;
1559
 
1560
}
1561
 
1562
 
1563
 
1564
 
1565
 
1566
 
1567
sub get_dir_in_object {
1568
        my ($object,$attribute1,$attribute2,$content,$status,$timeout,$default)=@_;
1569
        my $widget = def_hbox(FALSE,0);
1570
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1571
        $object->object_add_attribute($attribute1,$attribute2,  $default) if (!defined $value );
1572
        $value = $default if (!defined $value );
1573
        if (defined $default){
1574
                $object->object_add_attribute($attribute1,$attribute2,  $default) if  !(-d $value );
1575
                $value = $default  if !(-d $value );
1576
        };
1577
 
1578
        my $warning;
1579
 
1580
        my $entry=gen_entry($value);
1581
        $entry-> signal_connect("changed" => sub{
1582
                my $new_param_value=$entry->get_text();
1583
                $object->object_add_attribute($attribute1,$attribute2,$new_param_value);
1584
                set_gui_status($object,$status,$timeout) if (defined $status);
1585
                unless (-d $new_param_value ){
1586
                        if (!defined $warning){
1587
                                $warning = def_icon("icons/warning.png");
1588
                                $widget->pack_start( $warning, FALSE, FALSE, 0);
1589
                                set_tip($warning,"$new_param_value is not a valid directory");
1590
                                $widget->show_all;
1591
                        }
1592
 
1593
                }else{
1594
                        $warning->destroy if (defined $warning);
1595
                        undef $warning;
1596
 
1597
                }
1598
 
1599
        });
1600
        my $browse= get_directory_name_widget($object,undef,$entry,$attribute1,$attribute2,$status,$timeout);
1601
 
1602
        $widget->pack_start( $entry, FALSE, FALSE, 0);
1603
        $widget->pack_start( $browse, FALSE, FALSE, 0);
1604
 
1605
         if(defined $value){
1606
                unless (-d $value ){
1607
                        $warning= def_icon("icons/warning.png");
1608
                        $widget->pack_start( $warning, FALSE, FALSE, 0);
1609
                        set_tip($warning,"$value is not a valid directory path");
1610
                }
1611
        }
1612
        return $widget;
1613
}
1614
 
1615
 
1616
 
1617
 
1618
sub get_file_name_object {
1619
        my ($object,$attribute1,$attribute2,$extension,$open_in)=@_;
1620
        my $widget = def_hbox(FALSE,0);
1621
        my $value=$object->object_get_attribute($attribute1,$attribute2);
1622
        my $label;
1623
        if(defined $value){
1624
                my ($name,$path,$suffix) = fileparse("$value",qr"\..[^.]*$");
1625
                $label=gen_label_in_center($name.$suffix);
1626
 
1627
        } else {
1628
                        $label=gen_label_in_center("Selecet a file");
1629
                        $label->set_markup("<span  foreground= 'red' ><b>No file has been selected yet</b></span>");
1630
        }
1631
        my $entry=gen_entry();
1632
        my $browse= get_file_name($object,undef,$entry,$attribute1,$attribute2,$extension,$label,$open_in);
1633
        $widget->pack_start( $label, FALSE, FALSE, 0);
1634
        $widget->pack_start( $browse, FALSE, FALSE, 0);
1635
        return $widget;
1636
}
1637
 
1638
 
1639
 
1640
 
1641
 
1642
sub gen_notebook {
1643
        my $notebook = Gtk2::Notebook->new;
1644
        $notebook->can_focus(FALSE);
1645
 
1646
        return $notebook;
1647
}
1648
################
1649
# ADD info and label to widget
1650
################
1651
 
1652
 
1653
sub gen_label_info{
1654
        my ($label_name,$widget,$info)=@_;
1655
        my $box = def_hbox(FALSE,0);
1656
        #label
1657
        if(defined $label_name){
1658
                my $label= gen_label_in_left($label_name);
1659
                $box->pack_start( $label, FALSE, FALSE, 3);
1660
        }
1661
        $box->pack_start( $widget, FALSE, FALSE, 3);
1662
        #info   
1663
        if(defined $info){
1664
                my $button=def_image_button("icons/help.png");
1665
                $button->signal_connect("clicked" => sub {message_dialog($info);});
1666
                $box->pack_start( $button, FALSE, FALSE, 3);
1667
        }
1668
        $box->show_all;
1669
        return $box;
1670
}
1671
 
1672
 
1673
############
1674
#
1675
###########
1676
 
1677
sub gen_MenuBar{
1678
        my ($window,@menu_items)=@_;
1679
        my $accel_group = Gtk2::AccelGroup->new;
1680
    my $item_factory = Gtk2::ItemFactory->new ("Gtk2::MenuBar", "<main>",$accel_group);
1681
        $window->add_accel_group ($accel_group);
1682
    # Set up item factory to go away with the window
1683
    $window->{'<main>'} = $item_factory;
1684
    # create menu items
1685
    $item_factory->create_items ($window, @menu_items);
1686
    return $item_factory->get_widget ("<main>");
1687
}
1688
 
1689
sub creating_detachable_toolbar{
1690
        my @attachments=@_;
1691
 
1692
        #The handle box helps in creating a detachable toolbar 
1693
        my $hb = Gtk2::HandleBox->new;
1694
        #create a toolbar, and do some initial settings
1695
        my $toolbar = Gtk2::Toolbar->new;
1696
        $toolbar->set_icon_size ('small-toolbar');
1697
        $toolbar->set_show_arrow (FALSE);
1698
        foreach my $p (@attachments){
1699
                $toolbar->insert($p,-1);
1700
 
1701
        }
1702
        $hb->add($toolbar);
1703
        return $hb;
1704
}
1705
 
1706
sub gui_quite{
1707
        Gtk2->main_quit;
1708
}
1709
 
1710
sub gtk_gui_run{
1711
        my ($main)=@_;
1712
        Gtk2->init;
1713
        &$main;
1714
        Gtk2->main();
1715
        return 1;
1716
}
1717
 
1718
 
1719
sub refresh_gui{
1720
        while (Gtk2->events_pending) {
1721
      Gtk2->main_iteration;
1722
    }
1723
    Gtk2::Gdk->flush;
1724
}
1725
 
1726
 
1727
sub about {
1728
    my $version=shift;
1729
    my $about = Gtk2::AboutDialog->new;
1730
    $about->set_authors("Alireza Monemi\n Email: alirezamonemi\@opencores.org");
1731
    $about->set_version( $version );
1732
    $about->set_website('http://opencores.org/project,an-fpga-implementation-of-low-latency-noc-based-mpsoc');
1733
    $about->set_comments('NoC based MPSoC generator.');
1734
    $about->set_program_name('ProNoC');
1735
    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale("icons/ProNoC.png",50,50,FALSE);
1736
    $about->set_logo($pixbuf);
1737
 
1738
    $about->set_license(
1739
                 "This program is free software; you can redistribute it\n"
1740
                . "and/or modify it under the terms of the GNU General \n"
1741
                . "Public License as published by the Free Software \n"
1742
                . "Foundation; either version 1, or (at your option)\n"
1743
                . "any later version.\n\n"
1744
 
1745
        );
1746
        # Add the Hide action to the 'Close' button in the AboutDialog():
1747
    $about->signal_connect('response' => sub { $about->hide; });
1748
 
1749
 
1750
    $about->run;
1751
    $about->destroy;
1752
    return;
1753
}
1754
 
1755
 
1756
 
1757
############
1758
#  list_store
1759
###########
1760
 
1761
sub gen_list_store {
1762
        my ($dref,$clmn_type_ref, $clmn_lables_ref)=@_;
1763
 
1764
 
1765
#               my @data = (
1766
#  {0 => "Average distance",  1 =>"$avg"}, 
1767
#  {0 => "Max distance",  1 =>"$max" },  
1768
#  {0 => "Min distance",1 => "$min"},    
1769
#  {0 => "Normlized data per hop", 1 =>"$norm" }
1770
#  );
1771
 
1772
# my @clmn_type = (#'Glib::Boolean', # => G_TYPE_BOOLEAN
1773
#                                    #'Glib::Uint',    # => G_TYPE_UINT
1774
#                                    'Glib::String',  # => G_TYPE_STRING
1775
#                                  'Glib::String'); # you get the idea
1776
 
1777
 
1778
        my @data = @{$dref};
1779
        my @clmn_type = @{$clmn_type_ref};
1780
        my @clmn_lables= @{$clmn_lables_ref};
1781
 
1782
 
1783
    # create list store
1784
    my $store = Gtk2::ListStore->new ( @clmn_type);
1785
 
1786
 
1787
        # add data to the list store
1788
        foreach my $d (@data) {
1789
                my $iter = $store->append;
1790
                my @clmns = sort keys %{$d};
1791
                my @a=($iter);
1792
                foreach my $c (@clmns){
1793
                        push (@a,($c,$d->{$c}));
1794
 
1795
                }
1796
        $store->set (@a);
1797
 
1798
        }
1799
 
1800
 
1801
    my $treeview = Gtk2::TreeView->new ($store);
1802
    $treeview->set_rules_hint (TRUE);
1803
        $treeview->set_search_column (1);
1804
    my $renderer = Gtk2::CellRendererToggle->new;
1805
    $renderer->signal_connect (toggled => \&fixed_toggled, $store);
1806
 
1807
 
1808
        # column for severities
1809
        my $c=0;
1810
        foreach my $l (@clmn_lables){
1811
                $renderer = Gtk2::CellRendererText->new;
1812
                my $column = Gtk2::TreeViewColumn->new_with_attributes ("$l",
1813
                                                               $renderer,
1814
                                                               text => $c );
1815
                $column->set_sort_column_id ($c );
1816
                $treeview->append_column ($column);
1817
                $c++;
1818
        }
1819
 
1820
 
1821
        return $treeview;
1822
}
1823
 
1824
 
1825
 
1826
 
1827
 
1828
##############
1829
#       create tree
1830
##############
1831
 
1832
 
1833
sub create_tree_model_network_maker{
1834
        my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
1835
        my $tree_view = Gtk2::TreeView->new;
1836
        $tree_view->set_model ($model);
1837
        my $selection = $tree_view->get_selection;
1838
        $selection->set_mode ("single");
1839
        my $cell = Gtk2::CellRendererText->new;
1840
        $cell->set ('style' => 'italic');
1841
        my $column = Gtk2::TreeViewColumn->new_with_attributes ("select", $cell, 'text' => 0, 'style_set' => 3);
1842
        return ($model,$tree_view,$column);
1843
}
1844
 
1845
 
1846
sub treemodel_next_iter{
1847
        my      ($child , $tree_model)=@_;
1848
        return $tree_model->iter_next ($child);
1849
}
1850
 
1851
 
1852
 
1853
 
1854
 
1855
 
1856
 
1857
 
1858
 
1859
 
1860
 
1861
 
1862
 
1863
# clean names for column numbers.
1864
use constant DISPLAY_COLUMN    => 0;
1865
use constant CATRGORY_COLUMN    => 1;
1866
use constant MODULE_COLUMN     => 2;
1867
use constant ITALIC_COLUMN   => 3;
1868
use constant NUM_COLUMNS     => 4;
1869
 
1870
sub create_tree {
1871
   my ($self,$label,$info,$tree_ref,$row_selected_func,$row_activated_func)=@_;
1872
   my %tree_in = %{$tree_ref};
1873
   my $model = Gtk2::TreeStore->new ('Glib::String', 'Glib::String', 'Glib::Scalar', 'Glib::Boolean');
1874
   my $tree_view = Gtk2::TreeView->new;
1875
   $tree_view->set_model ($model);
1876
   my $selection = $tree_view->get_selection;
1877
   $selection->set_mode ('browse');
1878
 
1879
 
1880
 
1881
   foreach my $p (sort keys %tree_in)
1882
   {
1883
 
1884
        my @modules= @{$tree_in{$p}};
1885
        #my @dev_entry=  @{$tree_entry{$p}};    
1886
        my $iter = $model->append (undef);
1887
        $model->set ($iter,
1888
                   DISPLAY_COLUMN,    $p,
1889
                   CATRGORY_COLUMN, $p || '',
1890
                   MODULE_COLUMN,     0     || '',
1891
                   ITALIC_COLUMN,   FALSE);
1892
 
1893
        next unless  @modules;
1894
 
1895
        foreach my $v ( @modules){
1896
                 my $child_iter = $model->append ($iter);
1897
                 my $entry= '';
1898
 
1899
                $model->set ($child_iter,
1900
                        DISPLAY_COLUMN,    $v,
1901
                        CATRGORY_COLUMN, $p|| '',
1902
                        MODULE_COLUMN,     $v     || '',
1903
                        ITALIC_COLUMN,   FALSE);
1904
        }
1905
 
1906
 
1907
 
1908
   }
1909
 
1910
   my $cell = Gtk2::CellRendererText->new;
1911
   $cell->set ('style' => 'italic');
1912
   my $column = Gtk2::TreeViewColumn->new_with_attributes
1913
                                        ("$label",
1914
                                        $cell,
1915
                                        'text' => DISPLAY_COLUMN,
1916
                                        'style_set' => ITALIC_COLUMN);
1917
 
1918
        $tree_view->append_column ($column);
1919
        my @ll=($model,$info);
1920
   #row selected
1921
        $selection->signal_connect (changed =>sub {
1922
        my ($selection, $ref) = @_;
1923
        my ($model,$info)=@{$ref};
1924
        my $iter = $selection->get_selected;
1925
        return unless defined $iter;
1926
 
1927
        my ($category) = $model->get ($iter, CATRGORY_COLUMN);
1928
        my ($module) = $model->get ($iter,MODULE_COLUMN );
1929
        $row_selected_func->($self,$category,$module,$info) if(defined $row_selected_func);
1930
 
1931
 
1932
 
1933
}, \@ll);
1934
 
1935
#  row_activated 
1936
  $tree_view->signal_connect (row_activated => sub{
1937
 
1938
        my ($tree_view, $path, $column) = @_;
1939
        my $model = $tree_view->get_model;
1940
        my $iter = $model->get_iter ($path);
1941
        my ($category) = $model->get ($iter, CATRGORY_COLUMN);
1942
        my ($module) = $model->get ($iter,MODULE_COLUMN );
1943
 
1944
 
1945
        if($module){
1946
                #print "$module  is selected via row activaton!\n";
1947
                $row_activated_func->($self,$category,$module,$info) if(defined $row_activated_func);
1948
                #add_module_to_soc($soc,$ip,$category,$module,$info);
1949
 
1950
        }
1951
 
1952
}, \@ll);
1953
 
1954
  #$tree_view->expand_all;
1955
 
1956
  my $scrolled_window = Gtk2::ScrolledWindow->new;
1957
  $scrolled_window->set_policy ('automatic', 'automatic');
1958
  $scrolled_window->set_shadow_type ('in');
1959
  $scrolled_window->add($tree_view);
1960
 
1961
  my $hbox = Gtk2::HBox->new (FALSE, 0);
1962
  $hbox->pack_start ( $scrolled_window, TRUE, TRUE, 0);
1963
 
1964
  return $hbox;
1965
}
1966
 
1967
 
1968
sub row_activated_cb{
1969
         my ($tree_view, $path, $column) = @_;
1970
         my $model = $tree_view->get_model;
1971
         my $iter = $model->get_iter ($path);
1972
         my ($category) = $model->get ($iter, DISPLAY_COLUMN);
1973
         my ($module) = $model->get ($iter, CATRGORY_COLUMN);
1974
 
1975
}
1976
 
1977
 
1978
 
1979
sub file_edit_tree {
1980
        my $tree_store = Gtk2::TreeStore->new('Glib::String', 'Glib::String');
1981
        my $tree_view = Gtk2::TreeView->new($tree_store);
1982
        my $column = Gtk2::TreeViewColumn->new_with_attributes('Double-click to open', Gtk2::CellRendererText->new(), text => "0");
1983
        $tree_view->append_column($column);
1984
        $tree_view->set_headers_visible(TRUE);
1985
        return ($tree_store,$tree_view);
1986
}
1987
 
1988
##########
1989
#  run external commands
1990
##########
1991
 
1992
 
1993
 
1994
sub run_cmd_in_back_ground
1995
{
1996
  my $command = shift;
1997
  #print "\t$command\n";
1998
 
1999
  ### Start running the Background Job:
2000
    my $proc = Proc::Background->new($command);
2001
    my $PID = $proc->pid;
2002
    my $start_time = $proc->start_time;
2003
    my $alive = $proc->alive;
2004
 
2005
  ### While $alive is NOT '0', then keep checking till it is...
2006
  #  *When $alive is '0', it has finished executing.
2007
  while($alive ne 0)
2008
  {
2009
    $alive = $proc->alive;
2010
 
2011
    # This while loop will cause Gtk2 to continue processing events, if
2012
    # there are events pending... *which there are...
2013
    while (Gtk2->events_pending) {
2014
      Gtk2->main_iteration;
2015
    }
2016
    Gtk2::Gdk->flush;
2017
 
2018
    usleep(1000);
2019
  }
2020
 
2021
  my $end_time = $proc->end_time;
2022
 # print "*Command Completed at $end_time, with PID = $PID\n\n";
2023
 
2024
  # Since the while loop has exited, the BG job has finished running:
2025
  # so close the pop-up window...
2026
 # $popup_window->hide;
2027
 
2028
  # Get the RETCODE from the Background Job using the 'wait' method
2029
  my $retcode = $proc->wait;
2030
  $retcode /= 256;
2031
 
2032
  #print "\t*RETCODE == $retcode\n\n";
2033
  Gtk2::Gdk->flush;
2034
  ### Check if the RETCODE returned with an Error:
2035
  if ($retcode ne 0) {
2036
    print "Error: The Background Job ($command) returned with an Error...!\n";
2037
    return 1;
2038
  } else {
2039
    #print "Success: The Background Job Completed Successfully...!\n";
2040
    return 0;
2041
  }
2042
 
2043
}
2044
 
2045
sub run_cmd_in_back_ground_get_stdout
2046
{
2047
        my $cmd=shift;
2048
        my $exit;
2049
        my ($stdout, $stderr);
2050
        capture { $exit=run_cmd_in_back_ground($cmd) } \$stdout, \$stderr;
2051
        return ($stdout,$exit,$stderr);
2052
 
2053
}
2054
 
2055
sub run_cmd_message_dialog_errors{
2056
        my ($cmd)=@_;
2057
        my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
2058
        if(length $stderr>1){
2059
                message_dialog("$stderr\n",'error');
2060
                return 1;
2061
        }if($exit){
2062
                message_dialog("Error $cmd failed: $stdout\n",'error');
2063
                return 1;
2064
        }
2065
        return 0;
2066
 
2067
}
2068
 
2069
 
2070
sub run_cmd_textview_errors{
2071
        my ($cmd,$tview)=@_;
2072
        my ($stdout,$exit,$stderr)=run_cmd_in_back_ground_get_stdout($cmd);
2073
        if(length $stderr>1){
2074
                add_colored_info($tview,"Error: $stderr\n",'red');
2075
                add_colored_info($tview,"$cmd did not run successfully!\n",'red');
2076
                return undef;
2077
        }
2078
        if($exit){
2079
                add_colored_info($tview,"Error:$stdout\n",'red');
2080
                add_colored_info($tview,"$cmd did not run successfully!\n",'red');
2081
                return undef;
2082
        }
2083
        $stdout = "" if (!defined $stdout);
2084
        return  $stdout
2085
}
2086
 
2087
 
2088
sub create_iconview_model {
2089
#----------------------------------------------------
2090
#The Iconview needs a Gtk2::Treemodel implementation-
2091
#containing at least a Glib::String and -------------
2092
#Gtk2::Gdk::Pixbuf type. The first is used for the --
2093
#text of the icon, and the last for the icon self----
2094
#Gtk2::ListStore is ideal for this ------------------
2095
#----------------------------------------------------
2096
        my ($self,$name,$ref)=@_;
2097
        my @sources= (defined $ref)? @{$ref}:();
2098
    my $list_store = Gtk2::ListStore->new(qw/Glib::String Gtk2::Gdk::Pixbuf Glib::String/);
2099
 
2100
    #******************************************************
2101
    #we populate the Gtk2::ListStore with Gtk2::Stock icons
2102
    #******************************************************
2103
 
2104
 
2105
 
2106
    foreach my $val(@sources){
2107
        #get the iconset from the icon_factory
2108
        #my $iconset = $icon_factory->lookup_default($val);
2109
        #try and extract the icon from it
2110
        add_icon_to_tree($self,$name,$list_store,$val);
2111
    }
2112
 
2113
    return $list_store;
2114
}
2115
 
2116
####################
2117
#       SourceView
2118
####################
2119
 
2120
sub     gen_SourceView_with_buffer{
2121
        return Gtk2::SourceView2::View->new_with_buffer(@_);
2122
}
2123
 
2124
 
2125
 
2126
 
2127
 
2128
sub create_SourceView_buffer {
2129
        my $self = shift;
2130
        my $tags = Gtk2::TextTagTable->new();
2131
 
2132
        add_tag_to_SourceView($tags, search => {
2133
                        background => 'yellow',
2134
        });
2135
        add_tag_to_SourceView($tags, goto_line => {
2136
                        'paragraph-background' => 'orange',
2137
        });
2138
 
2139
        my $buffer = Gtk2::SourceView2::Buffer->new($tags);
2140
        $buffer->signal_connect('notify::cursor-position' => sub {
2141
                $self->clear_highlighted();
2142
        });
2143
 
2144
        return $buffer;
2145
}
2146
 
2147
 
2148
sub add_tag_to_SourceView {
2149
        my ($tags, $name, $properties) = @_;
2150
 
2151
        my $tag = Gtk2::TextTag->new($name);
2152
        $tag->set(%{ $properties });
2153
        $tags->add($tag);
2154
}
2155
 
2156
 
2157
sub detect_language {
2158
        my $self = shift;
2159
        my ($filename) = @_;
2160
 
2161
        # Guess the programming language of the file
2162
        my $manager = Gtk2::SourceView2::LanguageManager->get_default;
2163
        my $language = $manager->guess_language($filename);
2164
        $self->buffer->set_language($language);
2165
}
2166
 
2167
 
2168
 
2169
sub get_pressed_key{
2170
        my $event=shift;
2171
 
2172
        my $key = Gtk2::Gdk->keyval_name( $event->keyval );
2173
        return $key;
2174
}
2175
 
2176
 
2177
 
2178
 
2179
 
2180
 
2181
 
2182
1

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.