1#!/usr/bin/perl -w 2 3### 4# Pod Documentation 5### 6 7=head1 NAME 8 9trace_movie.pl 10 11=head1 SYNOPSIS 12 13Usage: trace_movie.pl -i org_file -t trace_file -o output_file [-m -f 10000] 14 15Create an image or a folder of images of organism instruction execution. 16 17=head1 DESCRIPTION 18 19=over 20 21=item B<-i> <org file paths> 22 23An Avida organism file (.org). Generated by the PrintDominantGenotype event, for example. 24 25=item B<-t> <trace file path> 26 27An Avida trace file. Generated by the analyze command. 28 29=item B<-o> <file/directory path> 30 31Output file name or directory name (if -m used). 32 33=item B<-m> 34 35Generate frames of a movie. Without this option, only the final frame is produced. 36 37=item B<-f> <frame limit> 38 39The maximum number of frames to draw. 40 41=back 42 43=head1 AUTHOR 44 45Jeffrey Barrick 46 47=head1 COPYRIGHT 48 49Copyright 2006-2007. All rights reserved. 50 51=cut 52 53### 54# End Pod Documentation 55### 56 57use strict; 58 59use FindBin; 60use lib $FindBin::Bin; 61use Data::Dumper; 62use GD; 63 64#Get options 65use Getopt::Long; 66use Pod::Usage; 67my ($help, $man); 68my $frame_limit = 1000; 69my ($input, $output, $trace, $movie, $collapse_frames, $gray_unvisited_instructions); 70#pod2usage(1) if (scalar @ARGV == 0); 71GetOptions( 72 'help|?' => \$help, 'man' => \$man, 73 'input|i=s' => \$input, 74 'trace|t=s' => \$trace, 75 'output|o=s' => \$output, 76 'movie|m' => \$movie, 77 'frame-limit|f=s' => \$frame_limit, 78 'collapse|c' => \$collapse_frames, 79 'gray|g' => \$gray_unvisited_instructions, 80) or pod2usage(2); 81pod2usage(1) if $help; 82pod2usage(-exitstatus => 0, -verbose => 2) if $man; 83pod2usage(1) if (!defined $output or !defined $input or !defined $trace); 84 85#Other options 86my $each_execution_once = 1; 87 88my $data; 89 90#Load the genome from the .org file 91open ORGANISM, "$input" or die "Could not open organism file: $input"; 92our @inst = <ORGANISM>; 93close ORGANISM; 94chomp @inst; 95@inst = grep !/^#/, @inst; #comments 96@inst = grep $_, @inst; #blank lines 97foreach my $inst (@inst) 98{ 99 $inst =~ s/\s*#.*$//; 100} 101#print +(join "\n", @org_lines) . "\n"; 102 103#Load the trace from the .org file 104our @trace; 105open TRACE, "$trace"; 106 107my $resources_found = 0; 108my $cur_resource_line; 109while (<TRACE>) 110{ 111 if ($_ =~ m/(\d+)\s+IP:(\d+)\s+AX:(\S+) \[(\S+)\]\s+BX:(\S+) \[(\S+)\]\s+CX:(\S+) \[(\S+)\]/) #Instruction pointer/register line 112 { 113 my $t; 114 $t->{'time'} = $1; 115 $t->{'inst'} = $2; 116 $t->{AX}->{'dec'} = $3; 117 $t->{AX}->{'hex'} = $4; 118 $t->{BX}->{'dec'} = $5; 119 $t->{BX}->{'hex'} = $6; 120 $t->{CX}->{'dec'} = $7; 121 $t->{CX}->{'hex'} = $8; 122 123 $t->{'aged_time'} = $t->{'time'}; 124 if ( $_ =~ m/EnergyUsed:(\d+)/ ) 125 { 126 $t->{'aged_time'} = $1; 127 } 128 my $on_line; 129 130 #The next line is the read/write/flow heads #ignore 131 $on_line = <TRACE>; 132 133 #The next line is stack 0 #ignore 134 $on_line = <TRACE>; 135 chomp $on_line; 136 $t->{stack_0} = $on_line; 137 138 #The next line is stack 1 #ignore 139 $on_line = <TRACE>; 140 chomp $on_line; 141 $t->{stack_1} = $on_line; 142 143 #The next line is memory #ignore 144 $on_line = <TRACE>; 145 146 #The next line is merit/bonus/tasks 147 $on_line = <TRACE>; 148 chomp $on_line; 149 $on_line =~ m/Bonus:\s*(\S+)\s*Errors:\s*(\d+)\s*Donates:\s*(\d+)/; 150 $t->{bonus} = $1; 151 $t->{donates} = $3; 152 153 #The next line is tasks 154 $on_line = <TRACE>; 155 my $original_line = $on_line; 156 157 chomp $on_line; 158 $on_line =~ m/:\s*(.+)$/; 159 $on_line = $1; 160 $on_line =~ s/\(\S+\)\s*//g; 161 $on_line =~ s/\s*$//g; #Not sure why I need this to get rid of trailing space 162 @{$t->{tasks}} = split /\s+/, $on_line; 163 164 #print "$original_line\n" if (scalar @{$t->{tasks}} != 9); 165 166 #optional lines are inserted here 167 168 #Next line is blank 169 $on_line = <TRACE>; 170 chomp $on_line; 171 while ($on_line) 172 { 173 if ($on_line =~ m/Terminated!/) 174 { 175 $t->{terminated} = 1; 176 } 177 178 $on_line = <TRACE>; 179 chomp $on_line; 180 } 181 182 #Next line is Input (env) 183 #Next line is Input (buf) 184 #Next line is Output 185 $on_line = <TRACE>; 186 $on_line = <TRACE>; 187 $on_line = <TRACE>; 188 #Next line is ---- 189 #Next line is ABOUT To EXECUTE 190 $on_line = <TRACE>; 191 $on_line = <TRACE>; 192 193 #Handle saved resources 194 if ($cur_resource_line) 195 { 196 $resources_found = 1; 197 @{$t->{resources}} = @{$t->{resources}} = split /\s+/, $cur_resource_line; 198 } 199 #print Dumper($t); 200 201 #Check to see if the last frame added was at the same location 202 if ($collapse_frames && $trace[$#trace]) 203 { 204 #print $trace[$#trace]->{'inst'} . " " . $t->{'inst'} . "\n"; 205 if ($trace[$#trace]->{'inst'} == $t->{'inst'}) 206 { 207 pop @trace; 208 #print "removed down to: " . scalar @trace . "\n"; 209 } 210 } 211 212 push @trace, $t; 213 } 214 if ($_ =~ s/^Resources: //) 215 { 216 $cur_resource_line = $_; 217 } 218 219} 220close TRACE; 221 222if ($movie) 223{ 224 `rm -r $output` if (-e "$output"); 225 mkdir $output; 226} 227 228#These constants control how the drawing is made 229our $inst_size_y = 7; 230our $inst_size_x = 7; 231our $inst_space_x = 1; 232 233our $min_size_x = 850; 234our $total_x = $inst_size_x * (scalar @inst) + $inst_space_x * ((scalar @inst) + 1); 235$total_x = $min_size_x if ($total_x < $min_size_x); 236 237our $arc_height_increment = 2; 238our $arc_height_initial = 5; 239 240our $text_size_y = 90; 241 242#Go through the execution to determing how high the drawing needs to be... 243 244#Now draw arrows showing execution 245my $drawn_connections = {}; 246my $arc_height = $arc_height_initial; 247foreach (my $i=1; $i < scalar @trace; $i++) 248{ 249 if ($trace[$i]->{inst} != $trace[$i-1]->{inst}) 250 { 251 my $key = "$trace[$i-1]->{inst}_$trace[$i]->{inst}"; 252 next if ($each_execution_once && defined $drawn_connections->{$key}); 253 254 $drawn_connections->{$key}++; 255 $arc_height +=$arc_height_increment; 256 } 257} 258 259our $total_y = $arc_height + 10 + 10 + $inst_size_y; 260our $text_y = $total_y; 261$total_y += $text_size_y; 262our $inst_y = $arc_height + 10; 263 264# create a new image 265my $img = new GD::Image($total_x,$total_y); 266$img->interlaced('true'); 267 268# allocate some colors 269our $colors; 270$colors->{white} = $img->colorAllocate(255,255,255); 271$colors->{black} = $img->colorAllocate(0,0,0); 272$colors->{red} = $img->colorAllocate(255,0,0); 273$colors->{blue} = $img->colorAllocate(0,0,255); 274$colors->{green} = $img->colorAllocate(0,255,0); 275$colors->{gray} = $img->colorAllocate(127,127,127); 276$colors->{cyan} = $img->colorAllocate(64,240,240); 277$colors->{magenta} = $img->colorAllocate(250,64,220); 278$colors->{orange} = $img->colorAllocate(250,150,55); 279$colors->{purple} = $img->colorAllocate(137,30,246); 280 281 282our $inst_to_style = { 283 'nop-A' => { 'c' => 'red', 's' => 'circle' }, 284 'nop-B' => { 'c' => 'green', 's' => 'circle' }, 285 'nop-C' => { 'c' => 'blue', 's' => 'circle' }, 286 'sense' => { 'c' => 'blue', 's' => 'triangle' }, 287 'goto' => { 'c' => 'green', 's' => 'square' }, 288 'label' => { 'c' => 'red', 's' => 'square' }, 289 'throw' => { 'c' => 'green', 's' => 'square' }, 290 'catch' => { 'c' => 'red', 's' => 'square' }, 291 'promoter' => { 'c' => 'green', 's' => 'square' }, 292 'terminate' => { 'c' => 'red', 's' => 'square' }, 293 'up-reg' => { 'c' => 'green', 's' => 'triangle' }, 294 'down-reg' => { 'c' => 'red', 's' => 'triangle' }, 295 'nand' => { 'c' => 'orange', 's' => 'square' }, 296 'get' => { 'c' => 'magenta', 's' => 'square' }, 297 'put' => { 'c' => 'cyan', 's' => 'square' }, 298 'metabolize' => { 'c' => 'cyan', 's' => 'square' }, 299 'repro' => { 'c' => 'purple', 's' => 'square' }, 300 'default' => { 'c' => 'black', 's' => 'square' } 301}; 302 303our $max_label_size = 8; 304our $inst_use_nops = { 305 'if-n-equ' => 1, 306 'if-less' => 1, 307 'pop' => 1, 308 'push' => 1, 309 'shift-r' => 1, 310 'shift-l' => 1, 311 'inc' => 1, 312 'dec' => 1, 313 'add' => 1, 314 'sub' => 1, 315 'nand' => 1, 316 'get' => 1, 317 'put' => 1, 318 'goto' => $max_label_size, 319 'goto-if=0' => $max_label_size, 320 'goto-if!=0' => $max_label_size, 321 'label' => $max_label_size, 322 'throw' => $max_label_size, 323 'throwif=0' => $max_label_size, 324 'throwif!=0' => $max_label_size, 325 'catch' => $max_label_size, 326 'sense-m100' => $max_label_size, 327 'sense-unit' => $max_label_size, 328 'up-reg' => $max_label_size, 329 'down-reg' => $max_label_size, 330}; 331 332our @execution_flare_colors = ( 333 $img->colorAllocate( 255, 0, 0), 334 $img->colorAllocate( 0, 50, 0), 335 $img->colorAllocate( 0, 75, 0), 336 $img->colorAllocate( 0, 100, 0), 337 $img->colorAllocate( 0, 125, 0), 338 $img->colorAllocate( 0, 150, 0), 339 $img->colorAllocate( 0, 175, 0), 340 $img->colorAllocate( 0, 200, 0), 341 $img->colorAllocate( 0, 230, 0), 342 $img->colorAllocate( 0, 255, 0), 343 $img->colorAllocate( 25, 255, 25), 344 $img->colorAllocate( 50, 255, 50), 345 $img->colorAllocate( 75, 255, 75), 346 $img->colorAllocate(100, 255, 100), 347 $img->colorAllocate(125, 255, 125), 348 $img->colorAllocate(150, 255, 150), 349 $img->colorAllocate(175, 255, 175), 350 $img->colorAllocate(200, 255, 200), 351 $img->colorAllocate(220, 220, 220), 352 353); 354 355 356 357#print Dumper($colors); 358 359#Draw a connecting line, vertically centered 360$img->line($inst_space_x,$inst_y + $inst_size_y / 2 ,(scalar @inst - 1) * ($inst_size_x + $inst_space_x), $inst_y + $inst_size_y / 2,$colors->{gray}); 361 362#Draw grayed out instructions for each box 363for (my $i=0; $i< scalar @inst; $i++) 364{ 365 draw_instruction( $i, ($gray_unvisited_instructions ? $colors->{gray} : undef) ); 366} 367 368 369#Draw ALL nops in default colors 370#foreach (my $i=0; $i < scalar @inst; $i++) 371#{ 372# draw_instruction($i) if ($inst[$i] =~ m/^nop/); 373#} 374 375$drawn_connections = {}; 376$arc_height = $arc_height_initial; 377our @arc_memory; 378 379my $frame; 380#Now draw arrows showing execution 381foreach (my $i=0; $i < scalar @trace; $i++) 382{ 383 #Now draw over instructions that were used in their real colors, if gray background 384 if ($gray_unvisited_instructions) 385 { 386 draw_instruction($trace[$i]->{inst}); 387 } 388 389 #Include nops as long as we find them and are within the limits of what the inst uses 390 my @nop_list; 391 if ($inst_use_nops->{$inst[$trace[$i]->{inst}]}) 392 { 393 my $used_nops = 0; 394 while ( ($inst[($trace[$i]->{inst}+1+$used_nops) % scalar @inst] =~ m/^nop/) 395 && ($used_nops < $inst_use_nops->{$inst[$trace[$i]->{inst}]}) ) 396 { 397 $used_nops++; 398 draw_instruction( ($trace[$i]->{inst}+$used_nops) % scalar @inst ); 399 push @nop_list, $inst[($trace[$i]->{inst}+$used_nops) % scalar @inst]; 400 } 401 } 402 403 $frame++; 404 die "Exceeded frame limit (-f)." if ($movie && ($frame > $frame_limit)); 405 406 if ($trace[$i]->{inst} != $trace[$i-1]->{inst}) 407 { 408 my $new_arc = { '1' => $trace[$i]->{inst}, '2' => $trace[$i]->{inst} }; 409 $new_arc->{1} = $trace[$i-1]->{inst} if ( ($i!=0) && (!$trace[$i]->{terminated}) ); 410 411 my $key = "$new_arc->{1}_$new_arc->{2}"; 412 413 #Increment the arc_height if drawing multiple connections of does not exist 414 415 if ($each_execution_once) 416 { 417 if (!defined $drawn_connections->{$key}) 418 { 419 $arc_height += $arc_height_increment; 420 $drawn_connections->{$key} = $arc_height; 421 } 422 } 423 else 424 { 425 $arc_height += $arc_height_increment; 426 $drawn_connections->{$key} = $arc_height; 427 } 428 $new_arc->{'h'} = $drawn_connections->{$key}; 429 430 unshift @arc_memory, $new_arc; 431 #remove last arc 432 pop @arc_memory if (scalar @arc_memory > scalar @execution_flare_colors); 433 434 #redraw all arcs in memory from oldest to newest 435 foreach (my $a= scalar @arc_memory-1; $a >= 0; $a--) 436 { 437 my $this_arc = $arc_memory[$a]; 438 draw_execution_arc($this_arc->{1}, $this_arc->{2}, $this_arc->{h}, $execution_flare_colors[$a]); 439 #print Dumper($this_arc, $execution_flare_colors[$a]); 440 } 441 } 442 443 #Erase the bottom information 444 $img->filledRectangle(0,$text_y,$total_x,$total_y,$colors->{white}); 445 446 #Draw current instruction name 447 $img->string(gdMediumBoldFont,3,$text_y,$trace[$i]->{time},$colors->{black}); 448 $img->string(gdMediumBoldFont,52,$text_y, "$inst[$trace[$i]->{inst}] @nop_list", $colors->{black}); 449 450 my $text_color; 451 $text_color = ($i==0 or $trace[$i]->{AX}->{'dec'} == $trace[$i-1]->{AX}->{'dec'}) ? $colors->{black} : $colors->{red}; 452 $img->string(gdMediumBoldFont,252,$text_y,"AX: $trace[$i]->{AX}->{'dec'} [$trace[$i]->{AX}->{'hex'}]",$text_color); 453 454 $text_color = ($i==0 or $trace[$i]->{BX}->{'dec'} == $trace[$i-1]->{BX}->{'dec'}) ? $colors->{black} : $colors->{red}; 455 $img->string(gdMediumBoldFont,452,$text_y,"BX: $trace[$i]->{BX}->{'dec'} [$trace[$i]->{BX}->{'hex'}]",$text_color); 456 457 $text_color = ($i==0 or $trace[$i]->{CX}->{'dec'} == $trace[$i-1]->{CX}->{'dec'}) ? $colors->{black} : $colors->{red}; 458 $img->string(gdMediumBoldFont,652,$text_y,"CX: $trace[$i]->{CX}->{'dec'} [$trace[$i]->{CX}->{'hex'}]",$text_color); 459 460 $text_color = ($i==0 or $trace[$i]->{stack_0} eq $trace[$i-1]->{stack_0}) ? $colors->{black} : $colors->{red}; 461 $img->string(gdMediumBoldFont,3,$text_y + 18,$trace[$i]->{stack_0},$text_color); 462 $text_color = ($i==0 or $trace[$i]->{stack_1} eq $trace[$i-1]->{stack_1}) ? $colors->{black} : $colors->{red}; 463 $img->string(gdMediumBoldFont,3,$text_y + 36,$trace[$i]->{stack_1},$text_color); 464 465 $text_color = ($i==0 or $trace[$i]->{bonus} == $trace[$i-1]->{bonus}) ? $colors->{black} : $colors->{red}; 466 $img->string(gdMediumBoldFont,3,$text_y + 54,"Bonus: $trace[$i]->{bonus}",$text_color); 467 468 $img->string(gdMediumBoldFont,180,$text_y + 54,"Tasks:",$colors->{black}); 469 for (my $b=0; $b<scalar @{$trace[$i]->{tasks}}; $b++) 470 { 471 if (!defined $trace[$i]->{tasks}->[$b] or !defined $trace[$i-1]->{tasks}->[$b]) 472 { 473 print Dumper($trace[$i]->{tasks}, $trace[$i-1]->{tasks}); 474 } 475 $text_color = ($i==0 or $trace[$i]->{tasks}->[$b] == $trace[$i-1]->{tasks}->[$b]) ? $colors->{black} : $colors->{red}; 476 $img->string(gdMediumBoldFont,250 + 60 * $b,$text_y + 54,"$trace[$i]->{tasks}->[$b]",$text_color); 477 } 478 479 #$img->string(gdMediumBoldFont,3,$text_y + 72,"Effective Time:",$colors->{black}); 480 $img->string(gdMediumBoldFont,3,$text_y + 72,$trace[$i]->{aged_time},$colors->{black}); 481 482 if ($resources_found) 483 { 484 $img->string(gdMediumBoldFont,153,$text_y + 72,"Resources:",$colors->{black}); 485 for (my $b=0; $b<scalar @{$trace[$i]->{resources}}; $b++) 486 { 487 if (!defined $trace[$i]->{resources}->[$b] or !defined $trace[$i-1]->{resources}->[$b]) 488 { 489 print Dumper($trace[$i]->{resources}, $trace[$i-1]->{resources}); 490 } 491 $text_color = ($i==0 or $trace[$i]->{resources}->[$b] == $trace[$i-1]->{resources}->[$b]) ? $colors->{black} : $colors->{red}; 492 $img->string(gdMediumBoldFont,250 + 60 * $b,$text_y + 72, sprintf("%.2e",$trace[$i]->{resources}->[$b]) ,$text_color); 493 } 494 } 495 496 if ($movie) 497 { 498 open OUT, ">$output/$frame.png"; 499 print OUT $img->png; 500 501 } 502} 503 504 505# make the background transparent and interlaced 506#$im->transparent($white); 507 508# Put a black frame around the picture 509#$im->rectangle(0,0,99,99,$black); 510 511# Draw a blue oval 512#$im->arc(50,50,95,75,0,360,$blue); 513 514# And fill it with red 515#$im->fill(50,50,$red); 516 517# make sure we are writing to a binary stream 518 519# Convert the image to PNG and print it on standard output 520if (!$movie) 521{ 522 open OUT, ">$output"; 523 binmode OUT; 524 print OUT $img->png; 525} 526 527#end of program 528 529sub find_inst_hash_match 530{ 531 my ($inst) = @_; 532 533 foreach my $key (keys %$inst_to_style) 534 { 535 return $key if ($inst =~ /^\Q$key\E/); 536 } 537 538 return 'default'; 539} 540 541sub get_inst_color 542{ 543 my ($inst) = @_; 544 return $inst_to_style->{find_inst_hash_match($inst)}->{c}; 545} 546 547sub get_inst_shape 548{ 549 my ($inst) = @_; 550 return $inst_to_style->{find_inst_hash_match($inst)}->{s}; 551} 552 553 554sub draw_instruction 555{ 556 my ($i, $color) = @_; 557 my $x = $inst_space_x + $i * ($inst_space_x + $inst_size_x); 558 559 $color = $colors->{get_inst_color($inst[$i])} if (!defined $color); 560 my $shape = get_inst_shape($inst[$i]); 561 562 #Decide how to draw it 563 if ($shape eq 'square') 564 { 565 $img->filledRectangle($x,$inst_y,$x+$inst_size_x-1,$inst_y+$inst_size_y-1,$color); 566 } 567 elsif ($shape eq 'circle') 568 { 569 $img->filledArc($x+$inst_size_x/2,$inst_y+$inst_size_y/2,$inst_size_x,$inst_size_y,0,360,$color); 570 571 } 572 elsif ($shape eq 'triangle') 573 { 574 my $poly = new GD::Polygon; 575 $poly->addPt($x + $inst_size_x / 2,$inst_y); 576 $poly->addPt($x, $inst_y + $inst_size_y - 1); 577 $poly->addPt($x + $inst_size_x - 1, $inst_y + $inst_size_y - 1); 578 579 # draw the polygon, filling it with a color 580 $img->filledPolygon($poly,$color); 581 } 582 583} 584 585 586sub draw_execution_arc 587{ 588 my ($i, $j, $h, $color) = @_; 589 590 if ($i > $j) 591 { 592 my $temp = $i; 593 $i = $j; 594 $j = $temp; 595 } 596 597 my $cx = ($inst_space_x + $i * ($inst_space_x + $inst_size_x) + $inst_space_x + $j * ($inst_space_x + $inst_size_x) + $inst_size_x) /2; 598 my $w = ($j - $i) * ($inst_space_x + $inst_size_x); 599 600 $img->arc($cx, $inst_y-1, $w, $h * 2, 180, 0, $color); 601} 602