From 42f1fa5f18fb250dc94b91e1998aeb81c74107ee Mon Sep 17 00:00:00 2001
From: jquelin <jquelin@merlin.mongueurs.net>
Date: Wed, 7 Nov 2007 17:05:05 +0000
Subject: [PATCH] [project @ 156]  r7620@merlin:  jquelin | 2007-11-07 18:00:18
 +0100  show color of ip being currently processed

---
 lib/Language/Befunge/Debugger.pm | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/lib/Language/Befunge/Debugger.pm b/lib/Language/Befunge/Debugger.pm
index 0a24498..5eb7419 100644
--- a/lib/Language/Befunge/Debugger.pm
+++ b/lib/Language/Befunge/Debugger.pm
@@ -82,7 +82,7 @@ sub _on_start {
         );
     }
     $tb->separator(-movable => 0 );
-    $tb->LabEntry(-label=>'tick', -textvariable=>\$h->{tick},-justify=>'center',-state=>'readonly');
+    $h->{w}{ip} = $tb->LabEntry(-label=>'tick', -textvariable=>\$h->{tick},-justify=>'center',-state=>'readonly');
 
     #
 
@@ -133,13 +133,12 @@ sub _on_b_next {
 
         # - decay colors
         my ($r,$g,$b) = exists $COLORS[$id] ?  @{$COLORS[$id]} : (rand(255), rand(255), rand(255));
-        my $bgcolor;
         foreach my $i ( 0 .. $DECAY-1 ) {
             my $ri = sprintf "%02x", $r + (255-$r) / $DECAY * ($i+1);
             my $gi = sprintf "%02x", $g + (255-$g) / $DECAY * ($i+1);
             my $bi = sprintf "%02x", $b + (255-$b) / $DECAY * ($i+1);
             $tm->tagConfigure( "decay-$id-$i", -bg => "#$ri$gi$bi" );
-            $bgcolor = "#$ri$gi$bi" if $i == int($DECAY/2);
+            $ips->{$ip}{bgcolor} = "#$ri$gi$bi" if $i == 0;
         }
 
         # - summary label
@@ -147,13 +146,16 @@ sub _on_b_next {
             -text    => _ip_to_label($ip,$bef),
             -justify => 'left',
             -anchor  => 'w',
-            -bg      => $bgcolor,
+            -bg      => $ips->{$ip}{bgcolor},
         )->pack(-fill=>'x', -expand=>1);
 
         # - old positions
         $ips->{$ip}{oldpos} = [];
     }
 
+    # show color of ip being currently processed
+    $w->{ip}->configure(-bg=>$ips->{$ip}{bgcolor});
+
     # do some color decay.
     my $oldpos = $ips->{$ip}{oldpos};
     unshift @$oldpos, _vec_to_tablematrix_index($ip->get_position);
-- 
2.11.4.GIT