Align.pm
上传用户:qdrechuli
上传日期:2022-08-01
资源大小:917k
文件大小:10k
源码类别:

视频捕捉/采集

开发平台:

Visual C++

  1. # $Id: Align.pm,v 1.13 2000/03/18 05:56:52 mgjv Exp $
  2. package GD::Text::Align;
  3. $GD::Text::Align::VERSION = '$Revision: 1.13 $' =~ /s([d.]+)/;
  4. =head1 NAME
  5. GD::Text::Align - Draw aligned strings
  6. =head1 SYNOPSIS
  7.   use GD;
  8.   use GD::Text::Align;
  9.   my $gd = GD::Image->new(800,600);
  10.   # allocate colours, do other things.
  11.   my $align = GD::Text::Align->new($gd
  12.     valign => 'top',
  13.     halign => 'right',
  14.   );
  15.   $align->set_font('cetus.ttf', 12);
  16.   $align->set_text('some string');
  17.   @bb = $align->bounding_box(200, 400, PI/3);
  18.   # you can do things based on the bounding box here
  19.   $align->draw(200, 400, PI/3);
  20. =head1 DESCRIPTION
  21. GD::Text::Align provides an object that draws a string aligned
  22. to a coordinate at an angle.
  23. For builtin fonts only two angles are valid: 0 and PI/2. All other
  24. angles will be converted to one of these two.
  25. =head1 METHODS
  26. This class inherits everything from GD::Text. I will only discuss the
  27. methods and attributes here that are not discussed there, or that have a
  28. different interface or behaviour. Methods directly inherited include
  29. C<set_text> and C<set_font>.
  30. =cut
  31. use strict;
  32. # XXX add version number to GD
  33. use GD;
  34. use GD::Text;
  35. use Carp;
  36. @GD::Text::Align::ISA = qw(GD::Text);
  37. =head2 GD::Text::Align->new($gd_object, attrib => value, ...)
  38. Create a new object. The first argument to new has to be a valid
  39. GD::Image object. The other arguments will be passed on to the set
  40. method.
  41. =cut
  42. sub new
  43. {
  44.     my $proto = shift;
  45.     my $class = ref($proto) || $proto;
  46.     my $gd    = shift;
  47.     ref($gd) and $gd->isa('GD::Image') 
  48.         or croak "Not a GD::Image object";
  49. my $self = $class->SUPER::new() or return;
  50. $self->{gd} = $gd;
  51. $self->_init();
  52. $self->set(@_);
  53.     bless $self => $class;
  54. }
  55. my %defaults = (
  56. halign => 'left',
  57. valign => 'base',
  58. );
  59. sub _init
  60. {
  61. my $self = shift;
  62. while (my ($k, $v) = each(%defaults))
  63. {
  64. $self->{$k} = $v;
  65. }
  66. $self->{colour} = $self->{gd}->colorsTotal - 1,
  67. }
  68. =head2 $align->set(attrib => value, ...)
  69. Set an attribute. Valid attributes are the ones discussed in
  70. L<GD::Text> and:
  71. =over 4
  72. =item valign, halign
  73. Vertical and horizontal alignment of the string. See also set_valign and
  74. set_halign.
  75. =item colour, color
  76. Synonyms. The colour to use to draw the string. This should be the index
  77. of the colour in the GD::Image object's palette. The default value is
  78. the last colour in the GD object's palette at the time of the creation
  79. of C<$align>.
  80. =back
  81. =cut
  82. sub set
  83. {
  84. my $self = shift;
  85. $@ = "Incorrect attribute list", return if @_%2;
  86. my %args = @_;
  87. my @super;
  88. foreach (keys %args)
  89. {
  90. /^valign/ and do {
  91. $self->set_valign($args{$_}); 
  92. next;
  93. };
  94. /^halign/ and do {
  95. $self->set_halign($args{$_}); 
  96. next;
  97. };
  98. /^colou?r$/ and do {
  99. $self->{colour} = $args{$_};
  100. next;
  101. };
  102. # Save anything unknown to pass off to SUPER class
  103. push @super, $_, $args{$_};
  104. }
  105. $self->SUPER::set(@super);
  106. }
  107. =head2 $align->get(attribute)
  108. Get the value of an attribute.
  109. Valid attributes are all the attributes mentioned in L<GD::Text>, the
  110. attributes mentioned under the C<set> method and
  111. =over 4
  112. =item x, y and angle
  113. The x and y coordinate and the angle to be used. You can only do this
  114. after a call to the draw or bounding_box methods. Note that these
  115. coordinates are not necessarily the same ones that were passed in.
  116. Instead, they are the coordinates from where the GD methods will start
  117. drawing. I doubt that this is very useful to anyone.
  118. =back
  119. Note that while you can set the colour with both 'color' and 'colour',
  120. you can only get it as 'colour'. Sorry, but such is life in Australia.
  121. =cut
  122. # get is inherited unchanged
  123. =head2 $align->set_valign(value)
  124. Set the vertical alignment of the string to one of 'top', 'center',
  125. 'base' or 'bottom'. For builtin fonts the last two are the same. The
  126. value 'base' denotes the baseline of a TrueType font.
  127. Returns true on success, false on failure.
  128. =cut
  129. sub set_valign
  130. {
  131. my $self = shift;
  132. local $_ = shift or return;
  133. if (/^top/ || /^center/ || /^bottom/ || /^base/) 
  134. {
  135. $self->{valign} = $_; 
  136. return $_;
  137. }
  138. else
  139. {
  140. carp "Illegal vertical alignment: $_";
  141. return;
  142. }
  143. }
  144. =head2 $align->set_halign(value)
  145. Set the horizontal alignment of the string to one of 'left', 'center',
  146. or 'right'. 
  147. Returns true on success, false on failure.
  148. =cut
  149. sub set_halign
  150. {
  151. my $self = shift;
  152. local $_ = shift or return;
  153. if (/^left/ || /^center/ || /^right/) 
  154. {
  155. $self->{halign} = $_; 
  156. return $_;
  157. }
  158. else
  159. {
  160. carp "Illegal horizontal alignment: $_";
  161. return;
  162. }
  163. }
  164. =head2 $align->set_align(valign, halign)
  165. Set the vertical and horizontal alignment. Just here for convenience.
  166. See also C<set_valign> and C<set_halign>.
  167. Returns true on success, false on failure.
  168. =cut
  169. sub set_align
  170. {
  171. my $self = shift;
  172. $self->set_valign(shift) or return;
  173. $self->set_halign(shift) or return;
  174. }
  175. #
  176. # Determine whether a builtin font string should be drawn with the
  177. # string or stringUp method. It will use the stringUp method for any
  178. # angles between PI/4 and 3PI/4, 5PI/4 and 7PI/4, and all equivalents.
  179. #
  180. # return 
  181. # true for stringUp
  182. # false for string
  183. #
  184. sub _builtin_up
  185. {
  186. my $self = shift;
  187. return (
  188. sin($self->{angle}) > 0.5 * sqrt(2) || 
  189. sin($self->{angle}) < -0.5 * sqrt(2)
  190. )
  191. }
  192. #
  193. # Calculates the x and y coordinate that should be passed
  194. # to the GD::Image drawing routines, and set them as attributes
  195. #
  196. sub _align
  197. {
  198. my $self = shift;
  199. my ($x, $y, $angle) = @_;
  200. defined $x  && defined $y or carp "Need X and Y coordinates", return;
  201. $self->{angle} = $angle || 0;
  202. if ($self->is_builtin)
  203. {
  204. return $self->_align_builtin($x, $y);
  205. }
  206. elsif ($self->is_ttf)
  207. {
  208. return $self->_align_ttf($x, $y);
  209. }
  210. else
  211. {
  212. confess "Impossible error in GD::Text::Align::_align";
  213. }
  214. }
  215. #
  216. # calculate the alignment for a builtin font
  217. #
  218. sub _align_builtin
  219. {
  220. my $self = shift;
  221. my ($x, $y) = @_;
  222. # Swap coordinates and make sure to keep the sign right, since left
  223. # becomes _down_ (larger) and right becomes _up_ (smaller)
  224. ($x, $y) = (-$y, $x) if ($self->_builtin_up);
  225. for ($self->{halign})
  226. {
  227. #/^left/   and $x = $x;
  228. /^center/ and $x -= $self->{width}/2;
  229. /^right/  and $x -= $self->{width};
  230. }
  231. for ($self->{valign})
  232. {
  233. #/^top/    and $y = $y;
  234. /^center/ and $y -= $self->{height}/2;
  235. /^bottom/ and $y -= $self->{height};
  236. /^base/   and $y -= $self->{height};
  237. }
  238. ($x, $y) = ($y, -$x) if ($self->_builtin_up);
  239. $self->{'x'} = $x;
  240. $self->{'y'} = $y;
  241. return 1;
  242. }
  243. #
  244. # calculate the alignment for a TrueType font
  245. #
  246. sub _align_ttf
  247. {
  248. my $self = shift;
  249. my ($x, $y) = @_;
  250. my $phi = $self->{angle};
  251. for ($self->{halign})
  252. {
  253. #/^left/ and $x = $x;
  254. /^center/ and do {
  255. $x -= cos($phi) * $self->{width}/2;
  256. $y += sin($phi) * $self->{width}/2;
  257. };
  258. /^right/  and do {
  259. $x -= cos($phi) * $self->{width};
  260. $y += sin($phi) * $self->{width};
  261. };
  262. }
  263. for ($self->{valign})
  264. {
  265. /^top/    and do {
  266. $x += sin($phi) * $self->{char_up};
  267. $y += cos($phi) * $self->{char_up};
  268. };
  269. /^center/ and do {
  270. $x -= sin($phi) * ($self->{char_down} - $self->{height}/2);
  271. $y -= cos($phi) * ($self->{char_down} - $self->{height}/2);
  272. };
  273. /^bottom/ and do {
  274. $x -= sin($phi) * $self->{char_down};
  275. $y -= cos($phi) * $self->{char_down};
  276. };
  277. #/^base/   and $y = $y;
  278. }
  279. $self->{'x'} = $x;
  280. $self->{'y'} = $y;
  281. return 1;
  282. }
  283. =head2 $align->draw(x, y, angle)
  284. Draw the string at coordinates I<x>, I<y> at an angle I<angle> in
  285. radians. The x and y coordinate become the pivot around which the
  286. string rotates.
  287. Note that for the builtin GD fonts the only two valid angles are 0 and
  288. PI/2.
  289. Returns the bounding box of the drawn string (see C<bounding_box()>).
  290. =cut
  291. sub draw
  292. {
  293. my $self = shift;
  294. my ($x, $y, $angle) = @_;
  295. $@ = "No text set", return unless defined $self->{text};
  296. $@ = "No colour set", return unless defined $self->{colour};
  297. $self->_align($x, $y, $angle) or return;
  298. if ($self->is_builtin)
  299. {
  300. if ($self->_builtin_up)
  301. {
  302. $self->{gd}->stringUp($self->{font}, 
  303. $self->{'x'}, $self->{'y'},
  304. $self->{text}, $self->{colour});
  305. }
  306. else
  307. {
  308. $self->{gd}->string($self->{font}, 
  309. $self->{'x'}, $self->{'y'},
  310. $self->{text}, $self->{colour});
  311. }
  312. }
  313. elsif ($self->is_ttf)
  314. {
  315. $self->{gd}->stringTTF($self->{colour}, 
  316. $self->{font}, $self->{ptsize},
  317. $self->{angle}, $self->{'x'}, $self->{'y'}, $self->{text});
  318. }
  319. else
  320. {
  321. confess "impossible error in GD::Text::Align::draw";
  322. }
  323. return $self->bounding_box($x, $y, $angle);
  324. }
  325. =head2 $align->bounding_box(x, y, angle)
  326. Return the bounding box of the string to draw. This returns an
  327. eight-element list (exactly like the GD::Image->stringTTF method):
  328.   (x1,y1) lower left corner
  329.   (x2,y2) lower right corner
  330.   (x3,y3) upper right corner
  331.   (x4,y4) upper left corner
  332. Note that upper, lower, left and right are relative to the string, not
  333. to the canvas.
  334. The bounding box can be used to make decisions about whether to move the
  335. string or change the font size prior to actually drawing the string.
  336. =cut
  337. sub bounding_box
  338. {
  339. my $self = shift;
  340. my ($x, $y, $angle) = @_;
  341. $@ = "No text set", return unless defined $self->{text};
  342. $self->_align($x, $y, $angle) or return;
  343. if ($self->is_builtin)
  344. {
  345. if ($self->_builtin_up)
  346. {
  347. return (
  348. $self->{'x'} + $self->{height}, $self->{'y'},
  349. $self->{'x'} + $self->{height}, $self->{'y'} - $self->{width},
  350. $self->{'x'}                  , $self->{'y'} - $self->{width},
  351. $self->{'x'}                  , $self->{'y'},
  352. )
  353. }
  354. else
  355. {
  356. return (
  357. $self->{'x'}                 , $self->{'y'} + $self->{height},
  358. $self->{'x'} + $self->{width}, $self->{'y'} + $self->{height},
  359. $self->{'x'} + $self->{width}, $self->{'y'},
  360. $self->{'x'}                 , $self->{'y'},
  361. )
  362. }
  363. }
  364. elsif ($self->is_ttf)
  365. {
  366. return GD::Image->stringTTF($self->{colour}, 
  367. $self->{font}, $self->{ptsize},
  368. $self->{angle}, $self->{'x'}, $self->{'y'}, $self->{text});
  369. }
  370. else
  371. {
  372. confess "impossible error in GD::Text::Align::draw";
  373. }
  374. }
  375. =head1 NOTES
  376. As with all Modules for Perl: Please stick to using the interface. If
  377. you try to fiddle too much with knowledge of the internals of this
  378. module, you may get burned. I may change them at any time.
  379. You can only use TrueType fonts with version of GD > 1.20, and then
  380. only if compiled with support for this. If you attempt to do it
  381. anyway, you will get errors.
  382. In the following, terms like 'top', 'upper', 'left' and the like are all
  383. relative to the string to be drawn, not to the canvas.
  384. =head1 BUGS
  385. Any bugs inherited from GD::Text.
  386. =head1 COPYRIGHT
  387. copyright 1999
  388. Martien Verbruggen (mgjv@comdyn.com.au)
  389. =head1 SEE ALSO
  390. L<GD>, L<GD::Text>, L<GD::Text::Wrap>
  391. =cut
  392. 1;