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/] [widget.pl] - Blame information for rev 24

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

Line No. Rev Author Line
1 16 alirezamon
use Glib qw/TRUE FALSE/;
2
#use Gtk2 '-init';
3
use strict;
4
use warnings;
5
 
6
use Gtk2::Pango;
7
 
8
 
9
##############
10
# combo box
11
#############
12
sub gen_combo{
13
        my ($combo_list, $combo_active_pos)= @_;
14
        my $combo = Gtk2::ComboBox->new_text;
15
 
16
        combo_set_names($combo,$combo_list);
17
        $combo->set_active($combo_active_pos);
18
 
19
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
20
        #$combo->modify_font($font);
21
 
22
 
23
        return $combo;
24
}
25
 
26
 
27
sub combo_set_names {
28
        my ( $combo, $list_ref ) = @_;
29
        my @list=@{$list_ref};
30
        #print "$list[0]\n";
31
        for my $item (@list){$combo->append_text($item);}
32
}
33
 
34
 
35
sub gen_combo_help {
36
        my ($help, @combo_list, $pos)= @_;
37
        my $box = def_hbox(FALSE, 0);
38
        my $combo= gen_combo(@combo_list, $pos);
39
        my $button=def_image_button("icons/help.png");
40
 
41
        $button->signal_connect("clicked" => sub {message_dialog($help);});
42
 
43
        $box->pack_start( $combo, FALSE, FALSE, 3);
44
        $box->pack_start( $button, FALSE, FALSE, 3);
45
        $box->show_all;
46
 
47
        return ($box,$combo);
48
}
49
 
50
 
51
sub def_h_labeled_combo{
52
                my ($label_name,$combo_list,$combo_active_pos)=@_;
53
                my $box = def_hbox(TRUE,0);
54
                my $label= gen_label_in_left($label_name);
55
                my $combo= gen_combo($combo_list, $combo_active_pos);
56
                $box->pack_start( $label, FALSE, FALSE, 3);
57
                $box->pack_start( $combo, FALSE, TRUE, 3);
58
                return ($box,$combo);
59
}
60
 
61
sub def_h_labeled_combo_scaled{
62
                my ($label_name,$combo_list,$combo_active_pos,$lable_w,$comb_w)=@_;
63
                my $table= def_table(1,3,TRUE);
64
                my $label= gen_label_in_left($label_name);
65
                my $combo= gen_combo($combo_list, $combo_active_pos);
66
                $table->attach_defaults ($label, 0, $lable_w, 0, 1);
67
                $table->attach_defaults ($combo, 1, $lable_w+$comb_w, 0, 1);
68
 
69
 
70
 
71
 
72
                return ($table,$combo);
73
}
74
 
75
 
76
##############
77
# spin button
78
#############
79
sub gen_spin{
80
        my ($min,$max,$step)= @_;
81
        my $spin = Gtk2::SpinButton->new_with_range ($min, $max, $step);
82
        return $spin;
83
}
84
 
85
 
86
 
87
sub gen_spin_help {
88
        my ($help, $min,$max,$step)= @_;
89
        my $box = def_hbox(FALSE, 0);
90
        my $spin= gen_spin($min,$max,$step);
91
        my $button=def_image_button("icons/help.png");
92
 
93
        $button->signal_connect("clicked" => sub {message_dialog($help);});
94
 
95
        $box->pack_start( $spin, FALSE, FALSE, 3);
96
        $box->pack_start( $button, FALSE, FALSE, 3);
97
        $box->show_all;
98
 
99
        return ($box,$spin);
100
}
101
 
102
 
103
#############
104
#  entry
105
#############
106
sub gen_entry{
107
        my ($initial) = @_;
108
        my $entry = Gtk2::Entry->new;
109
        if(defined $initial){ $entry->set_text($initial)};
110
        return $entry;
111
}
112
 
113
 
114
sub gen_entry_help{
115
        my ($help, $init)= @_;
116
        my $box = def_hbox(FALSE, 0);
117
        my $entry= gen_entry ($init);
118
        my $button=def_image_button("icons/help.png");
119
 
120
        $button->signal_connect("clicked" => sub {message_dialog($help);});
121
 
122
        $box->pack_start( $entry, FALSE, FALSE, 3);
123
        $box->pack_start( $button, FALSE, FALSE, 3);
124
        $box->show_all;
125
 
126
        return ($box,$entry);
127
}
128
 
129
sub def_h_labeled_entry{
130
        my ($label_name,$initial)=@_;
131
        my $box = def_hbox(TRUE,0);
132
        my $label= gen_label_in_left($label_name);
133
        my $entry =gen_entry($initial);
134
        $box->pack_start( $label, FALSE, FALSE, 3);
135
        $box->pack_start( $entry, FALSE, FALSE, 3);
136
        return ($box,$entry);
137
 
138 24 alirezamon
}
139 16 alirezamon
 
140 24 alirezamon
sub def_h_labeled_entry_help{
141
        my ($help,$label_name,$initial)=@_;
142
        my $box = def_hbox(TRUE,0);
143
        my $label= gen_label_in_left($label_name);
144
        my ($b,$entry) =gen_entry_help($help,$initial);
145
        $box->pack_start( $label, FALSE, FALSE, 3);
146
        $box->pack_start( $b, FALSE, FALSE, 3);
147
        return ($box,$entry);
148
 
149
}
150
 
151 17 alirezamon
##############
152
# ComboBoxEntry
153
##############
154 16 alirezamon
 
155 17 alirezamon
sub gen_combo_entry{
156
        my $list_ref=shift;
157
        my @list=@{$list_ref};
158
 
159
        my $combo_box_entry = Gtk2::ComboBoxEntry->new_text;
160
        foreach my $p (@list){
161
                $combo_box_entry->append_text($p);
162
        }
163
        $combo_box_entry->set_active(0);
164
        return $combo_box_entry;
165
}
166
 
167 24 alirezamon
###########
168
#
169
###########
170
 
171
sub def_h_labeled_checkbutton{
172
        my ($label_name,$status)=@_;
173
        my $box = def_hbox(TRUE,0);
174
        my $label= gen_label_in_left($label_name);
175
        my $check= Gtk2::CheckButton->new;
176
        #if($status==1) $check->
177
        $box->pack_start( $label, FALSE, FALSE, 3);
178
        $box->pack_start( $check, FALSE, FALSE, 3);
179
        return ($box,$check);
180
 
181
}
182
 
183
 
184
 
185
 
186 16 alirezamon
#############
187
#  label
188
############
189
 
190
sub gen_label_in_left{
191
        my ($data)=@_;
192
        my $label   = Gtk2::Label->new($data);
193
        $label->set_alignment( 0, 0.5 );
194
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
195
        #$label->modify_font($font);
196
        return $label;
197
}
198
 
199
 
200
sub gen_label_in_center{
201
        my ($data)=@_;
202
        my $label   = Gtk2::Label->new($data);
203
        return $label;
204
}
205
 
206
sub def_label{
207
        my @data=@_;
208
        my $label   = Gtk2::Label->new(@data);
209
        $label->set_alignment( 0, 0.5 );
210
        return $label;
211
 
212
}
213
 
214
 
215
sub box_label{
216
        my( $homogeneous, $spacing, $name)=@_;
217
        my $box=def_hbox($homogeneous, $spacing);
218
        my $label= def_label($name);
219
        $box->pack_start( $label, FALSE, FALSE, 3);
220
        return $box;
221
}
222
 
223
 
224
sub def_title_box{
225
        my( $homogeneous, $spacing, @labels)=@_;
226
        my $box=def_hbox($homogeneous, $spacing);
227
        foreach my $label (@labels){
228
                my $labelbox=box_label($homogeneous, $spacing, $label);
229
                $box->pack_start( $labelbox, FALSE, FALSE, 3);
230
 
231
        }
232
        return $box;
233
}
234
 
235
 
236
sub gen_label_help {
237
        my ($help, $label_name)= @_;
238
        my $box = def_hbox(FALSE, 0);
239
        my $label= gen_label_in_left($label_name);
240
        my $button=def_image_button("icons/help.png");
241
 
242
        $button->signal_connect("clicked" => sub {message_dialog($help);});
243
 
244
        $box->pack_start( $label, FALSE, FALSE, 0);
245
        $box->pack_start( $button, FALSE, FALSE, 0);
246
        $box->set_spacing (0);
247
        $box->show_all;
248
 
249
        return $box;
250
 
251
 
252
}
253
 
254
 
255
 
256
 
257
##############
258
# button
259
#############
260
 
261
 
262
sub button_box{
263
# create a new button
264
        my @label=@_;
265
        my $button = Gtk2::Button->new_from_stock(@label);
266
        my $box=def_hbox(TRUE,5);
267
        $box->pack_start($button,   FALSE, FALSE,0);
268
 
269
        return ($box,$button);
270
 
271
}
272
 
273
 
274
sub def_image{
275
        my $image_file=shift;
276
        my $font_size=get_deafualt_font_size();
277
        my $size=($font_size==10)? 25:
278
                     ($font_size==9 )? 22:
279
                         ($font_size==8 )? 18:
280
                         ($font_size==7 )? 15:12 ;
281
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
282
 
283
 
284
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
285
        return $image;
286
 
287
}
288
 
289
 
290
 
291
sub def_image_button{
292
        my ($image_file, $label_text)=@_;
293
        # create box for image and label 
294
        my $box = def_hbox(FALSE,0);
295
        my $image = def_image($image_file);
296
 
297
 
298
        # now on to the image stuff
299
        #my $image = Gtk2::Image->new_from_file($image_file);
300
        $box->pack_start($image, FALSE, FALSE, 0);
301
        $box->set_border_width(0);
302
        $box->set_spacing (0);
303
        # Create a label for the button
304
        if(defined $label_text ) {
305
                my $label = Gtk2::Label->new("  $label_text");
306
                $box->pack_start($label, FALSE, FALSE, 0);
307
        }
308
 
309
 
310
        my $button = Gtk2::Button->new();
311
        $button->add($box);
312
        $button->set_border_width(0);
313
        $button->show_all;
314
        return $button;
315
 
316
}
317
 
318
 
319
sub def_image_label{
320
        my ($image_file, $label_text)=@_;
321
        # create box for image and label 
322
        my $box = def_hbox(FALSE,1);
323
        # now on to the image stuff
324
        my $image = def_image($image_file);
325
        $box->pack_start($image, TRUE, FALSE, 0);
326
        # Create a label for the button
327
        if(defined $label_text ) {
328
                my $label = Gtk2::Label->new($label_text);
329
                $box->pack_start($label, TRUE, FALSE, 0);
330
        }
331
 
332
        return $box;
333
 
334
}
335
 
336
 
337
sub gen_button_message {
338
        my ($help, $image_file,$label_name)= @_;
339
        my $box = def_hbox(FALSE, 0);
340
        my $label= gen_label_in_center($label_name) if(defined $label_name);
341
        my $button=def_image_button($image_file);
342
 
343
        if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
344
 
345
        $box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
346
        $box->pack_start( $button, FALSE, FALSE, 0);
347
        $box->set_border_width(0);
348
        $box->set_spacing (0);
349
        $box->show_all;
350
 
351
        return $box;
352
 
353
 
354
}
355
 
356
 
357
sub def_colored_button{
358
        my ($label_text,$color_num)=@_;
359
        # create box for image and label 
360
        my $box = def_hbox(FALSE,0);
361
        my $font_size=get_deafualt_font_size();
362
        my $size=($font_size==10)? 25:
363
                     ($font_size==9 )? 22:
364
                         ($font_size==8 )? 18:
365
                         ($font_size==7 )? 15:12 ;
366
        $box->set_border_width(0);
367
        $box->set_spacing (0);
368
        # Create a label for the button
369
        if(defined $label_text ) {
370
                my $label = gen_label_in_center("$label_text");
371
                $box->pack_start($label, TRUE, TRUE, 0);
372
        }
373
        my @clr_code=get_color($color_num);
374
        my $color = Gtk2::Gdk::Color->new (@clr_code);
375
 
376
        my $button = Gtk2::Button->new();
377
        $button->modify_bg('normal',$color);
378
        $button->add($box);
379
        $button->set_border_width(0);
380
        $button->show_all;
381
        return $button;
382
 
383
}
384
 
385
 
386
 
387
 
388
 
389
 
390
 
391
############
392
#       message_dialog
393
############
394
 
395
sub message_dialog {
396
  my @message=@_;
397
  my $window;
398
  my $dialog = Gtk2::MessageDialog->new ($window,
399
                                   [qw/modal destroy-with-parent/],
400
                                   'info',
401
                                   'ok',
402
                                    @message);
403
  $dialog->run;
404
  $dialog->destroy;
405
 
406
}
407
 
408
 
409
############
410
# window
411
###########
412
 
413
sub def_win {
414
        my @titel=shift;
415
        my $window = Gtk2::Window->new('toplevel');
416
        $window->set_title(@titel);
417
        $window->set_position("center");
418
        $window->set_default_size(100, 100);
419
        $window->set_border_width(20);
420
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
421
        return $window;
422
 
423
}
424
 
425
 
426
sub def_win_size {
427
        my $x=shift;
428
        my $y=shift;
429
        my @titel=shift;
430
        my $window = Gtk2::Window->new('toplevel');
431
        $window->set_title(@titel);
432
        $window->set_position("center");
433
        $window->set_default_size($x, $y);
434
        $window->set_border_width(20);
435
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
436
        return $window;
437
 
438
}
439
 
440
 
441
sub def_popwin_size {
442
        my $x=shift;
443
        my $y=shift;
444
        my @titel=shift;
445
        #my $window = Gtk2::Window->new('popup');
446
        my $window = Gtk2::Window->new('toplevel');
447
        $window->set_title(@titel);
448
        $window->set_position("center");
449
        $window->set_default_size($x, $y);
450
        $window->set_border_width(20);
451
        $window->signal_connect (delete_event => sub { $window->destroy });
452
        return $window;
453
 
454
}
455
 
456
 
457
sub def_scrolled_window_box{
458
 
459
        my $window =  def_popwin_size(@_);
460
        my $box=def_vbox(TRUE,5);
461
        my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
462
        $scrolled_window->set_policy( "automatic", "automatic" );
463
        $scrolled_window->add_with_viewport($box);
464
 
465
 
466
 
467
        $window->add($scrolled_window);
468
        $window->show_all;
469
        $box->show_all;
470
 
471
        return ($box,$window);
472
 
473
}
474
 
475
sub max_win_size{
476
        my $screen =Gtk2::Gdk::Screen->get_default();
477
        my $hight = $screen->get_height();
478
        my $width = $screen->get_width();
479
        return ($width,$hight);
480
}
481
 
482
 
483
sub get_deafualt_font_size{
484
        my($width,$hight)=max_win_size();
485
        #print "($width,$hight)\n";
486
        my $font_size=($width>=1600)? 10:
487
                              ($width>=1400)? 9:
488
                                  ($width>=1200)? 8:
489
                                  ($width>=1000)? 7:6;
490
        return $font_size;
491
}
492
 
493
 
494
sub set_deafualt_font_size{
495
        my $font_size=get_deafualt_font_size();
496
        if($font_size==10){
497
                Gtk2::Rc->parse_string(<<__);
498
                        style "normal" {
499
                                font_name ="Verdana 10"
500
                        }
501
                        widget "*" style "normal"
502
__
503
 
504
        }
505
        elsif ($font_size==9){
506
                $font_size=9;
507
                Gtk2::Rc->parse_string(<<__);
508
                style "normal" {
509
                                font_name ="Verdana 9"
510
                        }
511
                        widget "*" style "normal"
512
__
513
 
514
        }
515
        elsif ($font_size==8){
516
                $font_size=8;
517
                Gtk2::Rc->parse_string(<<__);
518
                style "normal" {
519
                                font_name ="Verdana 8"
520
                        }
521
                        widget "*" style "normal"
522
__
523
 
524
        }
525
        elsif ($font_size==7){
526
            $font_size=7;
527
                Gtk2::Rc->parse_string(<<__);
528
                style "normal" {
529
                                font_name ="Verdana 7"
530
                        }
531
                        widget "*" style "normal"
532
__
533
 
534
        }
535
        else{
536
                Gtk2::Rc->parse_string(<<__);
537
                style "normal" {
538
                                font_name ="Verdana 6"
539
                        }
540
                        widget "*" style "normal"
541
__
542
 
543
        }
544
 
545
 
546
 
547
}
548
 
549
 
550
##############
551
#       box
552
#############
553
 
554
sub def_hbox {
555
        my( $homogeneous, $spacing)=@_;
556
        my $box = Gtk2::HBox->new($homogeneous, $spacing);
557
        $box->set_border_width(2);
558
        return $box;
559
}
560
 
561
sub def_vbox {
562
        my $box = Gtk2::VBox->new(FALSE, 0);
563
        $box->set_border_width(2);
564
        return $box;
565
}
566
 
567
sub def_pack_hbox{
568
        my( $homogeneous, $spacing , @box_list)=@_;
569
        my $box=def_hbox($homogeneous, $spacing);
570
        foreach my $subbox (@box_list){
571
                $box->pack_start( $subbox, FALSE, FALSE, 3);
572
        }
573
        return $box;
574
 
575
 
576
}
577
 
578
 
579
 
580
#############
581
# text_view 
582
############
583
 
584
sub create_text {
585
  my $scrolled_window = Gtk2::ScrolledWindow->new;
586
  $scrolled_window->set_policy ('automatic', 'automatic');
587
  $scrolled_window->set_shadow_type ('in');
588
  my $tview = Gtk2::TextView->new();
589
  $scrolled_window->add ($tview);
590
  $tview->show_all;
591
  # Make it a bit nicer for text.
592
  $tview->set_wrap_mode ('word');
593
  $tview->set_pixels_above_lines (2);
594
  $tview->set_pixels_below_lines (2);
595
  return ($scrolled_window,$tview);
596
}
597
 
598
 
599
#################
600
#       table
601
################
602
 
603
sub def_table{
604
        my ($row,$col,$homogeneous)=@_;
605
        my $table = Gtk2::Table->new ($row, $col, $homogeneous);
606
        $table->set_row_spacings (0);
607
        $table->set_col_spacings (0);
608
        return $table;
609
 
610
}
611
 
612
 
613
 
614
 
615
 
616
 
617
######
618
#  state
619
#####
620
 
621
sub def_state{
622
        my ($initial)=@_;
623
        my $entry = Gtk2::Entry->new;
624
        $entry->set_text($initial);
625
        my $timeout=0;
626
        my @state= ($entry,$timeout);
627
        return \@state
628
 
629
}
630
 
631
sub set_state{
632
        my ($state,$initial,$timeout)=@_;
633
        my ($entry,$time_out)=@{$state};
634
        $entry->set_text($initial);
635
        @{$state}[1]=$timeout;
636
 
637
}
638
 
639
 
640
sub get_state{
641
        my ($state)=@_;
642
        my ($entry,$time_out)=@{$state};
643
        my $st;
644
        $st=$entry->get_text();
645
        return ($st,$time_out);
646
}
647
 
648
 
649
 
650
 
651
##################
652
#       show_info
653
##################
654
sub show_info{
655
        my ($textview_ref,$info)=@_;
656
        my $buffer = $$textview_ref->get_buffer();
657
        $buffer->set_text($info);
658
}
659
 
660
 
661
 
662
####################
663
#       read verilog file
664
##################
665
 
666
 
667
sub read_file{
668
        my @files            = @_;
669
        my %cmd_line_defines = ();
670
        my $quiet            = 1;
671
        my @inc_dirs         = ();
672
        my @lib_dirs         = ();
673
        my @lib_exts         = ();
674
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
675
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
676
 
677
        my @problems = $vdb->get_problems();
678
        if (@problems) {
679
            foreach my $problem ($vdb->get_problems()) {
680
                print STDERR "$problem.\n";
681
            }
682
            # die "Warnings parsing files!";
683
        }
684
 
685
        return $vdb;
686
}
687
 
688
 
689
sub get_color {
690
        my $num=shift;
691
 
692
        my @colors=(
693
        0x6495ED,#Cornflower Blue
694
        0xFAEBD7,#Antiquewhite
695
        0xC71585,#Violet Red
696
        0xC0C0C0, #silver
697
        0xADD8E6,#Lightblue     
698
        0x6A5ACD,#Slate Blue
699
        0x00CED1,#Dark Turquoise
700
        0x008080,#Teal
701
        0x2E8B57,#SeaGreen
702
        0xFFB6C1,#Light Pink
703
        0x008000,#Green
704
        0xFF0000,#red
705
        0x808080,#Gray
706
        0x808000,#Olive
707
        0xFF69B4,#Hot Pink
708
        0xFFD700,#Gold
709
        0xDAA520,#Goldenrod
710
        0xFFA500,#Orange
711
        0x32CD32,#LimeGreen
712
        0x0000FF,#Blue
713
        0xFF8C00,#DarkOrange
714
        0xA0522D,#Sienna
715
        0xFF6347,#Tomato
716
        0x0000CD,#Medium Blue
717
        0xFF4500,#OrangeRed
718
        0xDC143C,#Crimson       
719
        0x9932CC,#Dark Orchid
720
        0x800000,#marron
721
        0x800080,#Purple
722
        0x4B0082,#Indigo
723
        0xFFFFFF #white                 
724
                );
725
 
726
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
727
        my $red=        ($color & 0xFF0000) >> 8;
728
        my $green=      ($color & 0x00FF00);
729
        my $blue=       ($color & 0x0000FF) << 8;
730
 
731
        return ($red,$green,$blue);
732
 
733
}
734
 
735
 
736
 
737
 
738
##############
739
#  clone_obj
740
#############
741
 
742
sub clone_obj{
743
        my ($self,$clone)=@_;
744
 
745
        foreach my $p (keys %$self){
746
                delete ($self->{$p});
747
        }
748
        foreach my $p (keys %$clone){
749
                $self->{$p}= $clone->{$p};
750
                my $ref= ref ($clone->{$p});
751
                if( $ref eq 'HASH' ){
752
 
753
                        foreach my $q (keys %{$clone->{$p}}){
754
                                $self->{$p}{$q}= $clone->{$p}{$q};
755
                                my $ref= ref ($self->{$p}{$q});
756
                                if( $ref eq 'HASH' ){
757
 
758
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
759
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
760
                                                my $ref= ref ($self->{$p}{$q}{$z});
761
                                                if( $ref eq 'HASH' ){
762
 
763
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$q}}){
764
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
765
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
766
                                                                if( $ref eq 'HASH' ){
767
 
768
 
769
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$q}{$w}}){
770
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
771
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
772
                                                                                if( $ref eq 'HASH' ){
773
 
774
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$q}{$w}{$m}}){
775
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
776
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
777
                                                                                                if( $ref eq 'HASH' ){
778
 
779
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$q}{$w}{$m}{$n}}){
780
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
781
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
782
                                                                                                                if( $ref eq 'HASH' ){
783
                                                                                                                }
784
                                                                                                        }
785
 
786
                                                                                                }#if                                                                                                            
787
                                                                                        }#n
788
                                                                                }#if
789
                                                                        }#m                                                     
790
                                                                }#if
791
                                                        }#w
792
                                                }#if
793
                                        }#z
794
                                }#if
795
                        }#q
796
                }#if    
797
        }#p
798
}#sub   
799
 
800
 
801
################
802
#       general
803
#################
804
 
805
 
806
 
807
 
808
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
809
 
810
sub remove_all_white_spaces($)
811
{
812
  my $string = shift;
813
  $string =~ s/\s+//g;
814
  return $string;
815
}
816
 
817
 
818
 
819
 
820
sub get_scolar_pos{
821
        my ($item,@list)=@_;
822
        my $pos;
823
        my $i=0;
824
        foreach my $c (@list)
825
        {
826
                if(  $c eq $item) {$pos=$i}
827
                $i++;
828
        }
829
        return $pos;
830
}
831
 
832
sub remove_scolar_from_array{
833
        my ($array_ref,$item)=@_;
834
        my @array=@{$array_ref};
835
        my @new;
836
        foreach my $p (@array){
837
                if($p ne $item ){
838
                        push(@new,$p);
839
                }
840
        }
841
        return @new;
842
}
843
 
844
sub replace_in_array{
845
        my ($array_ref,$item1,$item2)=@_;
846
        my @array=@{$array_ref};
847
        my @new;
848
        foreach my $p (@array){
849
                if($p eq $item1 ){
850
                        push(@new,$item2);
851
                }else{
852
                        push(@new,$p);
853
                }
854
        }
855
        return @new;
856
}
857
 
858
 
859
 
860
# return an array of common elemnts between two input arays 
861
sub get_common_array{
862
        my ($a_ref,$b_ref)=@_;
863
        my @A=@{$a_ref};
864
        my @B=@{$b_ref};
865
        my @C;
866
        foreach my $p (@A){
867
                if( grep (/^$p$/,@B)){push(@C,$p)};
868
        }
869
        return  @C;
870
}
871
 
872
#a-b
873
sub get_diff_array{
874
        my ($a_ref,$b_ref)=@_;
875
        my @A=@{$a_ref};
876
        my @B=@{$b_ref};
877
        my @C;
878
        foreach my $p (@A){
879
                if( !grep (/^$p$/,@B)){push(@C,$p)};
880
        }
881
        return  @C;
882
 
883
}
884
 
885
 
886
 
887
sub compress_nums{
888
        my      @nums=@_;
889
        my @f=sort { $a <=> $b } @nums;
890
        my $s;
891
        my $ls;
892
        my $range=0;
893
        my $x;
894
 
895
 
896
        foreach my $p (@f){
897
                if(!defined $x) {
898
                        $s="$p";
899
                        $ls=$p;
900
 
901
                }
902
                else{
903
                        if($p-$x>1){ #gap exist
904
                                if( $range){
905
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
906
                                        $ls=$p;
907
                                        $range=0;
908
                                }else{
909
                                $s= "$s,$p";
910
                                $ls=$p;
911
 
912
                                }
913
 
914
                        }else {$range=1;}
915
 
916
 
917
 
918
                }
919
 
920
                $x=$p
921
        }
922
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
923
        #update $s($ls,$hs);
924
 
925
        return $s;
926
 
927
}
928
 
929
 
930 24 alirezamon
sub copy_file_and_folders{
931
        my ($file_ref,$project_dir,$target_dir)=@_;
932
 
933
        foreach my $f(@{$file_ref}){
934
                my $name= basename($f);
935
                my $n="$project_dir$f";
936
                if (-f "$n") { #copy file
937
                        copy ("$n","$target_dir");
938
                }elsif(-f "$f" ){
939
                        copy ("$f","$target_dir");
940
                }elsif (-d "$n") {#copy folder
941
                        dircopy ("$n","$target_dir/$name");
942
                }elsif(-d "$f" ){
943
                        dircopy ("$f","$target_dir/$name");
944
 
945
                }
946
        }
947
 
948
}
949
 
950
sub read_file_cntent {
951
        my ($f,$project_dir)=@_;
952
        my $n="$project_dir$f";
953
        my $str;
954
        if (-f "$n") { #copy file
955
 
956
                $str = do {
957
                        local $/ = undef;
958
                        open my $fh, "<", $n
959
                        or die "could not open $n: $!";
960
                        <$fh>;
961
                };
962
 
963
        }elsif(-f "$f" ){
964
                $str = do {
965
                        local $/ = undef;
966
                        open my $fh, "<", $f
967
                        or die "could not open $f: $!";
968
                        <$fh>;
969
                };
970
 
971
 
972
        }
973
        return $str
974
 
975
}
976
 
977
 
978
sub metric_conversion{
979
        my $size=shift;
980
        my $size_text=  $size==0  ? 'Error':
981
                        $size<(1 << 10)? $size:
982
                        $size<(1 << 20)? join (' ', ($size>>10,"K")) :
983
                        $size<(1 << 30)? join (' ', ($size>>20,"M")) :
984
                                         join (' ', ($size>>30,"G")) ;
985
return $size_text;
986
}
987
 
988 16 alirezamon
1

powered by: WebSVN 2.1.0

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