This file is indexed.

/usr/lib/perl5/Ace/Graphics/Track.pm is in libace-perl 1.92-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
package Ace::Graphics::Track;
# This embodies the logic for drawing a single track of features.
# Features are of uniform style and are controlled by descendents of
# the Ace::Graphics::Glyph class (eek!).

use Ace::Graphics::GlyphFactory;
use Ace::Graphics::Fk;
use GD;  # maybe
use Carp 'croak';
use vars '$AUTOLOAD';
use strict;

sub AUTOLOAD {
  my $self = shift;
  my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
  $self->factory->$func_name(@_);
}

sub DESTROY { }

# Pass a list of Ace::Sequence::Feature objects, and a glyph name
sub new {
  my $class = shift;
  my ($glyph_name,$features,@options) = @_;

  $glyph_name ||= 'generic';
  $features   ||= [];

  my $glyph_factory = $class->make_factory($glyph_name,@options);
  my $self = bless {
		    features => [],                     # list of Ace::Sequence::Feature objects
		    factory  => $glyph_factory,         # the glyph class associated with this track
		    glyphs   => undef,                  # list of glyphs
		   },$class;
  $self->add_feature($_) foreach @$features;
  $self;
}

# control bump direction:
#    +1   => bump downward
#    -1   => bump upward
#     0   => no bump
sub bump {
  my $self = shift;
  $self->factory->option('bump',@_);
}

# add a feature (or array ref of features) to the list
sub add_feature {
  my $self       = shift;
  my $feature    = shift;
  if (ref($feature) eq 'ARRAY') {
    my $name     = ++$self->{group_name};
    $self->{group_ids}{$name} = $feature;
  } else {
    push @{$self->{features}},$feature;
  }
}

# link a set of features together so that they bump as a group
sub add_group {
  my $self     = shift;
  my $features = shift;
  ref($features) eq 'ARRAY' or croak("Usage: Ace::Graphics::Track->add_group(\$arrayref)");
  $self->add_feature($features);
}

# delegate lineheight to the glyph
sub lineheight {
  shift->{factory}->height(@_);
}

# the scale is horizontal, measured in pixels/bp
sub scale {
  my $self = shift;
  my $g = $self->{scale};
  $self->{scale} = shift if @_;
  $g;
}

sub width {
  my $self = shift;
  my $g = $self->{width};
  $self->{width} = shift if @_;
  $g;
}

# set scale by a segment
sub scale_to_segment {
  my $self = shift;
  my ($segment,$desired_width) = @_;
  $self->set_scale(abs($segment->length),$desired_width);
}

sub set_scale {
  my $self = shift;
  my ($bp,$desired_width) = @_;
  $desired_width ||= 512;
  $self->scale($desired_width/$bp);
  $self->width($desired_width);
}

# return the glyph class
sub factory {
  my $self = shift;
  my $g = $self->{factory};
  $self->{factory} = shift if @_;
  $g;
}

# return boxes for each of the glyphs
# will be an array of four-element [$feature,l,t,r,b] arrays
sub boxes {
  my $self = shift;
  my ($left,$top) = @_;
  $top  += 0; $left += 0;
  my @result;

  my $glyphs = $self->layout;

  for my $g (@$glyphs) {
    my ($l,$t,$r,$b) = $g->box;
    push @result,[$g->feature,$left+$l,$top+$t,$left+$r,$top+$b];

  }

  return wantarray ? @result : \@result;
}

# synthesize a key glyph
sub keyglyph {
  my $self = shift;
  my $scale = 1/$self->scale;  # base pairs/pixel
  # two segments, at pixels 0->50, 60->80
  my $offset = $self->offset;
  my $feature = Ace::Graphics::Fk->new(-segments=>[ [ 0*$scale +$offset,50*$scale+$offset],
						    [60*$scale+$offset, 80*$scale+$offset]
						    ],
				       -name => $self->option('key'),
				       -strand => '+1');
  my $factory = $self->factory->clone;
  $factory->scale($self->scale);
  $factory->width($self->width);
  $factory->option(label=>1);  # turn on labels
  return $factory->glyph($feature);
}

# draw glyphs onto a GD object at the indicated position
sub draw {
  my $self = shift;
  my ($gd,$left,$top) = @_;
  $top  += 0;  $left += 0;
  my $glyphs = $self->layout;

  # draw background
  my $bgcolor = $self->factory->bgcolor;
  # $gd->filledRectangle($left,$top,$left+$self->width,$top+$self->height,$bgcolor);

  if (my $label = $self->factory->option('track_label')) {
    my $font = $self->factory->font;
    my $y = $top + ($self->height-$font->height)/2;
    my $x = $left - length($label) * $font->width;
    $gd->string($font,$x,$y,$label,$self->factory->fontcolor);
  }
  $_->draw($gd,$left,$top) foreach @$glyphs;

  if ($self->factory->option('connectgroups')) {
    $_->draw($gd,$left,$top) foreach @{$self->{groups}};
  }
}

# lay out -- this uses the infamous bump algorithm
sub layout {
  my $self = shift;
  my $force = shift || 0;
  return $self->{glyphs} if $self->{glyphs} && !$force;

  my $f = $self->{features};
  my $factory = $self->factory;
  $factory->scale($self->scale);  # set the horizontal scale
  $factory->width($self->width);

  # create singleton glyphs
  my @singletons = map { $factory->glyph($_) } @$f;

  # create linked groups of glyphs
  my @groups;
  if (my $groups = $self->{group_ids}) {
    my $groupfactory = Ace::Graphics::GlyphFactory->new('group');
    for my $g (values %$groups) {
      my @g = map { $factory->glyph($_) } @$g;
      push @groups,$groupfactory->glyph(\@g);
    }
  }

  return $self->{glyphs} = [] unless @singletons || @groups;

  # run the bumper on the groups
  $self->_bump([@singletons,@groups]) if $self->bump;

  # merge the singletons and groups and sort them horizontally
  my @glyphs = sort {$a->left <=> $b->left } @singletons,map {$_->members} @groups;

  # If -1 bumping was allowed, then normalize so that the top glyph is at zero
  my ($topmost) = sort {$a->top <=> $b->top} @glyphs;
  my $offset = 0 - $topmost->top;
  $_->move(0,$offset) foreach @glyphs;

  $self->{groups}        = \@groups;
  return $self->{glyphs} = \@glyphs;
}

# bumper - glyphs already sorted left to right
sub _bump {
  my $self   = shift;
  my $glyphs = shift;
  my $bump_direction = $self->bump;  # +1 means bump down, -1 means bump up

  my @occupied;
  my $rightmost = -2;
  for my $g (sort { $a->left <=> $b->left} @$glyphs) {

    my $pos = 0;
    while (1) {
      # look for collisions
      last if $g->left > $rightmost + 2;
      my $bottom = $pos + $g->height;

      my $collision = 0;
      for my $old (@occupied) {
	last if $old->right + 2 < $g->left;
	next if $old->bottom < $pos;
	next if $old->top > $bottom;
	$collision = $old;
	last;
      }
      last unless $collision;
      if ($bump_direction > 0) {
	$pos += $collision->height + 2;                    # collision, so bump
      } else {
	$pos -= $g->height + 2;
      }
    }

    $g->move(0,$pos);
    @occupied = sort { $b->right <=> $a->right } ($g,@occupied);
    $rightmost = $g->right if $g->right > $rightmost;
  }
}

# return list of glyphs -- only after they are laid out
sub glyphs { shift->{glyphs} }

# height is determined by the layout, and cannot be externally controlled
sub height {
  my $self = shift;
  return $self->{cache_height} if defined $self->{cache_height};

  $self->layout;
  my $glyphs = $self->{glyphs} or croak "Can't lay out";
  return 0 unless @$glyphs;

  my ($topmost)    = sort { $a->top    <=> $b->top }    @$glyphs;
  my ($bottommost) = sort { $b->bottom <=> $a->bottom } @$glyphs;

  return $self->{cache_height} = $bottommost->bottom - $topmost->top;
}

sub make_factory {
  my ($class,$type,@options) = @_;
  Ace::Graphics::GlyphFactory->new($type,@options);
}


1;
__END__

=head1 NAME

Ace::Graphics::Track - PNG graphics of Ace::Sequence::Feature objects

=head1 SYNOPSIS

  use Ace::Sequence;
  use Ace::Graphics::Panel;

  my $db     = Ace->connect(-host=>'brie2.cshl.org',-port=>2005) or die;
  my $cosmid = Ace::Sequence->new(-seq=>'Y16B4A',
				  -db=>$db,-start=>-15000,-end=>15000) or die;

  my @transcripts = $cosmid->transcripts;

  my $panel = Ace::Graphics::Panel->new(
				      -segment => $cosmid,
				      -width  => 800
				     );


  my $track = $panel->add_track('transcript'
   		                -fillcolor =>  'wheat',
				-fgcolor   =>  'black',
				-bump      =>  +1,
				-height    =>  10,
				-label     =>  1);
  foreach (@transcripts) {
     $track->add_feature($_);
  }

  my $boxes = $panel->boxes;
  print $panel->png;


=head1 DESCRIPTION

The Ace::Graphics::Track class is used by Ace::Graphics::Panel to lay
out a set of sequence features using a uniform glyph type. You will
ordinarily work with panels rather than directly with tracks.

=head1 METHODS

This section describes the class and object methods for
Ace::Graphics::Panel.

=head2 CONSTRUCTORS

There is only one constructor, the new() method.  It is ordinarily
called by Ace::Graphics::Panel, and not in end-developer code.

=over 4

=item $track = Ace::Graphics::Track->new($glyph_name,$features,@options)

The new() method creates a new track object from the provided glyph
name and list of features.  The arguments are similar to those in
Ace::Graphics::Panel->new().

If successful new() will return a new Ace::Graphics::Track.
Otherwise, it will return undef.

If the specified glyph name is not a valid one, new() will throw an
exception.

=back

=head2 OBJECT METHODS

Once a track is created, the following methods can be invoked.

=over 4

=item $track->add_feature($feature)

This adds a new feature to the track.  The feature can either be a
single object that implements the Bio::SeqFeatureI interface (such as
an Ace::Sequence::Feature or Das::Segment::Feature), or can be an
anonymous array containing a set of related features.  In the latter
case, the track will attempt to keep the features in the same
horizontal band and will not allow any other features to overlap.

=item $track->add_group($group)

This behaves the same as add_feature(), but requires that its argument
be an array reference containing a list of grouped features.

=item $track->draw($gd,$left,$top)

Render the track on a previously-created GD::Image object.  The $left
and $top arguments indicate the position at which to start rendering.

=item $boxes = $track->boxes($left,$top)

=item @boxes = $track->boxes($left,$top)

Return an array of array references indicating glyph coordinates for
each of the render features.  $left and $top indicate the offset for
the track on the image plane.  In a scalar context, this method
returns an array reference of glyph coordinates.  In a list context,
it returns the list itself.

See Ace::Graphics::Panel->boxes() for the format of the result.

=back

=head2 ACCESSORS

The following accessor methods provide access to various attributes of
the track object.  Called with no arguments, they each return the
current value of the attribute.  Called with a single argument, they
set the attribute and return its previous value.

Note that in most cases you must change attributes before the track's
layout() method is called.

   Accessor Name      Description
   -------------      -----------

   scale()	      Get/set the track scale, measured in pixels/bp
   lineheight()	      Get/set the height of each glyph, pixels
   width()	      Get/set the width of the track
   bump()	      Get/set the bump direction

=head2 INTERNAL METHODS

The following methods are used internally, but may be useful for those
implementing new glyph types.

=over 4

=item $glyphs = $track->layout

Layout the features, and return an anonymous array of
Ace::Graphics::Glyph objects that have been created and correctly
positioned.

Because layout is an expensive operation, calling this method several
times will return the previously-cached result, ignoring any changes
to track attributes.

=item $height = $track->height

Invokes layout() and returns the height of the track.

=item $glyphs = $track->glyphs

Returns the glyph cache.  Returns undef before layout() and a
reference to an array of glyphs after layout().

=item $factory = $track->make_factory(@options)

Given a set of options (argument/value pairs), returns a
Ace::Graphics::GlyphFactory for use in creating the glyphs with the
desired settings.

=back

=head1 BUGS

Please report them.

=head1 SEE ALSO

L<Ace::Sequence>,L<Ace::Sequence::Feature>,L<Ace::Graphics::Panel>,
L<Ace::Graphics::GlyphFactory>,L<Ace::Graphics::Glyph>

=head1 AUTHOR

Lincoln Stein <lstein@cshl.org>.

Copyright (c) 2001 Cold Spring Harbor Laboratory

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  See DISCLAIMER.txt for
disclaimers of warranty.

=cut