[Bio] / FigKernelPackages / gd_tree_0.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/gd_tree_0.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Sat Feb 6 23:01:21 2010 UTC revision 1.5, Tue Apr 13 22:54:33 2010 UTC
# Line 178  Line 178 
178    
179      #  colors will all be [r,g,b] in 0 - 255 range;      #  colors will all be [r,g,b] in 0 - 255 range;
180      #  sizes will all be in pixels      #  sizes will all be in pixels
181        #  work on a local copy of options, so I can write to it
182    
183      my %options = ref( $options ) eq 'HASH' ? %$options : ();      my %options = ref( $options ) eq 'HASH' ? %$options : ();
184    
# Line 395  Line 396 
396      my $ymax = int( $nodeinfo->{ yn } + 0.5 * $options->{ dy } + 0.4999 );      my $ymax = int( $nodeinfo->{ yn } + 0.5 * $options->{ dy } + 0.4999 );
397      $options->{ ymax } = $ymax;      $options->{ ymax } = $ymax;
398      my @size = ( $xmax + 1, $ymax + 1 );      my @size = ( $xmax + 1, $ymax + 1 );
399      my $image = new GD::Image( @size );      my $image = myNewImage( @size );      # trueColor is false
     $image->trueColor( 1 );  
400    
401      #  Background is done outside of my management:      #  Background is done outside of my color management:
402    
403      my $bkg;      my $bkg;
404      if ( $options->{ bkg_color } )      if ( $options->{ bkg_color } )
# Line 407  Line 407 
407      }      }
408      else      else
409      {      {
410          $bkg = $image->colorAllocate( 255, 255, 255 );          #  Lets us use white on a transparent background (evil).
411            $bkg = $image->colorAllocate( 254, 254, 254 );
412          $image->transparent( $bkg );          $image->transparent( $bkg );
413      }      }
414      $options->{ bkg_index  } = $bkg;      $options->{ bkg_index  } = $bkg;
# Line 777  Line 778 
778  #  We can pretty quickly manage colors without worrying about the GD limits.  #  We can pretty quickly manage colors without worrying about the GD limits.
779  #  Generally the idea is to not free any colors.  Just let automatic recycling  #  Generally the idea is to not free any colors.  Just let automatic recycling
780  #  take over if necessary.  #  take over if necessary.
781    #
782    #  This is a fallback:
783    
784    sub myGetColor_alt
785    {
786        my $image = shift;
787        my ( @RGB ) = map { $_ || 0 } ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;
788        $image->colorAllocate( @RGB );
789    }
790    
791    
792  BEGIN  BEGIN
793  {  {
794  my %colorIndex   = ();  my %colorSet;      # We allow concurrent images.  I don't know if GD does.
 my %indexColor   = ();  
 my @recycleStack = ();  
 my $n_allo       =  0;  
795  my $n_stable     = 64;  my $n_stable     = 64;
796  my %is_stable    = ();  
797    sub myNewImage
798    {
799        my $image = new GD::Image( @_ );   # width, height
800        $image->trueColor( 0 );
801        # $image->trueColor( 1 );  # GD has a very bad color saved state issue
802    
803        # Associate a color mapping to the image
804        $colorSet{ $image } = { colorIndex   => {},
805                                indexColor   => {},
806                                recycleStack => [],
807                                n_allo       =>  0,
808                                is_stable    => {}
809                              };
810    
811        $image;
812    }
813    
814    
815  sub myGetColor  sub myGetColor
816  {  {
817      my $image = shift;      my $image = shift;
818    
819        my $colorSetH     = $colorSet{ $image };
820        my $colorIndexH   = $colorSetH->{ colorIndex };
821        my $indexColorH   = $colorSetH->{ indexColor };
822        my $recycleStackA = $colorSetH->{ recycleStack };
823    
824      my ( @RGB ) = map { $_ || 0 } ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;      my ( @RGB ) = map { $_ || 0 } ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_;
825      my $name = sprintf '%03d.%03d.%03d', @RGB;      my $name = sprintf '%03d.%03d.%03d', @RGB;
826      return $colorIndex{ $name } if $colorIndex{ $name };      return $colorIndexH->{ $name } if $colorIndexH->{ $name };
827      if ( $n_allo > 250 )      if ( $colorSetH->{ n_allo } > 250 )
828      {      {
829          my ( $del_name, $free_index ) = @{ shift @recycleStack };          my ( $del_name, $free_index ) = @{ shift @$recycleStackA };
830          $image->colorDeallocate( $free_index );          $image->colorDeallocate( $free_index );
831          delete $colorIndex{ $del_name };          delete $colorIndexH->{ $del_name };
832          delete $indexColor{ $free_index };          delete $indexColorH->{ $free_index };
833          $n_allo--;          $colorSetH->{ n_allo }--;
834      }      }
835      my $index = $image->colorAllocate( @RGB );      my $index = $image->colorAllocate( @RGB );
836      $colorIndex{ $name  } = $index;      $colorIndexH->{ $name  } = $index;
837      $indexColor{ $index } = $name;      $indexColorH->{ $index } = $name;
838      if ( ++$n_allo > $n_stable )      if ( ++$colorSetH->{ n_allo } > $n_stable )
839      {      {
840          push @recycleStack, [ $name, $index ];          push @$recycleStackA, [ $name, $index ];
841      }      }
842      else      else
843      {      {
844          $is_stable{ $index } = 1;          $colorSetH->{ is_stable }->{ $index } = 1;
845      }      }
846    
847      $index;      $index;
# Line 819  Line 850 
850  sub myFreeColor  sub myFreeColor
851  {  {
852      my ( $image, $index ) = @_;      my ( $image, $index ) = @_;
853      my $name = $indexColor{ $index };  
854        my $colorSetH     = $colorSet{ $image };
855        my $colorIndexH   = $colorSetH->{ colorIndex };
856        my $indexColorH   = $colorSetH->{ indexColor };
857        my $recycleStackA = $colorSetH->{ recycleStack };
858    
859        my $name = $indexColorH->{ $index };
860      return unless $name;      return unless $name;
861    
862      if ( $is_stable{ $index } )      if ( $colorSetH->{ is_stable }->{ $index } )
863      {      {
864          delete $is_stable{ $index };          delete $colorSetH->{ is_stable }->{ $index };
865          if ( @recycleStack )          if ( @$recycleStackA )
866          {          {
867              $is_stable{ $recycleStack[0]->[1] } = 1;              $colorSetH->{ is_stable }->{ $recycleStackA->[0]->[1] } = 1;
868              shift @recycleStack;              shift @$recycleStackA;
869          }          }
870      }      }
871      else      else
872      {      {
873          @recycleStack = grep { $_->[1] != $index } @recycleStack;          @$recycleStackA = grep { $_->[1] != $index } @$recycleStackA;
874      }      }
875    
876      $image->colorDeallocate( $index );      $image->colorDeallocate( $index );
877      delete $colorIndex{ $name };      delete $colorIndexH->{ $name };
878      delete $indexColor{ $index };      delete $indexColorH->{ $index };
879      $n_allo--;      $colorSetH->{ n_allo }--;
880  }  }
881    
882  }  }

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3