File Coverage

blib/lib/WE_Frontend/TextLayouter.pm

Criterion	Covered	Total	%
statement	78	82	95.1
branch	26	32	81.2
condition	7	12	58.3
subroutine	9	10	90.0
pod	1	4	25.0
total	121	140	86.4

# -*- perl -*-

#
# $Id: TextLayouter.pm,v 1.4 2003/12/16 15:21:23 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2001 Online Office Berlin. All rights reserved.
# Copyright (C) 2002 Slaven Rezic.
# This is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License, see the file COPYING.

#
# Mail: [e-mail]
# WWW:  http://we-framework.sourceforge.net
#

package WE_Frontend::TextLayouter;

use strict;
use vars qw($VERSION %fontinfo @EXPORT_OK);
$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);

use base 'Exporter';
@EXPORT_OK = qw(break_text continue_text_with_nl combine_fontinfo);

sub break_text {
    my($text, $fontinfo, $boxwidth, $boxheight, %args) = @_;

    my @out;
    my $box           = $args{'-box'}; $box = "" if !defined $box;
    my $x             = $args{'-x'} || 0;
    my $y             = $args{'-y'} || 0;
    my $maxlineheight = $args{'-maxlineheight'} || 0;
    my $lastboxref    = $args{'-lastbox'};

    my $space_width = (get_bounds(" ", $fontinfo))[0];
    my $line_height = (get_bounds("A", $fontinfo))[1]; # XXX maybe better character than "A"?

    foreach my $line (split /\n/, $text) {

	my $push_word;
	my $word_height = 0;

	my $next_line_or_box = sub {
	    if ($y+$word_height+$maxlineheight >= $boxheight) {
		# next box
		push @out, $box;
		$box = "";
		$x = 0;
		$y = 0;
		$maxlineheight = 0;
		$push_word->() if $push_word;
	    } else {
		# next line
		$box .= "\n";
		$x = 0;
		$y += $maxlineheight;
		$maxlineheight = 0;
		$push_word->() if $push_word;
	    }
	};

	foreach my $word (split /\s+/, $line) {
	    my $word_width;
	    ($word_width, $word_height) = get_bounds($word, $fontinfo);

	    my $is_beginning_of_line = sub {
		$box eq '' || $box =~ /\n\Z/s;
	    };

	    $push_word = sub {
		if (!$is_beginning_of_line->()) {
		    $box .= " ";
		    $x += $space_width;
		}
		$box .= $word;
		$x += $word_width;
		if ($word_height > $maxlineheight) {
		    $maxlineheight = $word_height;
		}
	    };

	    my $this_space_width = (!$is_beginning_of_line->() ? $space_width : 0);

	    if ($x+$word_width+$this_space_width < $boxwidth &&
		$y+$word_height < $boxheight) {
		# fits into this line
		$push_word->();
	    } else {
		$next_line_or_box->();
	    }
	}

	undef $push_word;
	$maxlineheight = $line_height;
	$next_line_or_box->();
    }

    push @out, $box if $box ne "";

    if ($lastboxref) {
	$lastboxref->{'-box'}           = $box;
	$lastboxref->{'-x'}             = $x;
	$lastboxref->{'-y'}             = $y;
	$lastboxref->{'-maxlineheight'} = $maxlineheight;
    }

    @out;
}

#XXX
#  sub add_br {
#      my($fontinfo, $boxwidth, $boxheight, %args) = @_;
#      if (!$args{'-prevlastbox'}) {
#  	die "The -prevlastbox option is missing";
#      }
#      my $prevlastbox = delete $args{'-prevlastbox'};
#      my %new_args = (-box => $prevlastbox->{'-box'}."\n",
#  		    -x => 0,
#  		    -y => $prevlastbox->{'-maxlineheight'}+$prevlastbox->{'-y'});
#      break_text("", $fontinfo, $boxwidth, $boxheight, %args, %new_args);
#  }

###XXX hmmm...????
sub continue_text_with_nl {
    my($text, $fontinfo, $boxwidth, $boxheight, %args) = @_;
    if (!$args{'-prevlastbox'}) {
	die "The -prevlastbox option is missing";
    }
    my $prevlastbox = delete $args{'-prevlastbox'};
    my %new_args = (-box => $prevlastbox->{'-box'}.($prevlastbox->{'-box'}ne""?"\n":""),
		    -x => 0,
		    -y => $prevlastbox->{'-maxlineheight'}+$prevlastbox->{'-y'});
    break_text($text, $fontinfo, $boxwidth, $boxheight, %args, %new_args);
}

sub add_y {
    my($prevlastbox_ref, $yadd) = @_;
    $prevlastbox_ref->{'y'} = 0 if !$prevlastbox_ref->{'y'};
    $prevlastbox_ref->{'y'} += $yadd;
}

sub get_bounds {
    my($text, $fontinfo) = @_;
    my($x,$y) = (0,0);

    foreach my $ch (split //, $text) {
	my $ord = ord $ch;
	if ($ord >= $fontinfo->{'firstchar'} &&
	    $ord <= $fontinfo->{'lastchar'}) {
	    my $inx = $ord-$fontinfo->{'firstchar'};
	    $x += $fontinfo->{'widths'}[$inx];
	    my $chheight = $fontinfo->{'heights'}[$inx];
	    if ($chheight > $y) {
		$y = $chheight;
	    }
	}
    }

    ($x,$y);
}

1;

__END__