From fc91820698d1dd44cad416711738745349027b66 Mon Sep 17 00:00:00 2001
From: etienne
Date: Thu, 30 Sep 2004 11:36:24 +0000
Subject: Transformations are correctly managed in build code

---
 Perl/Zinc/Debug.pm | 315 +++++++++++++++++++++++++++++------------------------
 1 file changed, 170 insertions(+), 145 deletions(-)

(limited to 'Perl/Zinc')

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index cb84c54..935709c 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -497,6 +497,150 @@ sub findintree {
 } # end findintree
 
 
+sub searchInTree {
+    
+    my $zinc = shift;
+    $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl);
+    $searchtree_tl = $zinc->Toplevel;
+    $searchtree_tl->title("Find string in tree");
+    my $fm = $searchtree_tl->Frame->pack(-side => 'top');
+    $fm->Label(-text => "Find : ",
+	       )->pack(-side => 'left', -padx => 10, -pady => 10);
+    my $entry = $fm->Entry(-width => 20)->pack(-side => 'left',
+					       -padx => 10, -pady => 10);
+    my $status = $searchtree_tl->Label(-foreground => 'sienna',
+				   )->pack(-side => 'top');
+    my $ep = 1;
+    my $searchfunc =  sub {
+	my $side = shift;
+	my $found = 0;
+        #print "ep=$ep side=$side\n";
+	$status->configure(-text => "");
+	$status->update;
+	$searchTreeEntryValue = $entry->get();
+	$searchTreeEntryValue = quotemeta($searchTreeEntryValue);
+	my $text;
+	while ($ep) {
+ 	    $ep = $tree->info($side, $ep);
+	    unless ($ep) {
+		$ep = 1;
+		$found = 0;
+		last;
+	    }
+	    $text = $tree->entrycget($ep, -text);
+	    if ($text =~ /$searchTreeEntryValue/) {
+		$tree->see($ep);
+		$tree->selectionClear;
+		$tree->anchorSet($ep);
+		$tree->selectionSet($ep);
+		$found = 1;
+		last;
+	    }
+	}
+	#print "searchTreeEntryValue=$searchTreeEntryValue found=$found\n";
+	$status->configure(-text => "Search string not found") unless $found > 0;
+    };
+
+    my $fm2 = $searchtree_tl->Frame->pack(-side => 'top');
+    $fm2->Button(-text => 'Prev',
+		 -command => sub {&$searchfunc('prev');},
+		 )->pack(-side => 'left', -pady => 10);
+    $fm2->Button(-text => 'Next',
+		 -command => sub {&$searchfunc('next');},
+		 )->pack(-side => 'left', -pady => 10);
+    $fm2->Button(-text => 'Close',
+		 -command => sub {$searchtree_tl->destroy},
+		 )->pack(-side => 'right', -pady => 10);
+    $entry->focus;
+    $entry->delete(0, 'end');
+    $entry->insert(0, $searchTreeEntryValue) if $searchTreeEntryValue;
+    $entry->bind('<Key-Return>', sub {&$searchfunc('next');});
+    
+} # end searchInTree
+
+
+sub extractinfo {
+    my $zinc = shift;
+    my $item = shift;
+    my $format = shift;
+    my $option = shift;
+    my $titleflag = shift;
+    $option =~ s/^\s+//;
+    $option =~ s/\s+$//;
+    #print "option=[$option]\n";
+    my @info;
+    $WARNING = 0;
+    eval {@info = $zinc->itemcget($item, $option)};
+    #print "eval $option = (@info) $@\n";
+    return if $@;
+    return if @info == 0;
+    my $info;
+    my $sep = ($format eq 'column') ? "\n  " : ", ";
+    if ($titleflag) {
+	$info = $sep."[$option] ".$info[0];
+    } else {
+	$info = $sep.$info[0];
+    }
+    if (@info > 1) {
+	shift(@info);
+	for (@info) {
+	    if ($format eq 'column') {
+		if (length($info." ".$_) > 40) {
+		    if ($titleflag) {
+			$info .= $sep."[$option] ".$_;
+		    } else {
+			$info .= $sep.$_;
+		    }
+		} else {
+		    $info .= ", $_";
+		}
+	    } else {
+		$info .= $sep.$_;
+	    }
+	}
+    }
+    $WARNING = 1;
+    return $info;
+    
+} # end extractinfo
+
+
+sub scangroup {
+    
+    my ($zinc, $tree, $group, $path, $format, @optionstodisplay) = @_;
+    my @items = $zinc->find('withtag', "$group.");
+    for my $item (@items) {
+	my $Type = ucfirst($zinc->type($item));
+	my $info = " ";
+	if (@optionstodisplay == 1) {
+	    $info .= &extractinfo($zinc, $item, $format, $optionstodisplay[0]);
+	} elsif (@optionstodisplay > 1) {
+	    for my $opt (@optionstodisplay) {
+		$info .= &extractinfo($zinc, $item, $format, $opt, 1);
+	    }
+	}
+	if ($Type eq "Group") {
+	    $tree->add($path.".".$item,
+		       -text => "$Type($item)$info",
+		       -style => 'group',
+		       );
+	    &scangroup($zinc, $tree, $item, $path.".".$item, $format, @optionstodisplay);
+	} else {
+	    $tree->add($path.".".$item,
+		       -text => "$Type($item)$info",
+		       -style => 'item',
+		       );
+	}
+    }
+
+} # end scangroup
+
+#---------------------------------------------------------------------------
+#
+# Functions used to build code
+#
+#---------------------------------------------------------------------------
+
 # build perl code corresponding to a branch of the items tree
 sub buildCode {
     
@@ -525,7 +669,7 @@ sub buildCode {
     } else {
 	push(@code, &buildItem($zinc, $item, 1));
     }
-    push(@code, &buildend);
+    push(@code, &buildEnd);
     
     my $file = $zinc->getSaveFile(-filetypes => [['Perl Files',   '.pl'],
                                                ['All Files',   '*']],
@@ -543,7 +687,7 @@ sub buildCode {
 } # end buildCode
 
 
-sub buildend {
+sub buildEnd {
 
     my @code;
     push(@code, 'for (keys(%items)) {');
@@ -552,7 +696,7 @@ sub buildend {
     push(@code, 'MainLoop;');
     return @code
 	
-} # end buildend
+} # end buildEnd
 
 
 # build a node of tree (corresponding to a TkZinc group item)
@@ -562,13 +706,18 @@ sub buildGroup {
     my $item = shift;
     my $group = shift;
     my @code;
+    # creation
     push(@code, '$items{'.$item.'}=$zinc->add("group", '.$group.', ');
     # options
     push(@code, &buildOptions($zinc, $item));
     push(@code, ');');
     push(@code, '');
+    # coords
     push(@code, '$zinc->coords($items{'.$item.'}, ['.
 	 join(',', $zinc->coords($item)).']);');
+    # transformations
+    push(@code, &buildTransformations($zinc, $item));
+    
     my @items = $zinc->find('withtag', "$item.");
     for my $it (reverse(@items)) {
 	if ($zinc->type($it) eq 'group') {
@@ -592,7 +741,7 @@ sub buildItem {
     my @code;
     my $numfields = 0;
     my $numcontours = 0;
-    # type group and initargs
+    # creation    
     my $initstring = '$items{'.$item.'}=$zinc->add("'.$type.'", '.$group.', ';
     if ($type eq 'tabular' or $type eq 'track' or $type eq 'waypoint') {
 	$numfields = $zinc->itemcget($item, -numfields);
@@ -623,11 +772,13 @@ sub buildItem {
     push(@code, &buildOptions($zinc, $item));
     push(@code, ');');
     push(@code, '');
+    # fields
     if ($numfields > 0) {
     	for (my $i=0; $i < $numfields; $i++) {
 	    push(@code, &buildField($zinc, $item, $i));
 	}
     }
+    # contours
     if ($numcontours > 1) {
 	for (my $i=1; $i < $numcontours; $i++) {
 	    my (@coords) = $zinc->coords($item);
@@ -644,6 +795,9 @@ sub buildItem {
 	    push(@code, '            '.$coordstr.');');
 	}
     }
+    # transformations
+    push(@code, &buildTransformations($zinc, $item));
+    
     return @code;
 
 } # end buildItem
@@ -667,6 +821,17 @@ sub buildField {
 } # end buildField
 
 
+sub buildTransformations {
+
+    my $zinc = shift;
+    my $item = shift;
+    my @tr = $zinc->tget($item);
+    my @code;
+    return ('$zinc->tset($items{'.$item.'}, '.join(", ", @tr).');');
+
+} # end buildTransformations
+
+
 sub buildOptions {
     
     my $zinc = shift;
@@ -695,7 +860,7 @@ sub buildOptions {
 	    push(@code, "           ".$option.' => "'.$value.'", ');
 
 	} elsif (ref($value) eq 'ARRAY') {
-	    push(@code, "           ".$option." => [qw/".join(' ', @$value)."/], ");
+	    push(@code, "           ".$option." => [qw(".join(' ', @$value).")], ");
 
 	} else {
 	    push(@code, "           ".$option." => '".$value."', ");
@@ -705,146 +870,6 @@ sub buildOptions {
 
 } # end buildOptions
 
-
-sub searchInTree {
-    
-    my $zinc = shift;
-    $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl);
-    $searchtree_tl = $zinc->Toplevel;
-    $searchtree_tl->title("Find string in tree");
-    my $fm = $searchtree_tl->Frame->pack(-side => 'top');
-    $fm->Label(-text => "Find : ",
-	       )->pack(-side => 'left', -padx => 10, -pady => 10);
-    my $entry = $fm->Entry(-width => 20)->pack(-side => 'left',
-					       -padx => 10, -pady => 10);
-    my $status = $searchtree_tl->Label(-foreground => 'sienna',
-				   )->pack(-side => 'top');
-    my $ep = 1;
-    my $searchfunc =  sub {
-	my $side = shift;
-	my $found = 0;
-        #print "ep=$ep side=$side\n";
-	$status->configure(-text => "");
-	$status->update;
-	$searchTreeEntryValue = $entry->get();
-	$searchTreeEntryValue = quotemeta($searchTreeEntryValue);
-	my $text;
-	while ($ep) {
- 	    $ep = $tree->info($side, $ep);
-	    unless ($ep) {
-		$ep = 1;
-		$found = 0;
-		last;
-	    }
-	    $text = $tree->entrycget($ep, -text);
-	    if ($text =~ /$searchTreeEntryValue/) {
-		$tree->see($ep);
-		$tree->selectionClear;
-		$tree->anchorSet($ep);
-		$tree->selectionSet($ep);
-		$found = 1;
-		last;
-	    }
-	}
-	#print "searchTreeEntryValue=$searchTreeEntryValue found=$found\n";
-	$status->configure(-text => "Search string not found") unless $found > 0;
-    };
-
-    my $fm2 = $searchtree_tl->Frame->pack(-side => 'top');
-    $fm2->Button(-text => 'Prev',
-		 -command => sub {&$searchfunc('prev');},
-		 )->pack(-side => 'left', -pady => 10);
-    $fm2->Button(-text => 'Next',
-		 -command => sub {&$searchfunc('next');},
-		 )->pack(-side => 'left', -pady => 10);
-    $fm2->Button(-text => 'Close',
-		 -command => sub {$searchtree_tl->destroy},
-		 )->pack(-side => 'right', -pady => 10);
-    $entry->focus;
-    $entry->delete(0, 'end');
-    $entry->insert(0, $searchTreeEntryValue) if $searchTreeEntryValue;
-    $entry->bind('<Key-Return>', sub {&$searchfunc('next');});
-    
-} # end searchInTree
-
-
-sub extractinfo {
-    my $zinc = shift;
-    my $item = shift;
-    my $format = shift;
-    my $option = shift;
-    my $titleflag = shift;
-    $option =~ s/^\s+//;
-    $option =~ s/\s+$//;
-    #print "option=[$option]\n";
-    my @info;
-    $WARNING = 0;
-    eval {@info = $zinc->itemcget($item, $option)};
-    #print "eval $option = (@info) $@\n";
-    return if $@;
-    return if @info == 0;
-    my $info;
-    my $sep = ($format eq 'column') ? "\n  " : ", ";
-    if ($titleflag) {
-	$info = $sep."[$option] ".$info[0];
-    } else {
-	$info = $sep.$info[0];
-    }
-    if (@info > 1) {
-	shift(@info);
-	for (@info) {
-	    if ($format eq 'column') {
-		if (length($info." ".$_) > 40) {
-		    if ($titleflag) {
-			$info .= $sep."[$option] ".$_;
-		    } else {
-			$info .= $sep.$_;
-		    }
-		} else {
-		    $info .= ", $_";
-		}
-	    } else {
-		$info .= $sep.$_;
-	    }
-	}
-    }
-    $WARNING = 1;
-    return $info;
-    
-} # end extractinfo
-
-
-sub scangroup {
-    
-    my ($zinc, $tree, $group, $path, $format, @optionstodisplay) = @_;
-    my @items = $zinc->find('withtag', "$group.");
-    for my $item (@items) {
-	my $Type = ucfirst($zinc->type($item));
-	my $info = " ";
-	if (@optionstodisplay == 1) {
-	    $info .= &extractinfo($zinc, $item, $format, $optionstodisplay[0]);
-	} elsif (@optionstodisplay > 1) {
-	    for my $opt (@optionstodisplay) {
-		$info .= &extractinfo($zinc, $item, $format, $opt, 1);
-	    }
-	}
-	if ($Type eq "Group") {
-	    $tree->add($path.".".$item,
-		       -text => "$Type($item)$info",
-		       -style => 'group',
-		       );
-	    &scangroup($zinc, $tree, $item, $path.".".$item, $format, @optionstodisplay);
-	} else {
-	    $tree->add($path.".".$item,
-		       -text => "$Type($item)$info",
-		       -style => 'item',
-		       );
-	}
-    }
-
-} # end scangroup
-
-
 #---------------------------------------------------------------------------
 #
 # Functions related to search in a rectangular area
-- 
cgit v1.1