1package Prima::PS::Drawable;
2use vars qw(@ISA);
3@ISA = qw(Prima::Drawable);
4
5use strict;
6use warnings;
7use Prima;
8
9{
10my %RNT = (
11	%{Prima::Drawable-> notification_types()},
12	Spool => nt::Action,
13);
14
15sub notification_types { return \%RNT; }
16}
17
18
19sub profile_default
20{
21	my $def = $_[ 0]-> SUPER::profile_default;
22	my %prf = (
23		grayscale        => 0,
24		pageSize         => [ 598, 845],
25		pageMargins      => [ 12, 12, 12, 12],
26		resolution       => [ 300, 300],
27		reversed         => 0,
28		rotate           => 0,
29		scale            => [ 1, 1],
30		textOutBaseline  => 0,
31	);
32	@$def{keys %prf} = values %prf;
33	return $def;
34}
35
36sub init
37{
38	my $self = shift;
39	$self-> {clipRect}    = [0,0,0,0];
40	$self-> {pageSize}    = [0,0];
41	$self-> {pageMargins} = [0,0,0,0];
42	$self-> {resolution}  = [72,72];
43	$self-> {scale}       = [ 1, 1];
44	$self-> {rotate}      = 1;
45	my %profile = $self-> SUPER::init(@_);
46	$self-> $_( $profile{$_}) for qw( grayscale rotate reversed );
47	$self-> $_( @{$profile{$_}}) for qw( pageSize pageMargins resolution scale );
48	$self->{fpType} = 'F';
49	return %profile;
50}
51
52sub save_state
53{
54	my $self = $_[0];
55
56	$self-> {save_state} = {};
57	$self-> {save_state}-> {$_} = $self-> $_() for qw(
58		color backColor fillPattern lineEnd linePattern lineWidth miterLimit
59		rop rop2 textOpaque textOutBaseline font lineJoin fillMode
60	);
61	$self->{save_state}->{fpType} = $self->{fpType};
62	$self-> {save_state}-> {$_} = [$self-> $_()] for qw(
63		translate clipRect
64	);
65}
66
67sub restore_state
68{
69	my $self = $_[0];
70	for ( qw( color backColor fillPattern lineEnd linePattern lineWidth miterLimit
71			rop rop2 textOpaque textOutBaseline font lineJoin fillMode)) {
72		$self-> $_( $self-> {save_state}-> {$_});
73	}
74	$self->{fpType} = $self->{save_state}->{fpType};
75	for ( qw( translate clipRect)) {
76		$self-> $_( @{$self-> {save_state}-> {$_}});
77	}
78}
79
80sub pixel2point
81{
82	my $self = shift;
83	my $i;
84	my @res;
85	for ( $i = 0; $i < scalar @_; $i+=2) {
86		my ( $x, $y) = @_[$i,$i+1];
87		push @res, int( $x * 7227 / $self-> {resolution}-> [0] + 0.5) / 100;
88		push @res, int( $y * 7227 / $self-> {resolution}-> [1] + 0.5) / 100 if defined $y;
89	}
90	return @res;
91}
92
93sub point2pixel
94{
95	my $self = shift;
96	my $i;
97	my @res;
98	for ( $i = 0; $i < scalar @_; $i+=2) {
99		my ( $x, $y) = @_[$i,$i+1];
100		push @res, $x * $self-> {resolution}-> [0] / 72.27;
101		push @res, $y * $self-> {resolution}-> [1] / 72.27 if defined $y;
102	}
103	return @res;
104}
105
106our $PI = 3.14159265358979323846264338327950288419716939937510;
107our $RAD = 180.0 / $PI;
108
109# L.Maisonobe 2003
110# http://www.spaceroots.org/documents/ellipse/elliptical-arc.pdf
111sub arc2cubics
112{
113	my ( $self, $x, $y, $dx, $dy, $start, $end) = @_;
114
115	my ($reverse, @out);
116	($start, $end, $reverse) = ( $end, $start, 1 ) if $start > $end;
117
118	push @out, $start;
119	# see defects appearing after 45 degrees:
120	# https://pomax.github.io/bezierinfo/#circles_cubic
121	while (1) {
122		if ( $end - $start > 45 ) {
123			push @out, $start += 45;
124			$start += 45;
125		} else {
126			push @out, $end;
127			last;
128		}
129	}
130	@out = map { $_ / $RAD } @out;
131
132	my $rx = $dx / 2;
133	my $ry = $dy / 2;
134
135	my @cubics;
136	for ( my $i = 0; $i < $#out; $i++) {
137		my ( $a1, $a2 ) = @out[$i,$i+1];
138		my $b           = $a2 - $a1;
139		my ( $sin1, $cos1, $sin2, $cos2) = ( sin($a1), cos($a1), sin($a2), cos($a2) );
140		my @d1  = ( -$rx * $sin1, -$ry * $cos1 );
141		my @d2  = ( -$rx * $sin2, -$ry * $cos2 );
142		my $tan = sin( $b / 2 ) / cos( $b / 2 );
143		my $a   = sin( $b ) * (sqrt( 4 + 3 * $tan * $tan) - 1) / 3;
144		my @p1  = ( $rx * $cos1, $ry * $sin1 );
145		my @p2  = ( $rx * $cos2, $ry * $sin2 );
146		my @points = (
147			@p1,
148			$p1[0] + $a * $d1[0],
149			$p1[1] - $a * $d1[1],
150			$p2[0] - $a * $d2[0],
151			$p2[1] + $a * $d2[1],
152			@p2
153		);
154		$points[$_] += $x for 0,2,4,6;
155		$points[$_] += $y for 1,3,5,7;
156		@points[0,1,2,3,4,5,6,7] = @points[6,7,4,5,2,3,0,1] if $reverse;
157		push @cubics, \@points;
158	}
159	return \@cubics;
160}
161
162sub conic2curve
163{
164	my ($self, $x0, $y0, $x1, $y1, $x2, $y2) = @_;
165	my (@cp1, @cp2);
166	$cp1[0] = $x0 + 2 / 3 * ($x1 - $x0);
167	$cp1[1] = $y0 + 2 / 3 * ($y1 - $y0);
168	$cp2[0] = $x2 + 2 / 3 * ($x1 - $x2);
169	$cp2[1] = $y2 + 2 / 3 * ($y1 - $y2);
170	return @cp1, @cp2, $x2, $y2;
171}
172
173sub begin_paint_info
174{
175	my $self = $_[0];
176	return 0 if $self-> get_paint_state;
177	my $ok = $self-> SUPER::begin_paint_info;
178	return 0 unless $ok;
179	$self-> save_state;
180}
181
182sub end_paint_info
183{
184	my $self = $_[0];
185	return if $self-> get_paint_state != ps::Information;
186	$self-> SUPER::end_paint_info;
187	$self-> restore_state;
188}
189
190sub spool
191{
192	shift-> notify( 'Spool', @_);
193	return 1;
194}
195
196# properties
197
198sub color
199{
200	return $_[0]-> SUPER::color unless $#_;
201	$_[0]-> SUPER::color( $_[1]);
202	return unless $_[0]-> {can_draw};
203	$_[0]-> {changed}-> {fill} = 1;
204}
205
206sub fillPatternOffset
207{
208	return $_[0]-> SUPER::fillPatternOffset unless $#_;
209	$_[0]-> SUPER::fillPatternOffset($_[1], $_[2]);
210	return unless $_[0]-> {can_draw};
211	$_[0]-> {changed}-> {fillPatternOffset} = 1;
212}
213
214sub lineEnd
215{
216	return $_[0]-> SUPER::lineEnd unless $#_;
217	$_[0]-> SUPER::lineEnd($_[1]);
218	return unless $_[0]-> {can_draw};
219	$_[0]-> {changed}-> {lineEnd} = 1;
220}
221
222sub lineJoin
223{
224	return $_[0]-> SUPER::lineJoin unless $#_;
225	$_[0]-> SUPER::lineJoin($_[1]);
226	return unless $_[0]-> {can_draw};
227	$_[0]-> {changed}-> {lineJoin} = 1;
228}
229
230sub fillMode
231{
232	return $_[0]-> SUPER::fillMode unless $#_;
233	$_[0]-> SUPER::fillMode($_[1]);
234}
235
236sub linePattern
237{
238	return $_[0]-> SUPER::linePattern unless $#_;
239	$_[0]-> SUPER::linePattern($_[1]);
240	return unless $_[0]-> {can_draw};
241	$_[0]-> {changed}-> {linePattern} = 1;
242}
243
244sub lineWidth
245{
246	return $_[0]-> SUPER::lineWidth unless $#_;
247	$_[0]-> SUPER::lineWidth($_[1]);
248	return unless $_[0]-> {can_draw};
249	$_[0]-> {changed}-> {lineWidth} = 1;
250}
251
252sub miterLimit
253{
254	return $_[0]-> SUPER::miterLimit unless $#_;
255	my ( $self, $ml ) = @_;
256	$ml = 1.0 if $ml < 0;
257	$self-> SUPER::miterLimit($ml);
258	return unless $self-> {can_draw};
259	$self-> {changed}-> {miterLimit} = 1;
260}
261
262sub rop
263{
264	return $_[0]-> SUPER::rop unless $#_;
265	my ( $self, $rop) = @_;
266	$rop = rop::CopyPut if
267		$rop != rop::Blackness || $rop != rop::Whiteness || $rop != rop::NoOper;
268	$self-> SUPER::rop( $rop);
269}
270
271sub rop2
272{
273	return $_[0]-> SUPER::rop2 unless $#_;
274	my ( $self, $rop) = @_;
275	$rop = rop::CopyPut if
276		$rop != rop::Blackness && $rop != rop::Whiteness && $rop != rop::NoOper;
277	$self-> SUPER::rop2( $rop);
278}
279
280sub translate
281{
282	return $_[0]-> SUPER::translate unless $#_;
283	my $self = shift;
284	$self-> SUPER::translate(@_);
285	$self-> change_transform;
286}
287
288sub clipRect
289{
290	return @{$_[0]-> {clipRect}} unless $#_;
291	$_[0]-> {clipRect} = [@_[1..4]];
292	$_[0]-> {region} = undef;
293	$_[0]-> change_transform;
294}
295
296sub region
297{
298	return undef;
299}
300
301sub scale
302{
303	return @{$_[0]-> {scale}} unless $#_;
304	my $self = shift;
305	$self-> {scale} = [@_[0,1]];
306	$self-> change_transform;
307}
308
309sub reversed
310{
311	return $_[0]-> {reversed} unless $#_;
312	my $self = $_[0];
313	$self-> {reversed} = $_[1] unless $self-> get_paint_state;
314	$self-> calc_page;
315}
316
317sub rotate
318{
319	return $_[0]-> {rotate} unless $#_;
320	my $self = $_[0];
321	$self-> {rotate} = $_[1];
322	$self-> change_transform;
323}
324
325sub resolution
326{
327	return @{$_[0]-> {resolution}} unless $#_;
328	return if $_[0]-> get_paint_state;
329	my ( $x, $y) =  @_[1..2];
330	return if $x <= 0 || $y <= 0;
331	$_[0]-> {resolution} = [$x, $y];
332	$_[0]-> calc_page;
333}
334
335sub grayscale
336{
337	return $_[0]-> {grayscale} unless $#_;
338	$_[0]-> {grayscale} = $_[1] unless $_[0]-> get_paint_state;
339}
340
341sub calc_page
342{
343	my $self = $_[0];
344	my @s =  @{$self-> {pageSize}};
345	my @m =  @{$self-> {pageMargins}};
346	if ( $self-> {reversed}) {
347		@s = @s[1,0];
348		@m = @m[1,0,3,2];
349	}
350	$self-> {size} = [
351		int(( $s[0] - $m[0] - $m[2]) * $self-> {resolution}-> [0] / 72.27 + 0.5),
352		int(( $s[1] - $m[1] - $m[3]) * $self-> {resolution}-> [1] / 72.27 + 0.5),
353	];
354}
355
356sub pageSize
357{
358	return @{$_[0]-> {pageSize}} unless $#_;
359	my ( $self, $px, $py) = @_;
360	return if $self-> get_paint_state;
361	$px = 1 if $px < 1;
362	$py = 1 if $py < 1;
363	$self-> {pageSize} = [$px, $py];
364	$self-> calc_page;
365}
366
367sub pageMargins
368{
369	return @{$_[0]-> {pageMargins}} unless $#_;
370	my ( $self, $px, $py, $px2, $py2) = @_;
371	return if $self-> get_paint_state;
372	$px = 0 if $px < 0;
373	$py = 0 if $py < 0;
374	$px2 = 0 if $px2 < 0;
375	$py2 = 0 if $py2 < 0;
376	$self-> {pageMargins} = [$px, $py, $px2, $py2];
377	$self-> calc_page;
378}
379
380sub size
381{
382	return @{$_[0]-> {size}} unless $#_;
383	$_[0]-> raise_ro("size");
384}
385
386sub flood_fill           { 0 }
387sub get_bpp              { return $_[0]-> {grayscale} ? 8 : 24 }
388sub get_nearest_color    { return $_[1] }
389sub get_physical_palette { return $_[0]-> {grayscale} ? [map { $_, $_, $_ } 0..255] : 0 }
390sub get_handle           { return 0 }
391sub bar_alpha            { 0 }
392sub can_draw_alpha       { 0 }
393
394sub fonts
395{
396	my ( $self, $family, $encoding) = @_;
397	$family   = undef if defined $family   && !length $family;
398	$encoding = undef if defined $encoding && !length $encoding;
399
400	my $enc = 'iso10646-1'; # unicode only
401	if ( !defined $family ) {
402		my @fonts;
403		my $num = $self->fontMapperPalette(-1);
404		if ( $num > 0 ) {
405			for my $fid ( 1 .. $num ) {
406				my $f = $self->fontMapperPalette($fid) or next;
407				$f->{encodings} = [$enc];
408				$f->{encoding} = $enc;
409				push @fonts, $f;
410			}
411		}
412		return \@fonts;
413	} else {
414		return [] if defined($encoding) && $encoding ne '' && $encoding ne $enc;
415
416		my @f = @{$::application->fonts($family) // []};
417		return [] unless @f;
418		$f[0]->{encoding} = $enc;
419		return [$f[0]];
420	}
421}
422
423sub glyph_canvas
424{
425	my $self = shift;
426	return $self->{glyph_canvas} //= Prima::DeviceBitmap->create(
427		width           => 1,
428		height          => 1,
429		textOutBaseline => 1,
430	);
431}
432
433sub glyph_canvas_set_font
434{
435	my ($self, %font) = @_;
436
437	my $g = $self-> glyph_canvas;
438	$font{style} &= ~(fs::Underlined|fs::StruckOut);
439	delete @font{qw(height width direction)};
440	$font{size} = 1000;
441	$g-> font(\%font);
442}
443
444sub get_font {+{%{$_[0]-> {font}}}}
445
446sub set_font
447{
448	my ( $self, $font) = @_;
449
450	my $canvas = $self-> glyph_canvas;
451	my ($curr_font, $new_font) = ('', '');
452	$curr_font = ($self->{font}->{size} // '-1'). '.' . ($self->{glyph_font} // '');
453
454	$font = { %$font };
455	my $wscale     = $font-> {width};
456	delete $font-> {width};
457
458	my $div        = 72.27 / $self-> {resolution}-> [1];
459	my $by_height  = defined($font->{height});
460	$font = Prima::Drawable-> font_match( $font, $self-> {font});
461	delete $font->{$by_height ? 'size' : 'height'};
462	$canvas->set_font( $font );
463	$font = $self-> {font} = { %{ $canvas->get_font } };
464
465	# convert Prima size definition to PS size definition
466	#
467	# PS doesn't account for internal leading, and thus there are two possibilities:
468	# 1) enforce Prima model, but that results in $font->size(100) printed
469	# will not exactly be 100 points by mm.
470	#
471	# 2) hack font structure on the fly, so that caller setting $font->size(100)
472	# will get $font->height slightly less (by internal leading) in pixels.
473	#
474	# Here #2 is implemented
475	if ( $by_height ) {
476		$font->{size} = int($font->{height} * $div + .5);
477	} else {
478		my $new_h        = $font->{size} / $div;
479		my $ratio        = $font->{height} / $new_h;
480		$font->{height}  = int( $new_h + .5);
481		$font->{ascent}  = int( $font->{ascent} / $ratio + .5 );
482		$font->{descent} = $font->{height} - $font->{ascent};
483	}
484
485	# we emulate wider fonts by PS scaling, but this factor is needed
486	# when reporting horizontal glyph and text extension
487	my $font_width_divisor  = $font->{width};
488	$font-> {width} = $wscale if $wscale;
489	$self-> {font_x_scale}  = $font->{width} / $font_width_divisor;
490
491	$self-> glyph_canvas_set_font(%$font);
492	my $f1000 = $self->glyph_canvas->font;
493	$self-> apply_canvas_font( $f1000 );
494
495	# When querying glyph extensions, remember to scale to the
496	# difference between PS and Prima models.
497	my $y_scale = 1.0 + $f1000->internalLeading / $f1000->height;
498	# Also, note that querying is on the canvas that has size=1000.
499	$self->{font_scale} = $font->{height} / $f1000->height * $y_scale;
500
501	$new_font = $font->{size} . '.' . $self->{glyph_font};
502	$self-> {changed}->{font} = 1 if $curr_font ne $new_font;
503}
504
505sub get_font_abc
506{
507	my ( $self, $first, $last, $flags) = @_;
508	$first = 0     if !defined ($first) || $first < 0;
509	$last = $first if !defined ($last) || $last < $first;
510	my $canvas = $self-> glyph_canvas;
511	my $scale  = $self->{font_scale} * $self->{font_x_scale};
512	return [ map { $_ * $scale } @{ $canvas->get_font_abc($first, $last, $flags // 0) } ];
513}
514
515sub get_font_def
516{
517	my ( $self, $first, $last, $flags) = @_;
518	$first = 0     if !defined ($first) || $first < 0;
519	$last = $first if !defined ($last) || $last < $first;
520	my $canvas = $self-> glyph_canvas;
521	my $scale  = $self->{font_scale};
522	return [ map { $_ * $scale } @{ $canvas->get_font_def($first, $last, $flags // 0) } ];
523}
524
525sub get_font_ranges    { shift->glyph_canvas->get_font_ranges    }
526sub get_font_languages { shift->glyph_canvas->get_font_languages }
527
528sub get_text_width
529{
530	my ( $self, $text, $flags, $from, $len) = @_;
531	$flags //= 0;
532	$from  //= 0;
533	my $glyphs;
534	if ( ref($text) eq 'Prima::Drawable::Glyphs') {
535		$glyphs = $text->glyphs;
536		$len    = @$glyphs if !defined($len) || $len < 0 || $len > @$glyphs;
537	} elsif (ref($text)) {
538		$len //= -1;
539		return $text->get_text_width($self, $flags, $from, $len);
540	} else {
541		$len = length($text) if !defined($len) || $len < 0 || $len > length($text);
542	}
543	return 0 unless $len;
544
545	my $w = $self->glyph_canvas-> get_text_width( $text, $flags, $from, $len);
546	$w *= $self->{font_scale} unless $glyphs && $text->advances;
547	return int( $w * $self-> {font_x_scale} + .5);
548}
549
550sub _rotate
551{
552	my ( $angle, $arr ) = @_;
553	my $s = sin( $angle / 57.29577951);
554	my $c = cos( $angle / 57.29577951);
555	my $i;
556	for ( $i = 0; $i < 10; $i+=2) {
557		my ( $x, $y) = @$arr[$i,$i+1];
558		$$arr[$i]   = $x * $c - $y * $s;
559		$$arr[$i+1] = $x * $s + $y * $c;
560	}
561}
562
563sub get_text_box
564{
565	my ( $self, $text, $from, $len) = @_;
566
567	$from //= 0;
568	my $glyphs;
569	if ( ref($text) eq 'Prima::Drawable::Glyphs') {
570		$glyphs = $text->glyphs;
571		$len    = @$glyphs if !defined($len) || $len < 0 || $len > @$glyphs;
572	} elsif (ref($text)) {
573		$len //= -1;
574		return $text->get_text_box($self, $from, $len);
575	} else {
576		$len  = length($text) if !defined($len) || $len < 0 || $len > length($text);
577	}
578	return [ (0) x 10 ] unless $len;
579
580	my $wmul = $self->{font_x_scale};
581	my $dir  = $self->{font}->{direction};
582	my @ret;
583
584	@ret = @{ $self-> glyph_canvas-> get_text_box( $text, $from, $len) };
585	my $div = $self->{font_scale};
586	if ($glyphs && $text->advances) {
587		$_ *= $div for @ret[1,3,5,7,9];
588	} else {
589		$_ *= $div for @ret;
590	}
591
592	if ( $wmul != 0.0 && $wmul != 1.0 ) {
593		_rotate(-$dir, \@ret) if $dir != 0;
594		$ret[$_] *= $wmul for 0,2,4,6,8;
595		_rotate($dir, \@ret) if $dir != 0;
596	}
597
598	return \@ret;
599}
600
601sub text_wrap
602{
603	my ( $self, $text, $width, @rest ) = @_;
604	my $res;
605	my $gc = $self->glyph_canvas;
606	my $x  = $self->{font_scale};
607	if ( $rest[-1] && ((ref($rest[-1]) // '') eq 'Prima::Drawable::Glyphs') && $rest[-1]->advances ) {
608		my $s = $rest[-1];
609		my @save  = ($s->advances, $s->positions);
610		my @clone = map { Prima::array::clone($_) } @save;
611		for my $v ( @clone ) {
612			$_ /= $x for @$v;
613		}
614		$s->[ Prima::Drawable::Glyphs::ADVANCES()  ] = $clone[0];
615		$s->[ Prima::Drawable::Glyphs::POSITIONS() ] = $clone[1];
616		$res = $gc->text_wrap($text, $width / $x, @rest);
617		$s->[ Prima::Drawable::Glyphs::ADVANCES()  ] = $save[0];
618		$s->[ Prima::Drawable::Glyphs::POSITIONS() ] = $save[1];
619	} else {
620		$res = $gc->text_wrap($text, $width / $x, @rest);
621	}
622	return $res;
623}
624
625sub text_shape
626{
627	my ( $self, $text, %opt ) = @_;
628
629	my $canvas = $self-> glyph_canvas;
630	my $shaped = $canvas->text_shape($text, %opt);
631	return $shaped unless $shaped;
632	$shaped->[Prima::Drawable::Glyphs::CUSTOM()] = $text;
633	if ( $shaped-> advances ) {
634		my $scale  = $self->{font_scale};
635		$_ *= $scale for @{ $shaped->advances  };
636		$_ *= $scale for @{ $shaped->positions };
637	}
638	return $shaped;
639}
640
641sub render_glyph {}
642
643package
644	Prima::PS::Drawable::Path;
645use base qw(Prima::Drawable::Path);
646
647sub entries
648{
649	my $self = shift;
650	unless ( $self->{entries} ) {
651		local $self->{stack} = [];
652		local $self->{curr}  = { matrix => [ $self-> identity ] };
653		my $c = $self->{commands};
654		$self-> {entries} = [];
655		for ( my $i = 0; $i < @$c; ) {
656			my ($cmd,$len) = @$c[$i,$i+1];
657			$self-> can("_$cmd")-> ( $self, @$c[$i+2..$i+$len+1] );
658			$i += $len + 2;
659		}
660		$self->{last_matrix} = $self->{curr}->{matrix};
661	}
662	return $self-> {entries};
663}
664
665sub emit { push @{shift->{entries}}, join(' ', @_) }
666
667sub last_point { @{$_[0]->{last_point} // [0,0]} }
668
669sub _open
670{
671	my $self = shift;
672	$self-> {move_is_line} = 0;
673	$self->emit('')
674}
675
676sub _close     { $_[0]->emit( $_[0]-> dict-> {closepath} ) }
677
678sub  _moveto
679{
680	my ( $self, $mx, $my, $rel) = @_;
681	($mx, $my) = $self-> canvas-> pixel2point( $mx, $my );
682	($mx, $my) = $self->matrix_apply($mx, $my);
683	my ($lx, $ly) = $rel ? $self->last_point : (0,0);
684	$lx += $mx;
685	$ly += $my;
686	@{$self-> {last_point}} = ($lx, $ly);
687	$self-> emit($lx, $ly, $self->dict->{moveto} );
688}
689
690sub _line
691{
692	my ( $self, $line ) = @_;
693	my @line = $self-> canvas-> pixel2point( @$line );
694	@line = @{ $self-> matrix_apply( \@line ) };
695	$self-> set_current_point( shift @line, shift @line );
696	@{$self-> {last_point}} = @line[-2,-1];
697	my $cmd = $self->dict->{lineto};
698	for ( my $i = 0; $i < @line; $i += 2 ) {
699		$self->emit(@line[$i,$i+1], $cmd);
700	}
701}
702
703sub _spline
704{
705	my ( $self, $points, $options ) = @_;
706	my @p = $self-> canvas-> pixel2point( @$points );
707	@p = @{ $self-> matrix_apply( \@p ) };
708
709	$options->{degree} //= 2;
710	return if $options->{degree} > 3;
711	my @p0 = @p[0,1];
712	$self-> set_current_point( @p0 );
713	my $cmd = $self->dict->{curveto};
714	if ( $options->{degree} == 2 ) {
715		for ( my $i = 2; $i < @p; $i += 4 ) {
716			my @pp = $self->canvas->conic2curve( @p0, @p[$i .. $i + 3] );
717			$self->emit(@pp, $cmd);
718			@p0 = @pp[-2,-1];
719		}
720	} else {
721		for ( my $i = 2; $i < @p; $i += 4 ) {
722			my @pp = @p[$i .. $i + 5];
723			$self->emit(@pp, $cmd);
724		}
725	}
726}
727
728sub _arc
729{
730	my ( $self, $from, $to, $rel ) = @_;
731	my $cubics = $self->canvas->arc2cubics(
732		0, 0, 2, 2,
733		$from, $to);
734
735	if ( $rel ) {
736		my ($lx,$ly) = $self->last_point;
737		my $pts = $cubics->[0];
738		my $m = $self->{curr}->{matrix};
739		my @s = $self->matrix_apply( $pts->[0], $pts->[1]);
740		$m->[4] += $lx - $s[0];
741		$m->[5] += $ly - $s[1];
742	}
743	my @p = map { $self-> matrix_apply( $_ ) } @$cubics;
744	$_ = [$self-> canvas-> pixel2point(@$_)] for @p;
745	$self-> set_current_point( @{$p[0]}[0,1] );
746	my $cmd = $self->dict->{curveto};
747	$self-> emit( @{$_}[2..7], $cmd) for @p;
748}
749
750sub stroke
751{
752	my $self = shift;
753	$self-> canvas-> stroke( join("\n", @{ $self->entries }, $self->dict->{stroke} ));
754}
755
756sub fill
757{
758	my ( $self, $fillMode ) = @_;
759	$fillMode //= $self->canvas->fillMode;
760	$fillMode = ((($fillMode & fm::Winding) == fm::Alternate) ? 'alt' : 'wind');
761	$self-> canvas-> fill( join("\n", @{ $self->entries }, $self-> dict->{"fill_$fillMode"} ));
762}
763
764package
765	Prima::PS::Drawable::Region;
766
767sub new
768{
769	my ($class, $entries) = @_;
770	bless {
771		path   => $entries,
772		offset => [0,0],
773	}, $class;
774}
775
776sub get_handle { "$_[0]" }
777sub get_boxes    { [] }
778sub point_inside { 0 }
779sub rect_inside  { 0 }
780sub box          { 0,0,0,0 }
781
782sub offset
783{
784	my ( $self, $dx, $dy ) = @_;
785	$self->{offset}->[0] += $dx;
786	$self->{offset}->[1] += $dy;
787}
788
789sub apply_offset
790{
791	my $self = shift;
792	my $path = $self->{path};
793	my @offset = @{ $self->{offset} };
794	return $path if 0 == grep { $_ != 0 } @offset;
795
796	my $n = '';
797	my $ix = 0;
798	while ( 1 ) {
799		$path =~ m/\G(\d+(?:\.\d+)?)/gcs and do {
800			$n .= $1 + $offset[$ix];
801			$ix = $ix ? 0 : 1;
802			redo;
803		};
804		$path =~ m/\G(\s+)/gcs and do {
805			$n .= $1;
806			redo;
807		};
808		$path =~ m/\G(\D+)/gcs and do {
809			$n .= $1;
810			$ix = 0;
811			redo;
812		};
813		$path =~ m/\G$/gcs and last;
814	}
815	$path = $n;
816}
817
8181;
819
820__END__
821
822=pod
823
824=head1 NAME
825
826Prima::PS::Drawable - Common routines for PS drawables
827
828=cut
829