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 16

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
}
139
 
140
 
141
#############
142
#  label
143
############
144
 
145
sub gen_label_in_left{
146
        my ($data)=@_;
147
        my $label   = Gtk2::Label->new($data);
148
        $label->set_alignment( 0, 0.5 );
149
        #my $font = Gtk2::Pango::FontDescription->from_string('Tahoma 5');
150
        #$label->modify_font($font);
151
        return $label;
152
}
153
 
154
 
155
sub gen_label_in_center{
156
        my ($data)=@_;
157
        my $label   = Gtk2::Label->new($data);
158
        return $label;
159
}
160
 
161
sub def_label{
162
        my @data=@_;
163
        my $label   = Gtk2::Label->new(@data);
164
        $label->set_alignment( 0, 0.5 );
165
        return $label;
166
 
167
}
168
 
169
 
170
sub box_label{
171
        my( $homogeneous, $spacing, $name)=@_;
172
        my $box=def_hbox($homogeneous, $spacing);
173
        my $label= def_label($name);
174
        $box->pack_start( $label, FALSE, FALSE, 3);
175
        return $box;
176
}
177
 
178
 
179
sub def_title_box{
180
        my( $homogeneous, $spacing, @labels)=@_;
181
        my $box=def_hbox($homogeneous, $spacing);
182
        foreach my $label (@labels){
183
                my $labelbox=box_label($homogeneous, $spacing, $label);
184
                $box->pack_start( $labelbox, FALSE, FALSE, 3);
185
 
186
        }
187
        return $box;
188
}
189
 
190
 
191
sub gen_label_help {
192
        my ($help, $label_name)= @_;
193
        my $box = def_hbox(FALSE, 0);
194
        my $label= gen_label_in_left($label_name);
195
        my $button=def_image_button("icons/help.png");
196
 
197
        $button->signal_connect("clicked" => sub {message_dialog($help);});
198
 
199
        $box->pack_start( $label, FALSE, FALSE, 0);
200
        $box->pack_start( $button, FALSE, FALSE, 0);
201
        $box->set_spacing (0);
202
        $box->show_all;
203
 
204
        return $box;
205
 
206
 
207
}
208
 
209
 
210
 
211
 
212
##############
213
# button
214
#############
215
 
216
 
217
sub button_box{
218
# create a new button
219
        my @label=@_;
220
        my $button = Gtk2::Button->new_from_stock(@label);
221
        my $box=def_hbox(TRUE,5);
222
        $box->pack_start($button,   FALSE, FALSE,0);
223
 
224
        return ($box,$button);
225
 
226
}
227
 
228
 
229
sub def_image{
230
        my $image_file=shift;
231
        my $font_size=get_deafualt_font_size();
232
        my $size=($font_size==10)? 25:
233
                     ($font_size==9 )? 22:
234
                         ($font_size==8 )? 18:
235
                         ($font_size==7 )? 15:12 ;
236
        my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file_at_scale($image_file,$size,$size,FALSE);
237
 
238
 
239
        my $image = Gtk2::Image->new_from_pixbuf($pixbuf);
240
        return $image;
241
 
242
}
243
 
244
 
245
 
246
sub def_image_button{
247
        my ($image_file, $label_text)=@_;
248
        # create box for image and label 
249
        my $box = def_hbox(FALSE,0);
250
        my $image = def_image($image_file);
251
 
252
 
253
        # now on to the image stuff
254
        #my $image = Gtk2::Image->new_from_file($image_file);
255
        $box->pack_start($image, FALSE, FALSE, 0);
256
        $box->set_border_width(0);
257
        $box->set_spacing (0);
258
        # Create a label for the button
259
        if(defined $label_text ) {
260
                my $label = Gtk2::Label->new("  $label_text");
261
                $box->pack_start($label, FALSE, FALSE, 0);
262
        }
263
 
264
 
265
        my $button = Gtk2::Button->new();
266
        $button->add($box);
267
        $button->set_border_width(0);
268
        $button->show_all;
269
        return $button;
270
 
271
}
272
 
273
 
274
sub def_image_label{
275
        my ($image_file, $label_text)=@_;
276
        # create box for image and label 
277
        my $box = def_hbox(FALSE,1);
278
        # now on to the image stuff
279
        my $image = def_image($image_file);
280
        $box->pack_start($image, TRUE, FALSE, 0);
281
        # Create a label for the button
282
        if(defined $label_text ) {
283
                my $label = Gtk2::Label->new($label_text);
284
                $box->pack_start($label, TRUE, FALSE, 0);
285
        }
286
 
287
        return $box;
288
 
289
}
290
 
291
 
292
sub gen_button_message {
293
        my ($help, $image_file,$label_name)= @_;
294
        my $box = def_hbox(FALSE, 0);
295
        my $label= gen_label_in_center($label_name) if(defined $label_name);
296
        my $button=def_image_button($image_file);
297
 
298
        if(defined $help ){$button->signal_connect("clicked" => sub {message_dialog($help);});}
299
 
300
        $box->pack_start( $label, FALSE, FALSE, 0) if(defined $label_name);
301
        $box->pack_start( $button, FALSE, FALSE, 0);
302
        $box->set_border_width(0);
303
        $box->set_spacing (0);
304
        $box->show_all;
305
 
306
        return $box;
307
 
308
 
309
}
310
 
311
 
312
sub def_colored_button{
313
        my ($label_text,$color_num)=@_;
314
        # create box for image and label 
315
        my $box = def_hbox(FALSE,0);
316
        my $font_size=get_deafualt_font_size();
317
        my $size=($font_size==10)? 25:
318
                     ($font_size==9 )? 22:
319
                         ($font_size==8 )? 18:
320
                         ($font_size==7 )? 15:12 ;
321
        $box->set_border_width(0);
322
        $box->set_spacing (0);
323
        # Create a label for the button
324
        if(defined $label_text ) {
325
                my $label = gen_label_in_center("$label_text");
326
                $box->pack_start($label, TRUE, TRUE, 0);
327
        }
328
        my @clr_code=get_color($color_num);
329
        my $color = Gtk2::Gdk::Color->new (@clr_code);
330
 
331
        my $button = Gtk2::Button->new();
332
        $button->modify_bg('normal',$color);
333
        $button->add($box);
334
        $button->set_border_width(0);
335
        $button->show_all;
336
        return $button;
337
 
338
}
339
 
340
 
341
 
342
 
343
 
344
 
345
 
346
############
347
#       message_dialog
348
############
349
 
350
sub message_dialog {
351
  my @message=@_;
352
  my $window;
353
  my $dialog = Gtk2::MessageDialog->new ($window,
354
                                   [qw/modal destroy-with-parent/],
355
                                   'info',
356
                                   'ok',
357
                                    @message);
358
  $dialog->run;
359
  $dialog->destroy;
360
 
361
}
362
 
363
 
364
############
365
# window
366
###########
367
 
368
sub def_win {
369
        my @titel=shift;
370
        my $window = Gtk2::Window->new('toplevel');
371
        $window->set_title(@titel);
372
        $window->set_position("center");
373
        $window->set_default_size(100, 100);
374
        $window->set_border_width(20);
375
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
376
        return $window;
377
 
378
}
379
 
380
 
381
sub def_win_size {
382
        my $x=shift;
383
        my $y=shift;
384
        my @titel=shift;
385
        my $window = Gtk2::Window->new('toplevel');
386
        $window->set_title(@titel);
387
        $window->set_position("center");
388
        $window->set_default_size($x, $y);
389
        $window->set_border_width(20);
390
        $window->signal_connect (delete_event => sub { Gtk2->main_quit });
391
        return $window;
392
 
393
}
394
 
395
 
396
sub def_popwin_size {
397
        my $x=shift;
398
        my $y=shift;
399
        my @titel=shift;
400
        #my $window = Gtk2::Window->new('popup');
401
        my $window = Gtk2::Window->new('toplevel');
402
        $window->set_title(@titel);
403
        $window->set_position("center");
404
        $window->set_default_size($x, $y);
405
        $window->set_border_width(20);
406
        $window->signal_connect (delete_event => sub { $window->destroy });
407
        return $window;
408
 
409
}
410
 
411
 
412
sub def_scrolled_window_box{
413
 
414
        my $window =  def_popwin_size(@_);
415
        my $box=def_vbox(TRUE,5);
416
        my $scrolled_window = new Gtk2::ScrolledWindow (undef, undef);
417
        $scrolled_window->set_policy( "automatic", "automatic" );
418
        $scrolled_window->add_with_viewport($box);
419
 
420
 
421
 
422
        $window->add($scrolled_window);
423
        $window->show_all;
424
        $box->show_all;
425
 
426
        return ($box,$window);
427
 
428
}
429
 
430
sub max_win_size{
431
        my $screen =Gtk2::Gdk::Screen->get_default();
432
        my $hight = $screen->get_height();
433
        my $width = $screen->get_width();
434
        return ($width,$hight);
435
}
436
 
437
 
438
sub get_deafualt_font_size{
439
        my($width,$hight)=max_win_size();
440
        #print "($width,$hight)\n";
441
        my $font_size=($width>=1600)? 10:
442
                              ($width>=1400)? 9:
443
                                  ($width>=1200)? 8:
444
                                  ($width>=1000)? 7:6;
445
        return $font_size;
446
}
447
 
448
 
449
sub set_deafualt_font_size{
450
        my $font_size=get_deafualt_font_size();
451
        if($font_size==10){
452
                Gtk2::Rc->parse_string(<<__);
453
                        style "normal" {
454
                                font_name ="Verdana 10"
455
                        }
456
                        widget "*" style "normal"
457
__
458
 
459
        }
460
        elsif ($font_size==9){
461
                $font_size=9;
462
                Gtk2::Rc->parse_string(<<__);
463
                style "normal" {
464
                                font_name ="Verdana 9"
465
                        }
466
                        widget "*" style "normal"
467
__
468
 
469
        }
470
        elsif ($font_size==8){
471
                $font_size=8;
472
                Gtk2::Rc->parse_string(<<__);
473
                style "normal" {
474
                                font_name ="Verdana 8"
475
                        }
476
                        widget "*" style "normal"
477
__
478
 
479
        }
480
        elsif ($font_size==7){
481
            $font_size=7;
482
                Gtk2::Rc->parse_string(<<__);
483
                style "normal" {
484
                                font_name ="Verdana 7"
485
                        }
486
                        widget "*" style "normal"
487
__
488
 
489
        }
490
        else{
491
                Gtk2::Rc->parse_string(<<__);
492
                style "normal" {
493
                                font_name ="Verdana 6"
494
                        }
495
                        widget "*" style "normal"
496
__
497
 
498
        }
499
 
500
 
501
 
502
}
503
 
504
 
505
##############
506
#       box
507
#############
508
 
509
sub def_hbox {
510
        my( $homogeneous, $spacing)=@_;
511
        my $box = Gtk2::HBox->new($homogeneous, $spacing);
512
        $box->set_border_width(2);
513
        return $box;
514
}
515
 
516
sub def_vbox {
517
        my $box = Gtk2::VBox->new(FALSE, 0);
518
        $box->set_border_width(2);
519
        return $box;
520
}
521
 
522
sub def_pack_hbox{
523
        my( $homogeneous, $spacing , @box_list)=@_;
524
        my $box=def_hbox($homogeneous, $spacing);
525
        foreach my $subbox (@box_list){
526
                $box->pack_start( $subbox, FALSE, FALSE, 3);
527
        }
528
        return $box;
529
 
530
 
531
}
532
 
533
 
534
 
535
#############
536
# text_view 
537
############
538
 
539
sub create_text {
540
  my $scrolled_window = Gtk2::ScrolledWindow->new;
541
  $scrolled_window->set_policy ('automatic', 'automatic');
542
  $scrolled_window->set_shadow_type ('in');
543
  my $tview = Gtk2::TextView->new();
544
  $scrolled_window->add ($tview);
545
  $tview->show_all;
546
  # Make it a bit nicer for text.
547
  $tview->set_wrap_mode ('word');
548
  $tview->set_pixels_above_lines (2);
549
  $tview->set_pixels_below_lines (2);
550
  return ($scrolled_window,$tview);
551
}
552
 
553
 
554
#################
555
#       table
556
################
557
 
558
sub def_table{
559
        my ($row,$col,$homogeneous)=@_;
560
        my $table = Gtk2::Table->new ($row, $col, $homogeneous);
561
        $table->set_row_spacings (0);
562
        $table->set_col_spacings (0);
563
        return $table;
564
 
565
}
566
 
567
 
568
 
569
 
570
 
571
 
572
######
573
#  state
574
#####
575
 
576
sub def_state{
577
        my ($initial)=@_;
578
        my $entry = Gtk2::Entry->new;
579
        $entry->set_text($initial);
580
        my $timeout=0;
581
        my @state= ($entry,$timeout);
582
        return \@state
583
 
584
}
585
 
586
sub set_state{
587
        my ($state,$initial,$timeout)=@_;
588
        my ($entry,$time_out)=@{$state};
589
        $entry->set_text($initial);
590
        @{$state}[1]=$timeout;
591
 
592
}
593
 
594
 
595
sub get_state{
596
        my ($state)=@_;
597
        my ($entry,$time_out)=@{$state};
598
        my $st;
599
        $st=$entry->get_text();
600
        return ($st,$time_out);
601
}
602
 
603
 
604
 
605
 
606
##################
607
#       show_info
608
##################
609
sub show_info{
610
        my ($textview_ref,$info)=@_;
611
        my $buffer = $$textview_ref->get_buffer();
612
        $buffer->set_text($info);
613
}
614
 
615
 
616
 
617
####################
618
#       read verilog file
619
##################
620
 
621
 
622
sub read_file{
623
        my @files            = @_;
624
        my %cmd_line_defines = ();
625
        my $quiet            = 1;
626
        my @inc_dirs         = ();
627
        my @lib_dirs         = ();
628
        my @lib_exts         = ();
629
        my $vdb = rvp->read_verilog(\@files,[],\%cmd_line_defines,
630
                          $quiet,\@inc_dirs,\@lib_dirs,\@lib_exts);
631
 
632
        my @problems = $vdb->get_problems();
633
        if (@problems) {
634
            foreach my $problem ($vdb->get_problems()) {
635
                print STDERR "$problem.\n";
636
            }
637
            # die "Warnings parsing files!";
638
        }
639
 
640
        return $vdb;
641
}
642
 
643
 
644
sub get_color {
645
        my $num=shift;
646
 
647
        my @colors=(
648
        0x6495ED,#Cornflower Blue
649
        0xFAEBD7,#Antiquewhite
650
        0xC71585,#Violet Red
651
        0xC0C0C0, #silver
652
        0xADD8E6,#Lightblue     
653
        0x6A5ACD,#Slate Blue
654
        0x00CED1,#Dark Turquoise
655
        0x008080,#Teal
656
        0x2E8B57,#SeaGreen
657
        0xFFB6C1,#Light Pink
658
        0x008000,#Green
659
        0xFF0000,#red
660
        0x808080,#Gray
661
        0x808000,#Olive
662
        0xFF69B4,#Hot Pink
663
        0xFFD700,#Gold
664
        0xDAA520,#Goldenrod
665
        0xFFA500,#Orange
666
        0x32CD32,#LimeGreen
667
        0x0000FF,#Blue
668
        0xFF8C00,#DarkOrange
669
        0xA0522D,#Sienna
670
        0xFF6347,#Tomato
671
        0x0000CD,#Medium Blue
672
        0xFF4500,#OrangeRed
673
        0xDC143C,#Crimson       
674
        0x9932CC,#Dark Orchid
675
        0x800000,#marron
676
        0x800080,#Purple
677
        0x4B0082,#Indigo
678
        0xFFFFFF #white                 
679
                );
680
 
681
        my $color=      ($num< scalar (@colors))? $colors[$num]: 0xFFFFFF;
682
        my $red=        ($color & 0xFF0000) >> 8;
683
        my $green=      ($color & 0x00FF00);
684
        my $blue=       ($color & 0x0000FF) << 8;
685
 
686
        return ($red,$green,$blue);
687
 
688
}
689
 
690
 
691
 
692
 
693
##############
694
#  clone_obj
695
#############
696
 
697
sub clone_obj{
698
        my ($self,$clone)=@_;
699
 
700
        foreach my $p (keys %$self){
701
                delete ($self->{$p});
702
        }
703
        foreach my $p (keys %$clone){
704
                $self->{$p}= $clone->{$p};
705
                my $ref= ref ($clone->{$p});
706
                if( $ref eq 'HASH' ){
707
 
708
                        foreach my $q (keys %{$clone->{$p}}){
709
                                $self->{$p}{$q}= $clone->{$p}{$q};
710
                                my $ref= ref ($self->{$p}{$q});
711
                                if( $ref eq 'HASH' ){
712
 
713
                                        foreach my $z (keys %{$clone->{$p}{$q}}){
714
                                                $self->{$p}{$q}{$z}= $clone->{$p}{$q}{$z};
715
                                                my $ref= ref ($self->{$p}{$q}{$z});
716
                                                if( $ref eq 'HASH' ){
717
 
718
                                                        foreach my $w (keys %{$clone->{$p}{$q}{$q}}){
719
                                                                $self->{$p}{$q}{$z}{$w}= $clone->{$p}{$q}{$z}{$w};
720
                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w});
721
                                                                if( $ref eq 'HASH' ){
722
 
723
 
724
                                                                        foreach my $m (keys %{$clone->{$p}{$q}{$q}{$w}}){
725
                                                                                $self->{$p}{$q}{$z}{$w}{$m}= $clone->{$p}{$q}{$z}{$w}{$m};
726
                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m});
727
                                                                                if( $ref eq 'HASH' ){
728
 
729
                                                                                        foreach my $n (keys %{$clone->{$p}{$q}{$q}{$w}{$m}}){
730
                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}= $clone->{$p}{$q}{$z}{$w}{$m}{$n};
731
                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n});
732
                                                                                                if( $ref eq 'HASH' ){
733
 
734
                                                                                                        foreach my $l (keys %{$clone->{$p}{$q}{$q}{$w}{$m}{$n}}){
735
                                                                                                                $self->{$p}{$q}{$z}{$w}{$m}{$n}{$l}= $clone->{$p}{$q}{$z}{$w}{$m}{$n}{$l};
736
                                                                                                                my $ref= ref ($self->{$p}{$q}{$z}{$w}{$m}{$n}{$l});
737
                                                                                                                if( $ref eq 'HASH' ){
738
                                                                                                                }
739
                                                                                                        }
740
 
741
                                                                                                }#if                                                                                                            
742
                                                                                        }#n
743
                                                                                }#if
744
                                                                        }#m                                                     
745
                                                                }#if
746
                                                        }#w
747
                                                }#if
748
                                        }#z
749
                                }#if
750
                        }#q
751
                }#if    
752
        }#p
753
}#sub   
754
 
755
 
756
################
757
#       general
758
#################
759
 
760
 
761
 
762
 
763
sub  trim { my $s = shift;  $s=~s/[\n]//gs; return $s };
764
 
765
sub remove_all_white_spaces($)
766
{
767
  my $string = shift;
768
  $string =~ s/\s+//g;
769
  return $string;
770
}
771
 
772
 
773
 
774
 
775
sub get_scolar_pos{
776
        my ($item,@list)=@_;
777
        my $pos;
778
        my $i=0;
779
        foreach my $c (@list)
780
        {
781
                if(  $c eq $item) {$pos=$i}
782
                $i++;
783
        }
784
        return $pos;
785
}
786
 
787
sub remove_scolar_from_array{
788
        my ($array_ref,$item)=@_;
789
        my @array=@{$array_ref};
790
        my @new;
791
        foreach my $p (@array){
792
                if($p ne $item ){
793
                        push(@new,$p);
794
                }
795
        }
796
        return @new;
797
}
798
 
799
sub replace_in_array{
800
        my ($array_ref,$item1,$item2)=@_;
801
        my @array=@{$array_ref};
802
        my @new;
803
        foreach my $p (@array){
804
                if($p eq $item1 ){
805
                        push(@new,$item2);
806
                }else{
807
                        push(@new,$p);
808
                }
809
        }
810
        return @new;
811
}
812
 
813
 
814
 
815
# return an array of common elemnts between two input arays 
816
sub get_common_array{
817
        my ($a_ref,$b_ref)=@_;
818
        my @A=@{$a_ref};
819
        my @B=@{$b_ref};
820
        my @C;
821
        foreach my $p (@A){
822
                if( grep (/^$p$/,@B)){push(@C,$p)};
823
        }
824
        return  @C;
825
}
826
 
827
#a-b
828
sub get_diff_array{
829
        my ($a_ref,$b_ref)=@_;
830
        my @A=@{$a_ref};
831
        my @B=@{$b_ref};
832
        my @C;
833
        foreach my $p (@A){
834
                if( !grep (/^$p$/,@B)){push(@C,$p)};
835
        }
836
        return  @C;
837
 
838
}
839
 
840
 
841
 
842
sub compress_nums{
843
        my      @nums=@_;
844
        my @f=sort { $a <=> $b } @nums;
845
        my $s;
846
        my $ls;
847
        my $range=0;
848
        my $x;
849
 
850
 
851
        foreach my $p (@f){
852
                if(!defined $x) {
853
                        $s="$p";
854
                        $ls=$p;
855
 
856
                }
857
                else{
858
                        if($p-$x>1){ #gap exist
859
                                if( $range){
860
                                        $s=($x-$ls>1 )? "$s:$x,$p": "$s,$x,$p";
861
                                        $ls=$p;
862
                                        $range=0;
863
                                }else{
864
                                $s= "$s,$p";
865
                                $ls=$p;
866
 
867
                                }
868
 
869
                        }else {$range=1;}
870
 
871
 
872
 
873
                }
874
 
875
                $x=$p
876
        }
877
        if($range==1){ $s= ($x-$ls>1 )? "$s:$x":  "$s,$x";}
878
        #update $s($ls,$hs);
879
 
880
        return $s;
881
 
882
}
883
 
884
 
885
1

powered by: WebSVN 2.1.0

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