1use strict;
2use warnings;
3use Prima;
4use Config;
5use Prima::Utils;
6use Prima::TextView;
7use Encode;
8
9package Prima::PodView::Link;
10use vars qw(@ISA);
11@ISA = qw( Prima::TextView::EventRectangles Prima::TextView::EventContent );
12
13sub on_mousedown
14{
15	my ( $self, $owner, $btn, $mod, $x, $y) = @_;
16	my $r = $self-> contains( $x, $y);
17	return 1 if $r < 0;
18	$r = $self-> {rectangles}-> [$r];
19	$r = $self-> {references}-> [$$r[4]];
20	$owner-> link_click( $r, $btn, $mod, $x, $y);
21	return 0;
22}
23
24sub on_mousemove
25{
26	my ( $self, $owner, $mod, $x, $y) = @_;
27	my $r = $self-> contains( $x, $y);
28	if ( $r != $owner-> {lastLinkPointer}) {
29		my $was_hand = ($owner->{lastLinkPointer} >= 0) ? 1 : 0;
30		my $is_hand  = ($r >= 0) ? 1 : 0;
31		if ( $is_hand != $was_hand) {
32			$owner-> pointer( $is_hand ? cr::Hand : cr::Text );
33		}
34		my $rr = $self->rectangles;
35		my ($dx, $dy) = $owner->point2screen(0,0);
36		my $or = $owner->{lastLinkPointer};
37		$owner-> {lastLinkPointer} = $r;
38		if ( $was_hand ) {
39			$or = $rr->[$or];
40			$owner-> invalidate_rect($or->[0] + $dx, $dy - $or->[1], $or->[2] + $dx, $dy - $or->[3]);
41		}
42		if ( $is_hand ) {
43			$or = $rr->[$r];
44			$owner-> invalidate_rect($or->[0] + $dx, $dy - $or->[1], $or->[2] + $dx, $dy - $or->[3]);
45		}
46	}
47}
48
49sub on_paint
50{
51	my ( $self, $owner, $canvas, $ci ) = @_;
52	my ($dx, $dy) = $owner->point2screen(0,0);
53	my $r  = $self->rectangles->[ $owner->{lastLinkPointer} ];
54	my $c  = $canvas-> color;
55	$canvas-> color( $owner-> {colorMap}->[ $ci ]);
56	$canvas-> translate(0,0);
57	$canvas-> line( $r->[0] + $dx, $dy - $r->[3], $r->[2] + $dx, $dy - $r->[3]);
58	$canvas-> color( $c);
59}
60
61package Prima::PodView;
62
63use vars qw(@ISA %HTML_Escapes $OP_LINK);
64@ISA = qw(Prima::TextView);
65
66use constant DEF_INDENT       => 4;
67use constant DEF_FIRST_INDENT => 1;
68
69use constant COLOR_LINK_FOREGROUND => 2 | tb::COLOR_INDEX;
70use constant COLOR_LINK_BACKGROUND => 3 | tb::COLOR_INDEX;
71use constant COLOR_CODE_FOREGROUND => 4 | tb::COLOR_INDEX;
72use constant COLOR_CODE_BACKGROUND => 5 | tb::COLOR_INDEX;
73
74use constant STYLE_CODE   => 0;
75use constant STYLE_TEXT   => 1;
76use constant STYLE_HEAD_1 => 2;
77use constant STYLE_HEAD_2 => 3;
78use constant STYLE_HEAD_3 => 4;
79use constant STYLE_HEAD_4 => 5;
80use constant STYLE_ITEM   => 6;
81use constant STYLE_LINK   => 7;
82use constant STYLE_VERBATIM => 8;
83use constant STYLE_MAX_ID => 8;
84
85# model layout indices
86use constant M_TYPE        => 0; # T_XXXX
87                                 # T_NORMAL
88use constant M_TEXT_OFFSET => 1; # contains same info as BLK_TEXT_OFFSET
89use constant M_INDENT      => 2; # pod-content driven indent
90use constant M_FONT_ID     => 3; # 0 or 1 ( i.e., variable or fixed )
91use constant M_START       => 4; # start of data, same purpose as BLK_START
92                                 # T_DIV
93use constant MDIV_TAG      => 2;
94use constant MDIV_STYLE    => 3;
95
96# model entries
97use constant T_NORMAL          => 0;
98use constant T_DIV             => 1;
99use constant TDIVTAG_OPEN      => 0;
100use constant TDIVTAG_CLOSE     => 1;
101use constant TDIVSTYLE_SOLID   => 0;
102use constant TDIVSTYLE_OUTLINE => 1;
103
104# topic layout indices
105use constant T_MODEL_START => 0; # beginning of topic
106use constant T_MODEL_END   => 1; # end of a topic
107use constant T_DESCRIPTION => 2; # topic name
108use constant T_STYLE       => 3; # style of STYLE_XXX
109use constant T_ITEM_DEPTH  => 4; # depth of =item recursion
110use constant T_LINK_OFFSET => 5; #
111
112# formatting constants
113use constant FORMAT_LINES    => 100;
114use constant FORMAT_TIMEOUT  => 300;
115
116$OP_LINK = tb::opcode(1, 'link');
117
118sub model_create
119{
120	my %opt = @_;
121	return (
122		$opt{type}   // T_NORMAL,
123		$opt{offset} // 0,
124		$opt{indent} // 0,
125		$opt{font}   // 0
126	);
127}
128
129sub div_create
130{
131	my %opt = @_;
132	return (
133		T_DIV,
134		$opt{offset} // 0,
135		$opt{open}  ? TDIVTAG_OPEN : TDIVTAG_CLOSE,
136		$opt{style} // TDIVSTYLE_SOLID,
137	);
138}
139
140{
141my %RNT = (
142	%{Prima::TextView-> notification_types()},
143	Link     => nt::Default,
144	Bookmark => nt::Default,
145	NewPage  => nt::Default,
146);
147
148sub notification_types { return \%RNT; }
149}
150
151sub profile_default
152{
153	my $def = $_[ 0]-> SUPER::profile_default;
154	my %prf = (
155		colorMap => [
156			$def-> {color},
157			$def-> {backColor},
158			0x337ab7,               # link foreground
159			$def-> {backColor},     # link background
160			cl::Blue,               # code foreground
161			0xf5f5f5,               # code background
162		],
163		images => [],
164		styles => [
165			{ fontId    => 1,                         # STYLE_CODE
166			color     => COLOR_CODE_FOREGROUND,
167			backColor => COLOR_CODE_BACKGROUND
168			},
169			{ },                                      # STYLE_TEXT
170			{ fontSize => 4, fontStyle => fs::Bold }, # STYLE_HEAD_1
171			{ fontSize => 2, fontStyle => fs::Bold }, # STYLE_HEAD_2
172			{ fontSize => 1, fontStyle => fs::Bold }, # STYLE_HEAD_3
173			{ fontSize => 1, fontStyle => fs::Bold }, # STYLE_HEAD_4
174			{ fontStyle => fs::Bold },                # STYLE_ITEM
175			{ color     => COLOR_LINK_FOREGROUND},    # STYLE_LINK
176			{ fontId    => 1,                         # STYLE_VERBATIM
177			color     => COLOR_CODE_FOREGROUND,
178			},
179		],
180		pageName      => '',
181		topicView     => 0,
182		textDirection  => $::application->textDirection,
183	);
184	@$def{keys %prf} = values %prf;
185	return $def;
186}
187
188
189sub init
190{
191	my $self = shift;
192	$self-> {model} = [];
193	$self-> {links} = [];
194	$self-> {styles} = [];
195	$self-> {pageName} = '';
196	$self-> {manpath}  = '';
197	$self-> {modelRange} = [0,0,0];
198	$self-> {postBlocks} = {};
199	$self-> {topics}     = [];
200	$self-> {hasIndex}   = 0;
201	$self-> {topicView}  = 0;
202	$self-> {lastLinkPointer} = -1;
203	my %profile = $self-> SUPER::init(@_);
204
205	$self-> {contents} = [ Prima::PodView::Link-> new ];
206
207	my %font = %{$self-> fontPalette-> [0]};
208	$font{pitch} = fp::Fixed;
209	$self-> {fontPalette}-> [1] = \%font;
210	$self-> {fontPaletteSize} = 2;
211
212	$self-> $_($profile{$_}) for qw( styles images pageName topicView);
213
214	return %profile;
215}
216
217sub on_paint
218{
219	my ( $self, $canvas ) = @_;
220	$self-> SUPER::on_paint($canvas);
221	$self-> {contents}-> [0]-> on_paint( $self, $canvas, COLOR_LINK_FOREGROUND & ~tb::COLOR_INDEX )
222		if $self->{lastLinkPointer} >= 0
223}
224
225sub on_size
226{
227	my ( $self, $oldx, $oldy, $x, $y) = @_;
228	$self-> SUPER::on_size( $oldx, $oldy, $x, $y);
229	$self-> format(1) if $oldx != $x;
230}
231
232sub on_fontchanged
233{
234	my $self = $_[0];
235	$self-> SUPER::on_fontchanged;
236	$self-> format(1);
237}
238
239# sub on_link {
240# 	my ( $self, $linkPointer, $mouseButtonOrKeyEventIfZero, $mod, $x, $y) = @_;
241# }
242
243# returns a storable string, that identifies position.
244# can report current positions and links to the upper topic
245sub make_bookmark
246{
247	my ( $self, $where) = @_;
248
249	return undef unless length $self-> {pageName};
250	if ( !defined $where) { # current position
251		my ( $ofs, $bid) = $self-> xy2info( $self-> {offset}, $self-> {topLine});
252		my $topic = $self-> {modelRange}-> [0];
253		$ofs = $self-> {blocks}-> [$bid]-> [tb::BLK_TEXT_OFFSET] + $ofs;
254		return "$self->{pageName}|$topic|$ofs\n";
255	} elsif ( $where =~ /up|next|prev/ ) { # up
256		if ( $self-> {topicView} ) {
257			my $topic = $self-> {modelRange}-> [0];
258			return undef if $where =~ /up|prev/ && $topic == 0; # contents
259			my $tid = -1;
260			my $t;
261			for ( @{$self-> {topics}}) {
262				$tid++;
263				next unless $$_[T_MODEL_START] == $topic;
264				$t = $_;
265				last;
266			}
267
268			if ( $where =~ /next|prev/) {
269				return undef unless defined $t;
270				my $index = scalar @{$self-> {topics}} - 1;
271				$tid += ( $where =~ /next/) ? 1 : -1;
272				return undef if $tid < 0 || $tid > $index;
273				$t = $self-> {topics}-> [$tid]-> [T_MODEL_START];
274				return "$self->{pageName}|$t|0";
275			}
276
277			return "$self->{pageName}|0|0" unless defined $t;
278			if ( $$t[ T_STYLE] >= STYLE_HEAD_1 && $$t[ T_STYLE] <= STYLE_HEAD_4) {
279				$t = $self-> {topics}-> [0];
280				return "$self->{pageName}|$$t[T_MODEL_START]|0"
281			}
282			my $state = $$t[ T_STYLE] - STYLE_HEAD_1 + $$t[ T_ITEM_DEPTH];
283			$state-- if $state > 0;
284			while ( $tid--) {
285				$t = $self-> {topics}-> [$tid];
286				$t = $$t[ T_STYLE] - STYLE_HEAD_1 + $$t[ T_ITEM_DEPTH];
287				$t-- if $t > 0;
288				next if $t >= $state;
289				$t = $self-> {topics}-> [$tid]-> [T_MODEL_START];
290				return "$self->{pageName}|$t|0";
291			}
292			# return index
293			$t = $self-> {topics}-> [-1]-> [T_MODEL_START];
294			return "$self->{pageName}|$t|0";
295		}
296	}
297	return undef;
298}
299
300sub load_bookmark
301{
302	my ( $self, $mark) = @_;
303
304	return 0 unless defined $mark;
305
306	my ( $page, $topic, $ofs) = split( '\|', $mark, 3);
307	return 0 unless $ofs =~ /^\d+$/ && $topic =~ /^\d+$/;
308
309
310	if ( $page ne $self-> {pageName}) {
311		my $ret = $self-> load_file( $page);
312		return 2 if $ret != 1;
313	}
314
315	if ( $self-> {topicView}) {
316		for my $k ( @{$self-> {topics}}) {
317			next if $$k[T_MODEL_START] != $topic;
318			$self-> select_topic($k);
319			last;
320		}
321	}
322	$self-> select_text_offset( $ofs);
323
324	return 1;
325}
326
327sub load_link
328{
329	my ( $self, $s) = @_;
330
331	my $mark = $self-> make_bookmark;
332	my $t;
333	if ( $s =~ /^topic:\/\/(.*)$/) { # local topic
334		$t = $1;
335		return 0 unless $t =~ /^\d+$/;
336		return 0 if $t < 0 || $t >= scalar @{$self-> {topics}};
337	}
338
339	my $doBookmark;
340
341	unless ( defined $t) { # page / section / item
342		my ( $page, $section, $item, $lead_slash) = ( '', '', 1, '');
343		my $default_topic = 0;
344
345		if ( $s =~ /^file:\/\/(.*)$/) {
346			$page = $1;
347		} elsif ( $s =~ m{^([:\w]+)/?$} ) {
348			$page = $1;
349		} elsif ( $s =~ /^([^\/]*)(\/)(.*)$/) {
350			( $page, $lead_slash, $section) = ( $1, $2, $3);
351		} else {
352			$section = $s;
353		}
354		$item = 0 if $section =~ s/^\"(.*?)\"$/$1/;
355
356		if ( !length $page) {
357			my $tid = -1;
358			for ( @{$self-> {topics}}) {
359				$tid++;
360				next unless $section eq $$_[T_DESCRIPTION];
361				next if !$item && $$_[T_STYLE] == STYLE_ITEM;
362				$t = $tid;
363				last;
364			}
365			if ( !defined $t || $t < 0) {
366				$tid = -1;
367				my $s = quotemeta $section;
368				for ( @{$self-> {topics}}) {
369					$tid++;
370					next unless $$_[T_DESCRIPTION] =~ m/^$s/;
371					next if !$item && $$_[T_STYLE] == STYLE_ITEM;
372					$t = $tid;
373					last;
374				}
375			}
376			unless ( defined $t) { # no such topic, must be a page?
377				$page = $lead_slash . $section;
378				$section = '';
379			}
380		}
381		if ( length $page and $page ne $self-> {pageName}) { # new page?
382			if ( $self-> load_file( $page) != 1) {
383				$self-> notify(q(Bookmark), $mark) if $mark;
384				return 0;
385			}
386			$doBookmark = 1;
387		}
388
389		if ( ! defined $t) {
390			$t = $default_topic if length $page && $self-> {topicView};
391			my $tid = -1;
392			for ( @{$self-> {topics}}) {
393				$tid++;
394				next unless $section eq $$_[T_DESCRIPTION];
395				$t = $tid;
396				last;
397			}
398			if ( length( $section) and ( !defined $t || $t < 0)) {
399				$tid = -1;
400				my $s = quotemeta $section;
401				for ( @{$self-> {topics}}) {
402					$tid++;
403					next unless $$_[T_DESCRIPTION] =~ m/^$s/;
404					$t = $tid;
405					last;
406				}
407			}
408		}
409	}
410
411	if ( defined $t) {
412		if ( $t = $self-> {topics}-> [$t]) {
413			if ( $self-> {topicView}) {
414				$self-> select_topic($t);
415			} else {
416				$self-> select_text_offset(
417					$self-> {model}-> [ $$t[ T_MODEL_START]]-> [ M_TEXT_OFFSET]
418				);
419			}
420			$self-> notify(q(Bookmark), $mark) if $mark;
421			return 1;
422		}
423	} elsif ( $doBookmark) {
424		$self-> notify(q(Bookmark), $mark) if $mark;
425		return 1;
426	}
427
428	return 0;
429}
430
431sub link_click
432{
433	my ( $self, $s, $btn, $mod, $x, $y) = @_;
434
435	return unless $self-> notify(q(Link), \$s, $btn, $mod, $x, $y);
436	return if $btn != mb::Left;
437	$self-> load_link( $s);
438}
439
440# selects a sub-page; does not check if topicView,
441# so must be called with care
442sub select_topic
443{
444	my ( $self, $t) = @_;
445	my @mr1 = @{$self-> {modelRange}};
446	if ( defined $t) {
447		$self-> {modelRange} = [
448			$$t[ T_MODEL_START],
449			$$t[ T_MODEL_END],
450			$$t[ T_LINK_OFFSET]
451		]
452	} else {
453		$self-> {modelRange} = [ 0, scalar @{$self-> {model}} - 1, 0 ]
454	}
455	my @mr2 = @{$self-> {modelRange}};
456
457	if ( grep { $mr1[$_] != $mr2[$_] } 0 .. 2) {
458		$self-> lock;
459		$self-> topLine(0);
460		$self-> offset(0);
461		$self-> selection(-1,-1,-1,-1);
462		$self-> format;
463		$self-> unlock;
464		$self-> notify(q(NewPage));
465	}
466}
467
468
469sub topicView
470{
471	return $_[0]-> {topicView} unless $#_;
472	my ( $self, $tv) = @_;
473	$tv = ( $tv ? 1 : 0);
474	return if $self-> {topicView} == $tv;
475	$self-> {topicView} = $tv;
476	return unless length $self-> {pageName};
477	$self-> load_file( $self-> {pageName});
478}
479
480
481sub pageName
482{
483	return $_[0]-> {pageName} unless $#_;
484	$_[0]-> {pageName} = $_[1];
485}
486
487sub textDirection
488{
489	return $_[0]-> {textDirection} unless $#_;
490	my ( $self, $td ) = @_;
491	$self-> {textDirection} = $td;
492}
493
494sub styles
495{
496	return $_[0]-> {styles} unless $#_;
497	my ( $self, @styles) = @_;
498	@styles = @{$styles[0]} if ( scalar(@styles) == 1) && ( ref($styles[0]) eq 'ARRAY');
499	if ( $#styles < STYLE_MAX_ID) {
500		my @as = @{$_[0]-> {styles}};
501		my @pd = @{$_[0]-> profile_default-> {styles}};
502		while ( $#styles < STYLE_MAX_ID) {
503			if ( $as[ $#styles]) {
504				$styles[ $#styles + 1] = $as[ $#styles + 1];
505			} else {
506				$styles[ $#styles + 1] = $pd[ $#styles + 1];
507			}
508		}
509	}
510	$self-> {styles} = \@styles;
511	$self-> update_styles;
512
513}
514
515sub images
516{
517	return $_[0]-> {images} unless $#_;
518	my ( $self, $images) = @_;
519	$self-> {images} = $images;
520	$self-> repaint;
521}
522
523sub update_styles # used for the direct {styles} hacking
524{
525	my $self = $_[0];
526	my @styleInfo;
527	for ( @{$self-> {styles}}) {
528		my $x = $_;
529		my ( @forw, @rev);
530		for ( qw( fontId fontSize fontStyle color backColor)) {
531			next unless exists $x-> {$_};
532			push @forw, $tb::{$_}-> ( $x-> {$_});
533			push @rev,  $tb::{$_}-> ( 0);
534		}
535		push @styleInfo, \@forw, \@rev;
536	}
537	$self-> {styleInfo} = \@styleInfo;
538}
539
540sub message
541{
542	my ( $self, $message, $error) = @_;
543	my $x;
544	$self-> open_read( createIndex => 0 );
545	if ( $error) {
546		$x = $self-> {styles}-> [STYLE_HEAD_1]-> {color};
547		$self-> {styles}-> [STYLE_HEAD_1]-> {color} = cl::Red;
548		$self-> update_styles;
549	}
550	$self-> read($message);
551	$self-> close_read( 0);
552	if ( $error) {
553		my $z = $self-> {styles}-> [STYLE_HEAD_1];
554		defined $x ? $z-> {color} = $x : delete $z-> {color};
555		$self-> update_styles;
556	}
557	$self-> pageName('');
558	$self-> {manpath} = '';
559}
560
561sub load_file
562{
563	my ( $self, $manpage) = @_;
564	my $pageName = $manpage;
565	my $path = '';
566
567	unless ( -f $manpage) {
568		my ( $fn, $mpath);
569		my @ext =  ( '.pod', '.pm', '.pl' );
570		push @ext, ( '.bat' ) if $^O =~ /win32/i;
571		push @ext, ( '.com' ) if $^O =~ /VMS/;
572		for ( map { $_, "$_/pod", "$_/pods" }
573				grep { defined && length && -d }
574					@INC,
575					split( $Config::Config{path_sep}, $ENV{PATH})) {
576			if ( -f "$_/$manpage") {
577				$manpage = "$_/$manpage";
578				$path = $_;
579				last;
580			}
581			$fn = "$_/$manpage";
582			$fn =~ s/::/\//g;
583			$mpath = $fn;
584			$mpath =~ s/\/[^\/]*$//;
585			for ( @ext ) {
586				if ( -f "$fn$_") {
587					$manpage = "$fn$_";
588					$path = $mpath;
589					goto FOUND;
590				}
591			}
592		}
593	}
594FOUND:
595
596	unless ( open F, "< $manpage") {
597		my $m = <<ERROR;
598\=head1 Error
599
600Error loading '$manpage' : $!
601
602ERROR
603		$m =~ s/^\\=/=/gm;
604		undef $self-> {source_file};
605		$self-> message( $m, 1);
606		return 0;
607	}
608
609	$self-> pointer( cr::Wait);
610	$self-> {manpath} = $path;
611	$self-> {source_file} = $manpage;
612	$self-> open_read;
613	$self-> read($_) while <F>;
614	close F;
615
616	$self-> pageName( $pageName);
617	my $ret = $self-> close_read( $self-> {topicView});
618
619	$self-> pointer( cr::Default);
620
621	unless ( $ret) {
622		$_ = <<ERROR;
623\=head1 Warning
624
625The file '$manpage' does not contain any POD context
626
627ERROR
628		s/^\\=/=/gm;
629		$self-> message($_);
630		return 2;
631	}
632	return 1;
633}
634
635sub load_content
636{
637	my ( $self, $content) = @_;
638	my $path = '';
639	$self-> {manpath} = '';
640	undef $self-> {source_file};
641	$self-> open_read;
642	$self-> read($content);
643	return $self-> close_read( $self-> {topicView});
644}
645
646
647sub open_read
648{
649	my ($self, @opt) = @_;
650	return if $self-> {readState};
651	$self-> clear_all;
652	$self-> {readState} = {
653		cutting       => 1,
654		pod_cutting   => 1,
655		begun         => '',
656		bulletMode    => 0,
657
658		indent        => DEF_INDENT,
659		indentStack   => [],
660
661		bigofs        => 0,
662		wrapstate     => '',
663		wrapindent    => 0,
664
665		topicStack    => [[-1]],
666		ignoreFormat  => 0,
667
668		createIndex   => 1,
669		encoding      => undef,
670		bom           => undef,
671		utf8          => undef,
672		verbatim      => undef,
673
674		@opt,
675	};
676}
677
678sub load_image
679{
680	my ( $self, $src, $frame ) = @_;
681	return Prima::Icon-> load( $src, index => $frame, iconUnmask => 1)
682		if -f $src;
683
684	$src =~ s!::!/!g;
685	for my $path (
686		map {( "$_", "$_/pod")}
687		grep { defined && length && -d }
688		( length($self-> {manpath}) ? $self-> {manpath} : (), @INC)
689	) {
690		return Prima::Icon-> load( "$path/$src", index => $frame, iconUnmask => 1)
691			if -f "$path/$src" && -r _;
692	}
693	return;
694}
695
696sub add_image
697{
698	my ( $self, $src, %opt ) = @_;
699
700	my $w = $opt{width} // $src-> width;
701	my $h = $opt{height} // $src-> height;
702	my @resolution = $self-> resolution;
703	$w *= 72 / $resolution[0];
704	$h *= 72 / $resolution[1];
705	$src-> {stretch} = [$w, $h];
706	$self-> {readState}-> {pod_cutting} = $opt{cut} ? 0 : 1
707		if defined $opt{cut};
708
709	my @imgop = (
710		tb::moveto( 2, 0, tb::X_DIMENSION_FONT_HEIGHT),
711		tb::wrap(tb::WRAP_MODE_OFF),
712		tb::extend( $w, $h, tb::X_DIMENSION_POINT),
713		tb::code( \&_imgpaint, $src),
714		tb::moveto( $w, 0, tb::X_DIMENSION_POINT),
715		tb::wrap(tb::WRAP_MODE_ON)
716	);
717
718	push @{$self-> {model}},
719		$opt{title} ? [div_create(open => 1, style => TDIVSTYLE_OUTLINE)] : (),
720		[model_create(
721			indent => $self-> {readState}-> {indent},
722			offset => $self-> {readState}-> {bigofs}
723		),
724		@imgop],
725		;
726	if ( $opt{title}) {
727		my $r = $self-> {readState};
728
729		my @g = model_create(
730			indent => $self-> {readState}-> {indent},
731			offset => $r-> {bigofs}
732		);
733		push @g,
734			tb::moveto( 2, 0, tb::X_DIMENSION_FONT_HEIGHT),
735			tb::fontStyle(fs::Italic),
736			tb::text(0, length $opt{title}),
737			tb::fontStyle(fs::Normal),
738			;
739		$opt{title} .= "\n";
740		${$self->{text}} .= $opt{title};
741		$r->{bigofs} += length $opt{title};
742
743		push @{$self-> {model}},
744			[model_create, tb::moveto(0, 1, tb::X_DIMENSION_FONT_HEIGHT)],
745			\@g,
746			[model_create, tb::moveto(0, 1, tb::X_DIMENSION_FONT_HEIGHT)],
747			[div_create(open => 0, style => TDIVSTYLE_OUTLINE) ]
748			;
749	}
750	push @{$self-> {model}}, [model_create, tb::moveto(0, 1, tb::X_DIMENSION_FONT_HEIGHT)];
751}
752
753sub add_formatted
754{
755	my ( $self, $format, $text) = @_;
756
757	return unless $self-> {readState};
758
759	if ( $format eq 'text') {
760		$self-> add($text,STYLE_CODE,0);
761		$self-> add_new_line;
762	} elsif ( $format eq 'podview') {
763		while ( $text =~ m/<\s*([^<>]*)\s*>/gcs) {
764			my $cmd = $1;
765			if ( lc($cmd) eq 'cut') {
766				$self-> {readState}-> {pod_cutting} = 0;
767			} elsif ( lc($cmd) eq '/cut') {
768				$self-> {readState}-> {pod_cutting} = 1;
769			} elsif ( $cmd =~ /^img\s*(.*)$/i) {
770				$cmd = $1;
771				my %opt;
772				while ( $cmd =~ m/\s*([a-z]*)\s*\=\s*(?:(?:'([^']*)')|(?:"([^"]*)")|(\S*))\s*/igcs) {
773					my ( $option, $value) = ( lc $1, defined($2)?$2:(defined $3?$3:$4));
774					if ( $option =~ /^(width|height|frame)$/ && $value =~ /^\d+$/) { $opt{$option} = $value }
775					elsif ( $option =~ /^(src|cut|title)$/) { $opt{$option} = $value }
776				}
777				if ( defined $opt{src}) {
778					my $img = $self->load_image($opt{src}, $opt{frame} // 0);
779					$self->add_image($img, %opt) if $img;
780				} elsif ( defined $opt{frame} && defined $self->{images}->[$opt{frame}]) {
781					$self->add_image($self->{images}->[$opt{frame}], %opt);
782				}
783			}
784		}
785	}
786}
787
788sub _imgpaint
789{
790	my ( $self, $canvas, $block, $state, $x, $y, $img) = @_;
791	my ( $dx, $dy) = @{$img->{stretch}};
792	my @res = $self-> resolution;
793	$dx *= $res[0] / 72;
794	$dy *= $res[1] / 72;
795	$canvas-> stretch_image( $x, $y, $dx, $dy, $img);
796	if ( $self-> {selectionPaintMode}) {
797		my @save = ( fillPattern => $canvas-> fillPattern, rop => $canvas-> rop, fillPatternOffset => [$canvas->fillPatternOffset]);
798		$canvas-> set( fillPattern => fp::Borland, rop => rop::AndPut, fillPatternOffset => [$x, $y]);
799		$canvas-> bar( $x, $y, $x + $dx - 1, $y + $dy - 1);
800		$canvas-> set( @save);
801	}
802}
803
804sub _bulletpaint
805{
806	my ( $self, $canvas, $block, $state, $x, $y, $filled) = @_;
807	$y -= $$block[ tb::BLK_APERTURE_Y];
808	my $fh = $canvas-> font-> height * 0.3;
809	$filled ?
810		$canvas-> fill_ellipse( $x + $fh / 2, $y + $$block[ tb::BLK_HEIGHT] / 2, $fh, $fh) :
811		$canvas-> ellipse     ( $x + $fh / 2, $y + $$block[ tb::BLK_HEIGHT] / 2, $fh, $fh);
812}
813
814sub read_paragraph
815{
816	my ( $self, $line ) = @_;
817	my $r = $self-> {readState};
818
819	for ( $line ) {
820		if ($r-> {cutting}) {
821			next unless /^=/;
822			$r-> {cutting} = 0;
823		}
824
825		unless ($r-> {pod_cutting}) {
826			next unless /^=/;
827		}
828
829		if ($r-> {begun}) {
830			my $begun = $r-> {begun};
831			if (/^=end\s+$begun/ || /^=cut/) {
832				$r-> {begun} = '';
833				$self-> add_new_line; # end paragraph
834				$r-> {cutting} = 1 if /^=cut/;
835			} else {
836				$self-> add_formatted( $r-> {begun}, $_);
837			}
838			next;
839		}
840
841		1 while s{^(.*?)(\t+)(.*)$}{
842			$1
843			. (' ' x (length($2) * 8 - length($1) % 8))
844			. $3
845		}me;
846
847		# Translate verbatim paragraph
848		if (/^\s/) {
849			$self-> add_verbatim_mark(1) unless defined $r->{verbatim};
850			$self-> add($_,STYLE_VERBATIM,$r-> {indent}) for split "\n", $_;
851			$self-> add_new_line;
852			next;
853		}
854		$self-> add_verbatim_mark(0);
855
856		if (/^=for\s+(\S+)\s*(.*)/s) {
857			$self-> add_formatted( $1, $2) if defined $2;
858			next;
859		} elsif (/^=begin\s+(\S+)\s*(.*)/s) {
860			$r-> {begun} = $1;
861			$self-> add_formatted( $1, $2) if defined $2;
862			next;
863		}
864
865		if (s/^=//) {
866			my ($Cmd, $args) = split(' ', $_, 2);
867			$args = '' unless defined $args;
868			if ($Cmd eq 'cut') {
869				$r-> {cutting} = 1;
870			}
871			elsif ($Cmd eq 'pod') {
872				$r-> {cutting} = 0;
873			}
874			elsif ($Cmd eq 'head1') {
875				$self-> add( $args, STYLE_HEAD_1, DEF_FIRST_INDENT);
876			}
877			elsif ($Cmd eq 'head2') {
878				$self-> add( $args, STYLE_HEAD_2, DEF_FIRST_INDENT);
879			}
880			elsif ($Cmd eq 'head3') {
881				$self-> add( $args, STYLE_HEAD_3, DEF_FIRST_INDENT);
882			}
883			elsif ($Cmd eq 'head4') {
884				$self-> add( $args, STYLE_HEAD_4, DEF_FIRST_INDENT);
885			}
886			elsif ($Cmd eq 'over') {
887				push(@{$r-> {indentStack}}, $r-> {indent});
888				$r-> {indent} += ( $args =~ m/^(\d+)$/ ) ? $1 : DEF_INDENT;
889			}
890			elsif ($Cmd eq 'back') {
891				$self-> _close_topic( STYLE_ITEM);
892				$r-> {indent} = pop(@{$r-> {indentStack}}) || 0;
893			}
894			elsif ($Cmd eq 'item') {
895				$self-> add( $args, STYLE_ITEM, $r-> {indentStack}-> [-1] || DEF_INDENT);
896			}
897			elsif ($Cmd eq 'encoding') {
898				$r->{encoding} = Encode::find_encoding($args); # or undef
899			}
900		}
901		else {
902			s/\n/ /g;
903			$self-> add($_, STYLE_TEXT, $r-> {indent});
904		}
905
906		$self-> add_new_line unless $r->{bulletMode};
907	}
908}
909
910sub read
911{
912	my ( $self, $pod) = @_;
913	my $r = $self-> {readState};
914	return unless $r;
915
916	unless ( defined $r->{bom} ) {
917		if ( $pod =~ s/^(\x{ef}\x{bb}\x{bf})// ) { # don't care about other BOMs so far
918			$r-> {bom} = $1;
919			$r-> {encoding} = Encode::find_encoding('utf-8');
920		}
921	}
922
923	my $odd = 0;
924	for ( split ( "(\n)", $pod)) {
925		next unless $odd = !$odd;
926		$_ = $r->{encoding}->decode($_, Encode::FB_HTMLCREF) if $r->{encoding};
927
928		if (defined $r-> {paragraph_buffer}) {
929			if ( /^\s*$/) {
930				my $pb = $r-> {paragraph_buffer};
931				undef $r-> {paragraph_buffer};
932				$self-> read_paragraph($pb);
933			} else {
934				$r-> {paragraph_buffer} .= "\n$_";
935				next;
936			}
937		} elsif ( !/^$/) {
938		    $r->{paragraph_buffer} = $_;
939		    next;
940		}
941	}
942}
943
944sub close_read
945{
946	my ( $self, $topicView) = @_;
947	return unless $self-> {readState};
948
949	my $r = $self-> {readState};
950	if ( defined $r->{paragraph_buffer}) {
951		my $pb = $r-> {paragraph_buffer};
952		undef $r-> {paragraph_buffer};
953		$self-> read_paragraph("$pb\n");
954	}
955
956	$topicView = $self-> {topicView} unless defined $topicView;
957	$self-> add_new_line; # end
958	$self-> add_verbatim_mark(0);
959	$self-> {contents}-> [0]-> references( $self-> {links});
960
961	goto NO_INDEX unless $self-> {readState}-> {createIndex};
962
963	my $secid = 0;
964	my $msecid = scalar(@{$self-> {topics}});
965
966	unless ( $msecid) {
967		push @{$self-> {topics}}, [
968			0, scalar @{$self-> {model}} - 1,
969			"Document", STYLE_HEAD_1, 0, 0
970		] if scalar @{$self-> {model}} > 2; # no =head's, but some info
971		goto NO_INDEX;
972	}
973
974	## this code creates the Index section, adds it to the end of text,
975	## and then uses black magic to put it in the front.
976
977	# remember the current end state
978	$self-> _close_topic( STYLE_HEAD_1);
979	my @text_ends_at = (
980		$r-> {bigofs},
981		scalar @{$self->{model}},
982		scalar @{$self->{topics}},
983		scalar @{$self->{links}},
984	);
985
986	# generate index list
987	my $ofs = $self-> {model}-> [$self-> {topics}-> [0]-> [T_MODEL_START]]-> [M_TEXT_OFFSET];
988	my $firstText = substr( ${$self-> {text}}, 0, ( $ofs > 0) ? $ofs : 0);
989	if ( $firstText =~ /[^\n\s\t]/) { # the 1st lines of text are not =head
990		unshift @{$self-> {topics}}, [
991			0, $self-> {topics}-> [0]-> [T_MODEL_START] - 1,
992			"Preface", STYLE_HEAD_1, 0, 0
993		];
994		$text_ends_at[2]++;
995		$msecid++;
996	}
997	my $start = scalar @{ $self->{model} };
998	$self-> add_new_line;
999	$self-> add_verbatim_mark(1);
1000	$self-> add( " Contents",  STYLE_HEAD_1, DEF_FIRST_INDENT);
1001	$self-> {hasIndex} = 1;
1002	$self-> {topics}->[-1]->[T_MODEL_START] = $start;
1003	my $last_style = STYLE_HEAD_1;
1004	for my $k ( @{$self-> {topics}}) {
1005		last if $secid == $msecid; # do not add 'Index' entry
1006		my ( $ofs, $end, $text, $style, $depth, $linkStart) = @$k;
1007		if ( $style == STYLE_ITEM ) {
1008			$style = $last_style;
1009		} else {
1010			$last_style = $style;
1011		}
1012		my $indent = DEF_INDENT + ( $style - STYLE_HEAD_1 + $depth ) * 2;
1013		$self-> add("L<$text|topic://$secid>", STYLE_TEXT, $indent);
1014		$secid++;
1015	}
1016	$self-> add_new_line;
1017	$self-> add_verbatim_mark(0);
1018
1019	$self-> _close_topic( STYLE_HEAD_1);
1020
1021	# remember the state after index is added
1022	my @index_ends_at = (
1023		$r-> {bigofs},
1024		scalar @{$self->{model}},
1025		scalar @{$self->{topics}},
1026		scalar @{$self->{links}},
1027	);
1028
1029	# exchange places for index and body
1030	my @offsets = map { $index_ends_at[$_] - $text_ends_at[$_] } 0 .. 3;
1031	my $m = $self-> {model};
1032	# first shift the offsets
1033	$$_[M_TEXT_OFFSET] += $offsets[0]      for @$m[0..$text_ends_at[1]-1];
1034	$$_[M_TEXT_OFFSET] -= $text_ends_at[0] for @$m[$text_ends_at[1]..$index_ends_at[1]-1];
1035	# next reshuffle the model
1036	unshift @$m, splice( @$m, $text_ends_at[1]);
1037	# text
1038	my $t = $self-> {text};
1039	my $ts = substr( $$t, $text_ends_at[0]);
1040	substr( $$t, $text_ends_at[0]) = '';
1041	substr( $$t, 0, 0) = $ts;
1042	# topics
1043	$t = $self-> {topics};
1044	for ( @$t[0..$text_ends_at[2]-1]) {
1045		$$_[T_MODEL_START] += $offsets[1];
1046		$$_[T_MODEL_END]   += $offsets[1];
1047		$$_[T_LINK_OFFSET] += $offsets[3];
1048	}
1049	for ( @$t[$text_ends_at[2]..$index_ends_at[2]-1]) {
1050		$$_[T_MODEL_START] -= $text_ends_at[1];
1051		$$_[T_MODEL_END]   -= $text_ends_at[1];
1052		$$_[T_LINK_OFFSET] -= $text_ends_at[3];
1053	}
1054	unshift @$t, splice( @$t, $text_ends_at[2]);
1055	# update the map of blocks that contain OP_LINKs
1056	$self-> {postBlocks} = {
1057		map {
1058			( $_ >= $text_ends_at[1]) ?
1059			( $_ - $text_ends_at[1] ) :
1060			( $_ + $offsets[1] ),
1061			1
1062		} keys %{$self-> {postBlocks}}
1063	};
1064	# links
1065	my $l = $self-> {links};
1066	s/^(topic:\/\/)(\d+)$/$1 . ( $2 + $offsets[2])/e for @$l;
1067	unshift @{$self->{links}}, splice( @{$self->{links}}, $text_ends_at[3]);
1068
1069NO_INDEX:
1070	# finalize
1071	undef $self-> {readState};
1072	$self-> {lastLinkPointer} = -1;
1073
1074	my $topic;
1075	$topic = $self-> {topics}-> [$msecid] if $topicView;
1076	$self-> select_topic( $topic);
1077
1078	$self-> notify(q(NewPage));
1079
1080	return scalar @{$self-> {model}} > 1; # if non-empty
1081}
1082
1083# internal sub, called when a new topic is emerged.
1084# responsible to what topics can include others ( =headX to =item)
1085sub _close_topic
1086{
1087	my ( $self, $style, $topicToPush) = @_;
1088
1089	my $r = $self-> {readState};
1090	my $t = $r-> { topicStack};
1091	my $state = ( $style >= STYLE_HEAD_1 && $style <= STYLE_HEAD_4) ?
1092		0 : scalar @{$r-> {indentStack}};
1093
1094	if ( $state <= $$t[-1]-> [0]) {
1095		while ( scalar @$t && $state <= $$t[-1]-> [0]) {
1096			my $nt = pop @$t;
1097			$nt = $$nt[1];
1098			$$nt[ T_MODEL_END] = scalar @{$self-> {model}} - 1;
1099		}
1100		push @$t, [ $state, $topicToPush ] if $topicToPush;
1101	} else {
1102		# assert defined $topicToPush
1103		push @$t, [ $state, $topicToPush ];
1104	}
1105}
1106
1107sub noremap {
1108	my $a = $_[0];
1109	$a =~ tr/\000-\177/\200-\377/;
1110	return $a;
1111}
1112
1113sub add
1114{
1115	my ( $self, $p, $style, $indent) = @_;
1116
1117	my $cstyle;
1118	my $r = $self-> {readState};
1119	return unless $r;
1120
1121	$p =~ s/\n//g;
1122	my $g = [ model_create( indent => $indent, offset => $r-> {bigofs}) ];
1123	my $styles = $self-> {styles};
1124	my $no_push_block;
1125	my $itemid = scalar @{$self-> {model}};
1126
1127	if ( $r-> {bulletMode}) {
1128		if ( $style == STYLE_TEXT || $style == STYLE_CODE || $style == STYLE_VERBATIM) {
1129			return unless length $p;
1130			$g = $self-> {model}-> [-1];
1131			$$g[M_TEXT_OFFSET] = $r-> {bigofs};
1132			$no_push_block = 1;
1133			$itemid--;
1134		}
1135		$r-> {bulletMode} = 0;
1136	}
1137
1138	if ( $style == STYLE_CODE || $style == STYLE_VERBATIM) {
1139		$$g[ M_FONT_ID] = $styles-> [$style]-> {fontId} || 1; # fixed font
1140		push @$g, tb::wrap(tb::WRAP_MODE_OFF);
1141	}
1142
1143	push @$g, @{$self-> {styleInfo}-> [$style * 2]};
1144	$cstyle = $styles-> [$style]-> {fontStyle} || 0;
1145
1146	if ( $style == STYLE_CODE || $style == STYLE_VERBATIM) {
1147		push @$g, tb::text( 0, length $p),
1148	} elsif (( $style == STYLE_ITEM) && ( $p =~ /^\*\s*$/ || $p =~ /^\d+\.?$/)) {
1149		push @$g,
1150			tb::wrap(tb::WRAP_MODE_OFF),
1151			tb::color(0),
1152			tb::code( \&_bulletpaint, ($p =~ /^\*\s*$/) ? 1 : 0),
1153			tb::moveto( 1, 0, tb::X_DIMENSION_FONT_HEIGHT),
1154			tb::wrap(tb::WRAP_MODE_ON);
1155		$r-> {bulletMode} = 1;
1156		$p = '';
1157	} else { # wrapable text
1158		$p =~ s/[\s\t]+/ /g;
1159		$p =~ s/([\200-\377])/"E<".ord($1).">"/ge;
1160		$p =~ s/(E<[^<>]+>)/noremap($1)/ge;
1161		$p =~ s/([:A-Za-z_][:A-Za-z_0-9]*\([^\)]*\))/C<$1>/g;
1162		my $maxnest = 10;
1163		my $linkStart = scalar @{$self-> {links}};
1164		my $m = $p;
1165		my @ids = ( [-2, 'Z', 2], [ length($m), 'z', 1]);
1166		while ( $maxnest--) {
1167			while ( $m =~ m/([A-Z])(<<+) /gcs) {
1168				my ( $pos, $cmd, $left, $right) = ( pos($m), $1, $2, ('>' x ( length($2))));
1169				if ( $m =~ m/\G.*? $right(?!>)/gcs) {
1170					if ( $cmd eq 'X') {
1171						my $d = length($cmd) + length($left) + 1;
1172						substr( $m, $pos - $d, pos($m) - $pos + $d, '');
1173					} else {
1174						push @ids, [
1175							$pos - length($left) - 2,
1176							$cmd,
1177							length($cmd)+length($left)
1178						], [
1179							pos($m) - length($right),
1180							lc $cmd,
1181							length($right)
1182						];
1183						substr $m, $ids[$_][0], $ids[$_][2], '_' x $ids[$_][2]
1184							for -2,-1;
1185					}
1186				}
1187			}
1188			while ( $m =~ m/([A-Z])<([^<>]*)>/gcs) {
1189				if ( $1 eq 'X') {
1190					my $d = length($2) + length($1) + 2;
1191					substr( $m, pos($m) - $d, $d, '');
1192				} else {
1193					push @ids,
1194						[ pos($m) - length($2) - 3, $1, 2],
1195						[ pos($m) - 1, lc $1, 1];
1196					substr $m, $ids[$_][0], $ids[$_][2], '_' x $ids[$_][2] for -2,-1;
1197				}
1198			}
1199			last unless $m =~ m/[A-Z]</;
1200		}
1201
1202		my %stack = map {[]} qw( fontStyle fontId fontSize wrap color backColor);
1203		my %val = (
1204			fontStyle => $cstyle,
1205			fontId    => 0,
1206			fontSize  => 0,
1207			wrap      => 1,
1208			color     => tb::COLOR_INDEX,
1209			backColor => tb::BACKCOLOR_DEFAULT,
1210		);
1211		my ( $link, $linkHREF) = ( 0, '');
1212
1213		my $pofs = 0;
1214		$p = '';
1215		for ( sort { $$a[0] <=> $$b[0] } @ids) {
1216			my $ofs = $$_[0] + $$_[2];
1217			if ( $pofs < $$_[0]) {
1218				my $s = substr( $m, $pofs, $$_[0] - $pofs);
1219				$s =~ tr/\200-\377/\000-\177/;
1220				$s =~ s{
1221						E<
1222						(
1223							( \d+ )
1224							| ( [A-Za-z]+ )
1225						)
1226						>
1227				} {
1228					do {
1229							defined $2
1230							? chr($2)
1231							:
1232						defined $HTML_Escapes{$3}
1233							? do { $HTML_Escapes{$3} }
1234							: do { "E<$1>"; }
1235					}
1236				}egx;
1237
1238				if ( $link) {
1239					my $l;
1240					if ( $s =~ m/^([^\|]*)\|(.*)$/) {
1241						$l = $2;
1242						$s = $1;
1243						$linkHREF = '';
1244					} else {
1245						$l = $s;
1246					}
1247					unless ( $s =~ /^\w+\:\/\//) {
1248						my ( $page, $section) = ( '', '');
1249						if ( $s =~ /^([^\/]*)\/(.*)$/) {
1250							( $page, $section) = ( $1, $2);
1251						} else {
1252							$section = $s;
1253						}
1254						$section =~ s/^\"(.*?)\"$/$1/;
1255						$s = length( $page) ? "$page: $section" : $section;
1256					}
1257					$linkHREF .= $l;
1258				}
1259
1260				push @$g, tb::text( length $p, length $s);
1261				$p .= $s;
1262			}
1263			$pofs = $ofs;
1264
1265			if ( $$_[1] ne lc $$_[1]) { # open
1266				if ( $$_[1] eq 'I' || $$_[1] eq 'F') {
1267					push @{$stack{fontStyle}}, $val{fontStyle};
1268					push @$g, tb::fontStyle( $val{fontStyle} |= fs::Italic);
1269				} elsif ( $$_[1] eq 'C') {
1270					push @{$stack{wrap}}, $val{wrap};
1271					push @$g, tb::wrap( $val{wrap} = tb::WRAP_MODE_OFF);
1272					my $z = $styles-> [STYLE_CODE];
1273					for ( qw( fontId fontStyle fontSize color backColor)) {
1274						next unless exists $z-> {$_};
1275						push @{$stack{$_}}, $val{$_};
1276						push @$g, $tb::{$_}-> ( $val{$_} = $z-> {$_});
1277					}
1278				} elsif ( $$_[1] eq 'L') {
1279					my $z = $styles-> [STYLE_LINK];
1280					for ( qw( fontId fontStyle fontSize color backColor)) {
1281						next unless exists $z-> {$_};
1282						push @{$stack{$_}}, $val{$_};
1283						push @$g, $tb::{$_}-> ( $val{$_} = $z-> {$_});
1284					}
1285					unless ($link) {
1286						push @$g, $OP_LINK, $link = 1;
1287						$linkHREF = '';
1288					}
1289				} elsif ( $$_[1] eq 'S') {
1290					push @{$stack{wrap}}, $val{wrap};
1291					push @$g, tb::wrap( $val{wrap} = tb::WRAP_MODE_OFF);
1292				} elsif ( $$_[1] eq 'B') {
1293					push @{$stack{fontStyle}}, $val{fontStyle};
1294					push @$g, tb::fontStyle( $val{fontStyle} |= fs::Bold);
1295				}
1296			} else { # close
1297				if ( $$_[1] eq 'i' || $$_[1] eq 'f' || $$_[1] eq 'b') {
1298					push @$g, tb::fontStyle( $val{fontStyle} = pop @{$stack{fontStyle}});
1299				} elsif ( $$_[1] eq 'c') {
1300					my $z = $styles-> [STYLE_CODE];
1301					push @$g, tb::wrap( $val{wrap} = pop @{$stack{wrap}});
1302					for ( qw( fontId fontStyle fontSize color backColor)) {
1303						next unless exists $z-> {$_};
1304						push @$g, $tb::{$_}-> ( $val{$_} = pop @{$stack{$_}});
1305					}
1306				} elsif ( $$_[1] eq 'l') {
1307					my $z = $styles-> [STYLE_LINK];
1308					for ( qw( fontId fontStyle fontSize color backColor)) {
1309						next unless exists $z-> {$_};
1310						push @$g, $tb::{$_}-> ( $val{$_} = pop @{$stack{$_}});
1311					}
1312					if ( $link) {
1313						push @$g, $OP_LINK, $link = 0;
1314						push @{$self-> {links}}, $linkHREF;
1315						$self-> {postBlocks}-> { $itemid} = 1;
1316					}
1317				} elsif ( $$_[1] eq 's') {
1318					push @$g, tb::wrap( $val{wrap} = pop @{$stack{wrap}});
1319				}
1320			}
1321		}
1322		if ( $link) {
1323			push @$g, $OP_LINK, $link = 0;
1324			push @{$self-> {links}}, $linkHREF;
1325			$self-> {postBlocks}-> { $itemid} = 1;
1326		}
1327
1328		# add topic
1329		if (
1330	        	( $style >= STYLE_HEAD_1 && $style <= STYLE_HEAD_4 ) ||
1331			(( $style == STYLE_ITEM) && $p !~ /^[0-9*]+\.?$/)
1332		) {
1333			my $itemDepth = ( $style == STYLE_ITEM) ?
1334				scalar @{$r-> {indentStack}} : 0;
1335			my $pp = $p;
1336			$pp =~ s/\|//g;
1337			$pp =~ s/([<>])/'E<' . (($1 eq '<') ? 'lt' : 'gt') . '>'/ge;
1338			if ( $style == STYLE_ITEM && $pp =~ /^\s*[a-z]/) {
1339				$pp =~ s/([\s\)\(\[\]\{\}].*)$/C<$1>/; # seems like function entry?
1340			}
1341			my $newTopic = [ $itemid, 0, $pp, $style, $itemDepth, $linkStart];
1342			$self-> _close_topic( $style, $newTopic);
1343			push @{$self-> {topics}}, $newTopic;
1344		}
1345	}
1346
1347
1348	# add text
1349	$p .= "\n";
1350	${$self-> {text}} .= $p;
1351
1352	# all-string format options - close brackets
1353	push @$g, @{$self-> {styleInfo}-> [$style * 2 + 1]};
1354
1355	# finish block
1356	$r-> {bigofs} += length $p;
1357	push @{$self-> {model}}, $g unless $no_push_block;
1358}
1359
1360sub add_new_line
1361{
1362	my $self = $_[0];
1363	my $r = $self-> {readState};
1364	return unless $r;
1365	my $p = " \n";
1366	${$self-> {text}} .= $p;
1367	push @{$self-> {model}}, [ model_create( offset => $r->{bigofs} ), tb::text(0, 1) ];
1368	$r-> {bigofs} += length $p;
1369}
1370
1371sub add_verbatim_mark
1372{
1373	my ($self, $on) = @_;
1374	my $r = $self-> {readState};
1375	return unless $r;
1376
1377	my $open;
1378	if ( $on ) {
1379		return if defined $r->{verbatim};
1380		$open = 1;
1381		$r->{verbatim} = 1;
1382	} else {
1383		return unless defined $r->{verbatim};
1384		$open = 0;
1385		undef $r->{verbatim};
1386	}
1387
1388	push @{$self-> {model}}, [ div_create(open => $open, style => TDIVSTYLE_SOLID) ];
1389}
1390
1391sub stop_format
1392{
1393	my $self = $_[0];
1394	$self-> {formatTimer}-> destroy if $self-> {formatTimer};
1395	undef $self-> {formatData};
1396	undef $self-> {formatTimer};
1397}
1398
1399sub format
1400{
1401	my ( $self, $keepOffset) = @_;
1402	my ( $pw, $ph) = $self-> get_active_area(2);
1403
1404	my $autoOffset;
1405	if ( $keepOffset) {
1406		if ( $self-> {formatData} && $self-> {formatData}-> {position}) {
1407			$autoOffset = $self-> {formatData}-> {position};
1408		} else {
1409			my ( $ofs, $bid) = $self-> xy2info( $self-> {offset}, $self-> {topLine});
1410			if ( $self-> {blocks}-> [$bid]) {
1411				$autoOffset = $ofs + $self-> {blocks}-> [$bid]-> [tb::BLK_TEXT_OFFSET];
1412			}
1413		}
1414	}
1415
1416	$self-> stop_format;
1417	$self-> selection(-1,-1,-1,-1);
1418
1419	my $paneWidth = $pw;
1420	my $paneHeight = 0;
1421	my ( $min, $max, $linkIdStart) = @{$self-> {modelRange}};
1422	if ( $min >= $max) {
1423		$self-> {blocks} = [];
1424		$self-> {contents}-> [0]-> rectangles([]);
1425		$self-> paneSize(0,0);
1426		return;
1427	}
1428
1429	$self-> {blocks} = [];
1430	$self-> {contents}-> [0]-> rectangles( []);
1431
1432	$self-> begin_paint_info;
1433
1434	# cache indents
1435	my @indents;
1436	my $state = $self-> create_state;
1437
1438	for my $fid ( 0 .. ( scalar @{$self-> fontPalette} - 1)) {
1439		$$state[ tb::BLK_FONT_ID] = $fid;
1440		$self-> realize_state( $self, $state, tb::REALIZE_FONTS);
1441		$indents[$fid] = $self-> font-> width;
1442	}
1443	$$state[ tb::BLK_FONT_ID] = 0;
1444
1445	$self-> end_paint_info;
1446
1447	$self-> {formatData} = {
1448		indents       => \@indents,
1449		state         => $state,
1450		orgState      => [ @$state ],
1451		linkId        => $linkIdStart,
1452		min           => $min,
1453		max           => $max,
1454		current       => $min,
1455		paneWidth     => $paneWidth,
1456		formatWidth   => $paneWidth,
1457		linkRects     => $self-> {contents}-> [0]-> rectangles,
1458		step          => FORMAT_LINES,
1459		position      => undef,
1460		positionSet   => 0,
1461		verbatim      => undef,
1462		last_ymap     => 0,
1463	};
1464
1465	$self-> {formatTimer} = $self-> insert( Timer =>
1466		name        => 'FormatTimer',
1467		delegations => [ 'Tick' ],
1468		timeout     => FORMAT_TIMEOUT,
1469	) unless $self-> {formatTimer};
1470
1471	$self-> paneSize(0,0);
1472	$self-> {formatTimer}-> start;
1473	$self-> select_text_offset( $autoOffset) if $autoOffset;
1474
1475	while ( 1) {
1476		$self-> format_chunks;
1477		last unless
1478			$self-> {formatData} &&
1479			$self-> {blocks}-> [-1] &&
1480			$self-> {blocks}-> [-1]-> [tb::BLK_Y] < $ph;
1481	}
1482}
1483
1484sub FormatTimer_Tick
1485{
1486	$_[0]-> format_chunks
1487}
1488
1489sub paint_code_div
1490{
1491	my ( $self, $canvas, $block, $state, $x, $y, $coord) = @_;
1492	my $f  = $canvas->font;
1493	my ($style, $w, $h) = @$coord;
1494	my @x = ( $canvas-> backColor, $canvas-> color );
1495	my $path = $canvas->new_path->round_rect($x, $y, $x + $w, $y + $h, 20);
1496	if ( $style == TDIVSTYLE_SOLID ) {
1497		$canvas->set(backColor => $self->{colorMap}->[5], color => 0xcccccc);
1498		$path->fill_stroke;
1499		$canvas-> set( backColor => $x[0], color => $x[1] );
1500	} else {
1501		$canvas->set(color => 0x808080);
1502		$path-> stroke;
1503		$canvas-> set( color => $x[1] );
1504	}
1505}
1506
1507sub add_code_div
1508{
1509	my ($self, $style, $from, $to) = @_;
1510
1511	my ($w,$y1,$y2) = (0,($self->{blocks}->[$from]->[tb::BLK_Y]) x 2);
1512	for my $b ( @{ $self->{blocks} } [$from .. $to] ) {
1513		$w = $$b[tb::BLK_X] + $$b[tb::BLK_WIDTH]  if $w < $$b[tb::BLK_X] + $$b[tb::BLK_WIDTH];
1514		$y1 = $$b[tb::BLK_Y] if $y1 > $$b[tb::BLK_Y];
1515		$y2 = $$b[tb::BLK_Y] + $$b[tb::BLK_HEIGHT] if $y2 < $$b[tb::BLK_Y] + $$b[tb::BLK_HEIGHT];
1516	}
1517	my ($fh, $fw) = ( $self->font->height, $self->font->width );
1518	my $h = $y2 - $y1;
1519	my $b = tb::block_create();
1520	$$b[tb::BLK_X] = $self->{blocks}->[$from]->[tb::BLK_X];
1521	$$b[tb::BLK_Y] = $y1 - $fh / 2;
1522	$w += 2 * $fw;
1523	$$b[tb::BLK_WIDTH]  = $w;
1524	$$b[tb::BLK_HEIGHT] = $h;
1525	$$b[tb::BLK_TEXT_OFFSET] = -1;
1526	push @$b,
1527		tb::code( \&paint_code_div, [$style, $w, $h]),
1528		tb::extend($w, $h);
1529	return $b;
1530}
1531
1532sub format_chunks
1533{
1534	my $self = $_[0];
1535
1536	my $f = $self-> {formatData};
1537
1538	my $time = time;
1539	$self-> begin_paint_info;
1540
1541	my $mid = $f-> {current};
1542	my $postBlocks = $self-> {postBlocks};
1543	my $max = $f-> {current} + $f-> {step};
1544	$max = $f-> {max} if $max > $f-> {max};
1545	my $indents   = $f-> {indents};
1546	my $state     = $f-> {state};
1547	my $linkRects = $f-> {linkRects};
1548	my $formatWidth = $f-> {formatWidth};
1549	my $fw = $self->font->width;
1550
1551	for ( ; $mid <= $max; $mid++) {
1552		my $g = tb::block_create();
1553		my $m = $self-> {model}-> [$mid];
1554
1555		if ( $m->[M_TYPE] == T_DIV ) {
1556			if ( $m->[MDIV_TAG] == TDIVTAG_OPEN) {
1557				$f->{verbatim} = scalar @{ $self->{blocks} };
1558			} else {
1559				splice @{ $self->{blocks} },
1560					$f->{verbatim}, 0,
1561					$self-> add_code_div( $m->[MDIV_STYLE], $f->{verbatim}, $#{$self->{blocks}} );
1562				undef $f->{verbatim};
1563			}
1564			next;
1565		}
1566
1567		my @blocks;
1568		$$g[ tb::BLK_TEXT_OFFSET] = $$m[M_TEXT_OFFSET];
1569		$$g[ tb::BLK_Y] = undef;
1570		push @$g, @$m[ M_START .. $#$m ];
1571
1572		# format the paragraph
1573
1574		my $next_text_offs = ( $mid == $#{$self->{model}} ) ? length( ${$self->{text}} ) : $self->{model}->[$mid + 1]->[M_TEXT_OFFSET];
1575		my $indent = $$m[M_INDENT] * $$indents[ $$m[M_FONT_ID]];
1576		@blocks = $self-> block_wrap( $self, $g, $state, $formatWidth - $indent);
1577
1578		# adjust size
1579		for ( @blocks) {
1580			if ( $self->{textDirection} ) {
1581				$$_[ tb::BLK_X] = $f->{paneWidth} - $$_[ tb::BLK_WIDTH] - $indent;
1582			} else {
1583				$$_[ tb::BLK_X] += $indent;
1584			}
1585			$f-> {paneWidth} = $$_[ tb::BLK_X] + $$_[ tb::BLK_WIDTH]
1586				if $$_[ tb::BLK_X] + $$_[ tb::BLK_WIDTH] > $f-> {paneWidth};
1587		}
1588
1589		# check links
1590		if ( $postBlocks-> {$mid}) {
1591			my $linkState = 0;
1592			my $linkStart = 0;
1593			my @rect;
1594			for my $b ( @blocks) {
1595				my @pos = ( $$b[tb::BLK_X], 0 );
1596
1597				if ( $linkState) {
1598					$rect[0] = $$b[ tb::BLK_X];
1599					$rect[1] = $$b[ tb::BLK_Y];
1600				}
1601
1602				$self-> block_walk( $b,
1603					position => \@pos,
1604					trace => tb::TRACE_POSITION,
1605					link  => sub {
1606						if ( $linkState = shift ) {
1607							$rect[0] = $pos[0];
1608							$rect[1] = $$b[ tb::BLK_Y];
1609						} else {
1610							$rect[2] = $pos[0] + $fw;
1611							$rect[3] = $$b[ tb::BLK_Y] + $$b[ tb::BLK_HEIGHT];
1612							push @$linkRects, [ @rect, $f-> {linkId} ++ ];
1613						}
1614					},
1615				);
1616
1617				if ( $linkState) {
1618					$rect[2] = $pos[0];
1619					$rect[3] = $$b[ tb::BLK_Y] + $$b[ tb::BLK_HEIGHT];
1620					push @$linkRects, [ @rect, $f-> {linkId}];
1621				}
1622			}
1623		}
1624
1625		# push back
1626		push @{$self-> {blocks}}, @blocks;
1627	}
1628
1629	my $paneHeight = 0;
1630	my @settopline;
1631	if ( scalar @{$self-> {blocks}}) {
1632		my $b = $self-> {blocks}-> [-1];
1633		$paneHeight = $$b[ tb::BLK_Y] + $$b[ tb::BLK_HEIGHT];
1634		if ( defined $f-> {position} &&
1635			! $f-> {positionSet} &&
1636			$self-> {topLine} == 0 &&
1637			$self-> {offset} == 0 &&
1638			$$b[ tb::BLK_TEXT_OFFSET] >= $f-> {position}) {
1639			$b = $self-> text_offset2block( $f-> {position});
1640			$f-> {positionSet} = 1;
1641			if ( defined $b) {
1642				$b = $self-> {blocks}-> [$b];
1643				@settopline = @$b[ tb::BLK_X, tb::BLK_Y];
1644			}
1645		}
1646	}
1647
1648	$f-> {current} = $mid;
1649	$self-> end_paint_info;
1650
1651	if ( ! defined $f->{verbatim} ){
1652		$self-> recalc_ymap( $f->{last_ymap} );
1653		$f->{last_ymap} = scalar @{ $self->{blocks} };
1654		if ( $f->{suppressed_ymap} ) {
1655			$f->{suppressed_ymap} = 0;
1656			$self->repaint;
1657		}
1658	} else {
1659		$f->{suppressed_ymap} = 1;
1660	}
1661
1662	my $ps = $self-> {paneWidth};
1663	if ( $ps != $f-> {paneWidth}) {
1664		$self-> paneSize( $f-> {paneWidth}, $paneHeight);
1665	} else {
1666		my $oph = $self-> {paneHeight};
1667		$self-> {paneHeight} = $paneHeight; # direct nasty hack
1668		$self-> reset_scrolls;
1669		$self-> repaint if $oph >= $self-> {topLine} &&
1670			$oph <= $self-> {topLine} + $self-> height;
1671	}
1672
1673	if ( @settopline) {
1674		$self-> topLine( $settopline[1]);
1675		$self-> offset( $settopline[0]);
1676	}
1677
1678	$self-> stop_format if $mid >= $f-> {max};
1679	$f-> {step} *= 2 unless time - $time;
1680}
1681
1682sub print
1683{
1684	my ( $self, $canvas, $callback) = @_;
1685
1686	my ( $min, $max, $linkIdStart) = @{$self-> {modelRange}};
1687	return 1 if $min >= $max;
1688	my $ret = 0;
1689
1690	goto ABORT if $callback && ! $callback-> ();
1691
1692	# cache indents
1693	my @indents;
1694	my $state = $self-> create_state;
1695	for ( 0 .. ( scalar @{$self-> fontPalette} - 1)) {
1696		$$state[ tb::BLK_FONT_ID] = $_;
1697		$self-> realize_state( $canvas, $state, tb::REALIZE_FONTS);
1698		$indents[$_] = $canvas-> font-> width;
1699	}
1700	$$state[ tb::BLK_FONT_ID] = 0;
1701
1702	my ( $formatWidth, $formatHeight) = $canvas-> size;
1703        my $hmargin = $formatWidth  / 24;
1704        my $vmargin = $formatHeight / 12;
1705        $formatWidth  -= $hmargin * 2;
1706        $formatHeight -= $vmargin * 2;
1707        $canvas->translate( $hmargin, $vmargin );
1708
1709	my $mid = $min;
1710	my $y = $formatHeight;
1711
1712	my $pageno = 1;
1713	my $pagenum  = sub {
1714		$canvas->translate( 0, 0 );
1715		my %save = %{$canvas->font};
1716		$canvas->font->set( name => $self->fontPalette->[0]->{name} || 'Default', size => 6, style => 0, pitch => fp::Default );
1717		$canvas->set( color => cl::Black );
1718		$canvas->text_out( $pageno, ( $formatWidth - $canvas->get_text_width($pageno) ) / 2, ($vmargin - $canvas->font->height ) / 2 );
1719		delete $save{height}; # XXX fix this
1720		$canvas->font(\%save);
1721		$pageno++;
1722	};
1723	my $new_page = sub {
1724		goto ABORT if $callback && ! $callback-> ();
1725		$pagenum->();
1726		goto ABORT unless $canvas-> new_page;
1727		$canvas->translate( $hmargin, $vmargin );
1728	};
1729
1730	for ( ; $mid <= $max; $mid++) {
1731		my $g = tb::block_create();
1732		my $m = $self-> {model}-> [$mid];
1733		next if $$m[M_TYPE] != T_NORMAL; # don't print div background
1734
1735		my @blocks;
1736		$$g[ tb::BLK_TEXT_OFFSET] = $$m[M_TEXT_OFFSET];
1737		$$g[ tb::BLK_Y] = undef;
1738		push @$g, @$m[ M_START .. $#$m ];
1739
1740		# format the paragraph
1741		my $indent = $$m[M_INDENT] * $indents[ $$m[M_FONT_ID]];
1742		@blocks = $self-> block_wrap( $canvas, $g, $state, $formatWidth - $indent);
1743
1744		# paint
1745		$self-> reset_state;
1746		for ( @blocks) {
1747			my $b = $_;
1748			if ( $y < $$b[ tb::BLK_HEIGHT]) {
1749				if ( $$b[ tb::BLK_HEIGHT] < $formatHeight) {
1750					$new_page->();
1751					$y = $formatHeight - $$b[ tb::BLK_HEIGHT];
1752					$self-> block_draw( $canvas, $b, $indent, $y);
1753				} else {
1754					$y -= $$b[ tb::BLK_HEIGHT];
1755					while ( $y < 0) {
1756						$new_page->();
1757						$self-> block_draw( $canvas, $b, $indent, $y);
1758						$y += $formatHeight;
1759					}
1760				}
1761			} else {
1762				$y -= $$b[ tb::BLK_HEIGHT];
1763				goto ABORT unless $self-> block_draw( $canvas, $b, $indent, $y);
1764			}
1765		}
1766	}
1767	$pagenum->();
1768
1769	$ret = 1;
1770ABORT:
1771	return $ret;
1772}
1773
1774sub select_text_offset
1775{
1776	my ( $self, $pos) = @_;
1777	if ( defined $self-> {formatData}) {
1778		my $last = $self-> {blocks}-> [-1];
1779		$self-> {formatData}-> {position} = $pos;
1780		return if ! $last || $$last[tb::BLK_TEXT_OFFSET] < $pos;
1781	}
1782	my $b = $self-> text_offset2block( $pos);
1783	if ( defined $b) {
1784		$b = $self-> {blocks}-> [$b];
1785		$self-> topLine( $$b[ tb::BLK_Y]);
1786		$self-> offset( $$b[ tb::BLK_X]);
1787	}
1788}
1789
1790sub clear_all
1791{
1792	my $self = $_[0];
1793	$self-> SUPER::clear_all;
1794	$self-> {modelRange} = [0,0,0];
1795	$self-> {model}      = [];
1796	$self-> {links}      = [];
1797	$self-> {postBlocks} = {};
1798	$self-> {topics}     = [];
1799	$self-> {topicIndex} = {};
1800	$self-> {hasIndex}   = 0;
1801}
1802
1803sub text_range
1804{
1805	my $self = $_[0];
1806	my @range;
1807	$range[0] = $self-> {model}-> [ $self-> {modelRange}-> [0]]-> [M_TEXT_OFFSET];
1808	$range[1] = ( $self-> {modelRange}-> [1] + 1 >= scalar @{$self-> {model}}) ?
1809		length ( ${$self-> {text}} ) :
1810		$self-> {model}-> [ $self-> {modelRange}-> [1] + 1]-> [M_TEXT_OFFSET];
1811	$range[1]-- if $range[1] > $range[0];
1812	return @range;
1813}
1814
1815%HTML_Escapes = (
1816	'amp'	=>	'&',	#   ampersand
1817	'lt'	=>	'<',	#   left chevron, less-than
1818	'gt'	=>	'>',	#   right chevron, greater-than
1819	'quot'	=>	'"',	#   double quote
1820
1821	"Aacute"=>	"\xC1",	#   capital A, acute accent
1822	"aacute"=>	"\xE1",	#   small a, acute accent
1823	"Acirc"	=>	"\xC2",	#   capital A, circumflex accent
1824	"acirc"	=>	"\xE2",	#   small a, circumflex accent
1825	"AElig"	=>	"\xC6",	#   capital AE diphthong (ligature)
1826	"aelig"	=>	"\xE6",	#   small ae diphthong (ligature)
1827	"Agrave"=>	"\xC0",	#   capital A, grave accent
1828	"agrave"=>	"\xE0",	#   small a, grave accent
1829	"Aring"	=>	"\xC5",	#   capital A, ring
1830	"aring"	=>	"\xE5",	#   small a, ring
1831	"Atilde"=>	"\xC3",	#   capital A, tilde
1832	"atilde"=>	"\xE3",	#   small a, tilde
1833	"Auml"	=>	"\xC4",	#   capital A, dieresis or umlaut mark
1834	"auml"	=>	"\xE4",	#   small a, dieresis or umlaut mark
1835	"Ccedil"=>	"\xC7",	#   capital C, cedilla
1836	"ccedil"=>	"\xE7",	#   small c, cedilla
1837	"Eacute"=>	"\xC9",	#   capital E, acute accent
1838	"eacute"=>	"\xE9",	#   small e, acute accent
1839	"Ecirc"	=>	"\xCA",	#   capital E, circumflex accent
1840	"ecirc"	=>	"\xEA",	#   small e, circumflex accent
1841	"Egrave"=>	"\xC8",	#   capital E, grave accent
1842	"egrave"=>	"\xE8",	#   small e, grave accent
1843	"ETH"	=>	"\xD0",	#   capital Eth, Icelandic
1844	"eth"	=>	"\xF0",	#   small eth, Icelandic
1845	"Euml"	=>	"\xCB",	#   capital E, dieresis or umlaut mark
1846	"euml"	=>	"\xEB",	#   small e, dieresis or umlaut mark
1847	"Iacute"=>	"\xCD",	#   capital I, acute accent
1848	"iacute"=>	"\xED",	#   small i, acute accent
1849	"Icirc"	=>	"\xCE",	#   capital I, circumflex accent
1850	"icirc"	=>	"\xEE",	#   small i, circumflex accent
1851	"Igrave"=>	"\xCD",	#   capital I, grave accent
1852	"igrave"=>	"\xED",	#   small i, grave accent
1853	"Iuml"	=>	"\xCF",	#   capital I, dieresis or umlaut mark
1854	"iuml"	=>	"\xEF",	#   small i, dieresis or umlaut mark
1855	"Ntilde"=>	"\xD1",	#   capital N, tilde
1856	"ntilde"=>	"\xF1",	#   small n, tilde
1857	"Oacute"=>	"\xD3",	#   capital O, acute accent
1858	"oacute"=>	"\xF3",	#   small o, acute accent
1859	"Ocirc"	=>	"\xD4",	#   capital O, circumflex accent
1860	"ocirc"	=>	"\xF4",	#   small o, circumflex accent
1861	"Ograve"=>	"\xD2",	#   capital O, grave accent
1862	"ograve"=>	"\xF2",	#   small o, grave accent
1863	"Oslash"=>	"\xD8",	#   capital O, slash
1864	"oslash"=>	"\xF8",	#   small o, slash
1865	"Otilde"=>	"\xD5",	#   capital O, tilde
1866	"otilde"=>	"\xF5",	#   small o, tilde
1867	"Ouml"	=>	"\xD6",	#   capital O, dieresis or umlaut mark
1868	"ouml"	=>	"\xF6",	#   small o, dieresis or umlaut mark
1869	"szlig"	=>	"\xDF",		#   small sharp s, German (sz ligature)
1870	"THORN"	=>	"\xDE",	#   capital THORN, Icelandic
1871	"thorn"	=>	"\xFE",	#   small thorn, Icelandic
1872	"Uacute"=>	"\xDA",	#   capital U, acute accent
1873	"uacute"=>	"\xFA",	#   small u, acute accent
1874	"Ucirc"	=>	"\xDB",	#   capital U, circumflex accent
1875	"ucirc"	=>	"\xFB",	#   small u, circumflex accent
1876	"Ugrave"=>	"\xD9",	#   capital U, grave accent
1877	"ugrave"=>	"\xF9",	#   small u, grave accent
1878	"Uuml"	=>	"\xDC",	#   capital U, dieresis or umlaut mark
1879	"uuml"	=>	"\xFC",	#   small u, dieresis or umlaut mark
1880	"Yacute"=>	"\xDD",	#   capital Y, acute accent
1881	"yacute"=>	"\xFD",	#   small y, acute accent
1882	"yuml"	=>	"\xFF",	#   small y, dieresis or umlaut mark
1883
1884	"lchevron"=>	"\xAB",	#   left chevron (double less than)
1885	"rchevron"=>	"\xBB",	#   right chevron (double greater than)
1886);
1887
18881;
1889
1890__END__
1891
1892=pod
1893
1894=head1 NAME
1895
1896Prima::PodView - POD browser widget
1897
1898=head1 SYNOPSIS
1899
1900	use Prima qw(Application PodView);
1901
1902	my $window = Prima::MainWindow-> create;
1903	my $podview = $window-> insert( 'Prima::PodView',
1904		pack => { fill => 'both', expand => 1 }
1905	);
1906	$podview-> open_read;
1907	$podview-> read("=head1 NAME\n\nI'm also a pod!\n\n");
1908	$podview-> close_read;
1909
1910	run Prima;
1911
1912=for podview <img src="podview.gif">
1913
1914=for html <p><img src="https://raw.githubusercontent.com/dk/Prima/master/pod/Prima/podview.gif">
1915
1916=head1 DESCRIPTION
1917
1918Prima::PodView contains a formatter ( in terms of L<perlpod> ) and viewer of
1919POD content. It heavily employs its ascendant class L<Prima::TextView>,
1920and is in turn base for the toolkit's default help viewer L<Prima::HelpViewer>.
1921
1922=head1 USAGE
1923
1924The package consists of the several logically separated parts. These include
1925file locating and loading, formatting and navigation.
1926
1927=head2 Content methods
1928
1929The basic access to the content is not bound to the file system. The POD
1930content can be supplied without any file to the viewer. Indeed, the file
1931loading routine C<load_file> is a mere wrapper to the content loading
1932functions:
1933
1934=over
1935
1936=item open_read %OPTIONS
1937
1938Clears the current content and enters the reading mode. In this mode
1939the content can be appended by calling L<read> that pushes the raw POD
1940content to the parser.
1941
1942=item read TEXT
1943
1944Supplies TEXT string to the parser. Manages basic indentation,
1945but the main formatting is performed inside L<add> and L<add_formatted>
1946
1947Must be called only within open_read/close_read brackets
1948
1949=item add TEXT, STYLE, INDENT
1950
1951Formats TEXT string of a given STYLE ( one of C<STYLE_XXX> constants) with
1952INDENT space.
1953
1954Must be called only within open_read/close_read brackets.
1955
1956=item add_formatted FORMAT, TEXT
1957
1958Adds a pre-formatted TEXT with a given FORMAT, supplied by C<=begin> or C<=for>
1959POD directives. Prima::PodView understands 'text' and 'podview' FORMATs;
1960the latter format is for Prima::PodView itself and contains small number
1961of commands, aimed at inclusion of images into the document.
1962
1963The 'podview' commands are:
1964
1965=over
1966
1967=item cut
1968
1969Example:
1970
1971	=for podview <cut>
1972
1973	=for text just text-formatter info
1974
1975		....
1976		text-only info
1977		...
1978
1979	=for podview </cut>
1980
1981The E<lt>cut<gt> clause skips all POD input until cancelled.
1982It is used in conjunction with the following command, L<img>, to allow
1983a POD manpage provide both graphic ('podview', 'html', etc ) and text ( 'text' )
1984content.
1985
1986=item img [src="SRC"] [width="WIDTH"] [height="HEIGHT"] [cut="CUT"] [frame="FRAME"]
1987
1988An image inclusion command, where src is a relative or an absolute path to
1989an image file. In case if scaling is required, C<width> and C<height> options
1990can be set. When the image is a multiframe image, the frame index can be
1991set by C<frame> option. Special C<cut> option, if set to a true value, activates the
1992L<cut> behavior if ( and only if ) the image load operation was unsuccessful.
1993This makes possible simultaneous use of 'podview' and 'text' :
1994
1995	=for podview <img src="graphic.gif" cut=1 >
1996
1997	=begin text
1998
1999	y     .
2000	|  .
2001	|.
2002	+----- x
2003
2004	=end text
2005
2006	=for podview </cut>
2007
2008In the example above 'graphic.gif' will be shown if it can be found and loaded,
2009otherwise the poor-man-drawings would be selected.
2010
2011If "src" is omitted, image is retrieved from C<images> array, from the index C<frame>.
2012
2013=back
2014
2015
2016=item close_read
2017
2018Closes the reading mode and starts the text rendering by calling C<format>.
2019Returns C<undef> if there is no POD context, 1 otherwise.
2020
2021=back
2022
2023=head2 Rendering
2024
2025The rendering is started by C<format> call, which returns ( almost ) immediately,
2026initiating the mechanism of delayed rendering, which is often time-consuming.
2027C<format>'s only parameter KEEP_OFFSET is a boolean flag, which, if set to 1,
2028remembers the current location on a page, and when the rendered text approaches
2029the location, scrolls the document automatically.
2030
2031The rendering is based an a document model, generated by open_read/close_read session.
2032The model is a set of same text blocks defined by L<Prima::TextView>, except
2033that the header length is only three integers:
2034
2035	M_INDENT       - the block X-axis indent
2036	M_TEXT_OFFSET  - same as BLK_TEXT_OFFSET
2037	M_FONT_ID      - 0 or 1, because PodView's fontPalette contains only two fonts -
2038	                 variable ( 0 ) and fixed ( 1 ).
2039
2040The actual rendering is performed in C<format_chunks>, where model blocks are
2041transformed to the full text blocks, wrapped and pushed into TextView-provided
2042storage. In parallel, links and the corresponding event rectangles are calculated
2043on this stage.
2044
2045=head2 Topics
2046
2047Prima::PodView provides the C<::topicView> property, which governs whether
2048the man page is viewed by topics or as a whole. When it is viewed as topics,
2049C<{modelRange}> array selects the model blocks that include the topic.
2050Thus, having a single model loaded, text blocks change dynamically.
2051
2052Topics contained in C<{topics}> array, each is an array with indices of C<T_XXX>
2053constants:
2054
2055	T_MODEL_START - beginning of topic
2056	T_MODEL_END   - length of a topic
2057	T_DESCRIPTION - topic name
2058	T_STYLE       - STYLE_XXX constant
2059	T_ITEM_DEPTH  - depth of =item recursion
2060	T_LINK_OFFSET - offset in links array, started in the topic
2061
2062=head2 Styles
2063
2064C<::styles> property provides access to the styles, applied to different pod
2065text parts. These styles are:
2066
2067	STYLE_CODE     - style for C<>
2068	STYLE_TEXT     - normal text
2069	STYLE_HEAD_1   - =head1
2070	STYLE_HEAD_2   - =head2
2071	STYLE_HEAD_3   - =head3
2072	STYLE_HEAD_4   - =head4
2073	STYLE_ITEM     - =item
2074	STYLE_LINK     - style for L<> text
2075	STYLE_VERBATIM - style for pre-formatted text
2076
2077Each style is a hash with the following keys: C<fontId>, C<fontSize>, C<fontStyle>,
2078C<color>, C<backColor>, fully analogous to the tb::BLK_DATA_XXX options.
2079This functionality provides another layer of accessibility to the pod formatter.
2080
2081In addition to styles, Prima::PodView defined C<colormap> entries for
2082C<STYLE_LINK> , C<STYLE_CODE>, and C<STYLE_VERBATIM>:
2083
2084	COLOR_LINK_FOREGROUND
2085	COLOR_LINK_BACKGROUND
2086	COLOR_CODE_FOREGROUND
2087	COLOR_CODE_BACKGROUND
2088
2089The default colors in the styles are mapped into these entries.
2090
2091=head2 Link and navigation methods
2092
2093Prima::PodView provides a hand-icon mouse pointer highlight for the link
2094entries and as an interactive part, the link documents or topics are loaded
2095when the user presses the mouse button on the link. The mechanics below that
2096is as follows. C<{contents}> of event rectangles, ( see L<Prima::TextView> )
2097is responsible for distinguishing whether a mouse is inside a link or not.
2098When the link is activated, C<link_click> is called, which, in turn, calls
2099C<load_link> method. If the page is loaded successfully, depending on C<::topicView>
2100property value, either C<select_topic> or C<select_text_offset> method is called.
2101
2102The family of file and link access functions consists of the following methods:
2103
2104=over
2105
2106=item load_file MANPAGE
2107
2108Loads a manpage, if it can be found in the PATH or perl installation directories.
2109If unsuccessful, displays an error.
2110
2111=item load_link LINK
2112
2113LINK is a text in format of L<perlpod> C<LE<lt>E<gt>> link: "manpage/section".
2114Loads the manpage, if necessary, and selects the section.
2115
2116=item load_bookmark BOOKMARK
2117
2118Loads a bookmark string, prepared by L<make_bookmark> function.
2119Used internally.
2120
2121=item load_content CONTENT
2122
2123Loads content into the viewer. Returns C<undef> is there is no POD
2124context, 1 otherwise.
2125
2126=item make_bookmark [ WHERE ]
2127
2128Combines the information about the currently viewing manpage, topic and text offset
2129into a storable string. WHERE, an optional string parameter, can be either omitted,
2130in such case the current settings are used, or be one of 'up', 'next' or 'prev' strings.
2131
2132The 'up' string returns a bookmark to the upper level of the manpage.
2133
2134The 'next' and 'prev' return a bookmark to the next or the previous topics in a manpage.
2135
2136If the location cannot be stored or defined, C<undef> is returned.
2137
2138=back
2139
2140=head2 Events
2141
2142=over
2143
2144=item Bookmark BOOKMARK
2145
2146When a new topic is navigated to by the user, this event is triggered with the
2147current topic to have it eventually stored in bookmarks or history.
2148
2149=item Link LINK_REF, BUTTON, MOD, X, Y
2150
2151When the user clicks on a link, this event is called with the link address,
2152mouse button, modificator keys, and coordinates.
2153
2154=item NewPage
2155
2156Called after new content is loaded
2157
2158=back
2159
2160=cut
2161