From 17abe415644f9bd0e63d14bc06f659873d99c922 Mon Sep 17 00:00:00 2001
From: jquelin <jquelin@merlin.mongueurs.net>
Date: Tue, 6 Nov 2007 18:31:19 +0000
Subject: [PATCH] [project @ 137]  r7583@merlin:  jquelin | 2007-11-06 19:18:09
 +0100  introducing some real color decay

---
 lib/Language/Befunge/Debugger.pm | 36 +++++++++++++++++++++++++++++++-----
 1 file changed, 31 insertions(+), 5 deletions(-)

diff --git a/lib/Language/Befunge/Debugger.pm b/lib/Language/Befunge/Debugger.pm
index c9482a6..e7771a4 100644
--- a/lib/Language/Befunge/Debugger.pm
+++ b/lib/Language/Befunge/Debugger.pm
@@ -13,6 +13,7 @@ use warnings;
 
 use Language::Befunge;
 use Language::Befunge::Vector;
+use Readonly;
 use Tk; # should come before POE
 use Tk::Dialog;
 use Tk::TableMatrix;
@@ -20,6 +21,7 @@ use POE;
 
 
 our $VERSION = '0.0.1';
+Readonly my $DECAY => 8;
 
 #--
 # constructor
@@ -56,7 +58,7 @@ sub _on_start {
 
     my $fh1 = $poe_main_window->Frame->pack(-fill=>'both', -expand=>1);
     my $tm = $fh1->Scrolled( 'TableMatrix',
-        -bg => 'white',
+        -bg         => 'white',
         -scrollbars => 'osoe',
         -cols       => 80,
         -rows       => 25,
@@ -114,7 +116,11 @@ sub _on_start {
     #-- various initializations
     $tm->tagCell( 'current', '0,0' );
     $tm->tagConfigure( 'current', -bg => 'red' );
-    # FIXME: color decay
+    # color decay.
+    foreach my $i ( 0 .. $DECAY-1 ) {
+        my $v = sprintf "%02x", 255 / $DECAY * ($i+1);
+        $tm->tagConfigure( "decay$i", -bg => "#ff$v$v" );
+    }
 }
 
 #--
@@ -125,17 +131,31 @@ sub _on_b_next {
 
     my $bef = $h->{bef};
     my $tm  = $h->{w}{tm};
-    
+
     if ( scalar @{ $bef->get_ips } == 0 ) {
         # no more ip - end of program
         return;
     }
 
+    # get next ip
+    my $ip = shift @{ $bef->get_ips };
+    my $id = $ip->get_id;
+    $h->{oldpos}{$id} ||= [];
+
+    # do some color decay.
+    my $oldpos = $h->{oldpos}{$id};
+    unshift @$oldpos, _vec_to_tablematrix_index($ip->get_position);
+    pop     @$oldpos if scalar @$oldpos > $DECAY;
+    foreach my $i ( 0 .. $DECAY-1 ) {
+        last unless exists $oldpos->[$i];
+        $tm->tagCell("decay$i", $h->{oldpos}{$id}[$i]);
+    }
+
+
+
     # update gui
-    # FIXME: tag delete
 
     # advance next ip
-    my $ip = shift @{ $bef->get_ips };
     $bef->set_curip($ip);
     $bef->process_ip;
 
@@ -186,6 +206,12 @@ sub _get_cell_value {
     return chr( $torus->get_value($v) );
 }
 
+sub _vec_to_tablematrix_index {
+    my ($vec) = @_;
+    my ($x, $y) = $vec->get_all_components;
+    return "$y,$x";
+}
+
 
 1;
 
-- 
2.11.4.GIT