##
##  wml::des::typography - Typography
##  Copyright (c) 1997-2001 Ralf S. Engelschall, All Rights Reserved. 
##

#  The <preserve>/<restore> tags with multiple arguments require WML 2.0.3
#use wml::mod::version
<require 2.0.3 />

#use wml::std::tags
#use wml::des::imgdot
#use wml::des::gfont
#use wml::des::space
#use wml::fmt::verbatim

#
#   typographical paragraph skip (ps)
#   [german variant: *D*urch*S*chuß (ds)]
#
<define-tag ps>
<br />
<imgdot height=<or %0 4 /> /><br />
</define-tag>

<let ds=ps />

#
#   typographical paragraph indention (pi)
#   [german variant: *Ein*rückung (ein)]
#
<define-tag pi>
<br />
<imgdot height=16 width=<or %0 40 /> />
</define-tag>

<let ein=pi />

#
#   big letter
#
<define-tag big>
<gfont face="ps:ptmb8r" size=+4 align=left crop>%0</gfont>
</define-tag>

#
#   Spaced Paragraph
#   [german variant: Gesperrt]
#
<define-tag spaced endtag=required>
<preserve interchar interline />
<set-var %attributes />
<perl>
{
    my $n_char = qq|<get-var interchar />|;
    my $n_line = qq|<get-var interline />|;
    my $base   = qq|<or <get-var IMGDOT_BASE /> <get-var IMAGE_BASE /> />|;
    my $format = qq|<or <get-var IMAGE_FORMAT /> gif />|;
    <perl:assign:sq $body>%body</perl:assign:sq>
    $n_char = 0 if ($n_char eq '' or $n_char < 0);
    $n_line = 0 if ($n_line eq '' or $n_line < 0);

    my $pad_char = '';
    if ($n_char > 0) {
        $pad_char = '&nbsp;' x $n_char;
    }

    my $pad_line = '';
    if ($n_line > 0) {
        $n_line += 14; # 14 pt is the average text width
        my $file = &imgdot($base, 1, 1, 'transp-ffffff', 255, 255, 255, 1, $format);
        $pad_line = '<*img src="'.$file.'" width=1 height='.$n_line.' alt="">';
    }

    my $cnt = 0;
    my $every = int(5 / ($n_char+1));
    $every = 1 if ($every < 1);
    while ($body) {
        if ($body =~ s|^(</?[a-zA-Z]+[^>]*>)||s) {
            <perl:print: $1 />
        }
        elsif ($body =~ s|^([^<\s]+)||s) {
            $word = $1;
            $word =~ s|\G(.)|$1$pad_char|sg;
            <perl:print: $word />
            if (($cnt++ % $every) == 0) {
                <perl:print: $pad_line />
            }
        }
        elsif ($body =~ s|^(\S+)||s) {
            $word = $1;
            $word =~ s|\G(.)|$1$pad_char|sg;
            <perl:print: $word />
            if (($cnt++ % $every) == 0) {
                <perl:print: $pad_line />
            }
        }
        elsif ($body =~ s|^(\s+)||s) {
            $space = $1;
            $space =~ s|\G([^\n])|$pad_char$1|sg;
            <perl:print: $space />
        }
    }
}
</perl>
<restore  interchar interline />
</define-tag>

<let gesperrt=spaced />

#
#   Small Caps (sc)
#   i.e. change all lower case letters to upper case but lower
#   them a little bit by font size.  Optionally all words can
#   begin with an upper case letter
#   [german variant: "Kapitälchen"]
#
<define-tag sc endtag=required>\
<preserve complete />\
<set-var complete=* />\
<set-var %attributes />\
<perl>
{
    my $complete = (qq|<get-var complete />| eq '' ? 1 : 0);
    <perl:assign:sq $body>%body</perl:assign:sq>
    $body =~ s|\n$||s;
    use locale;
    sub convword {
        my ($w) = @_;

        #   optionally make all words start with an upper case letter
        $w = uc(substr($w, 0, 1)).substr($w, 1) if ($complete);

        #   convert lower case chars to upper case
        my $c;
        my @C = split('', $w);
        my $makeupper = 0;
        $w = '';
        foreach $c (@C) {
            if (not $makeupper and $c eq lc($c)) {
                $w .= '<*font size="-1">'.uc($c);
                $makeupper = 1;
            }
            elsif ($makeupper and $c ne lc($c)) {
                $w .= '<*/font>'.$c;
                $makeupper = 0;
            }
            elsif ($makeupper and $c eq lc($c)) {
                $w .= uc($c);
            }
            else {
                $w .= $c;
            }
        }
        $w .= '<*/font>' if ($makeupper);
        return $w;
    }
    my $text = '';
    while ($body ne '') {
        if ($body =~ m|^([^<]+)(<[/a-zA-Z].*?>)(.*)$|) {
            my $words = $1;
            my $rest  = $2;
            $body = $3;
            $words =~ s|(\w+)|&convword($1)|sge;
            $text .= $words . $rest;
        }
        elsif ($body =~ m|^(<[/a-zA-Z].*?>)(.*)$|) {
            $text .= $1;
            $body = $2;
        }
        else {
            $body =~ s|(\w+)|&convword($1)|sge;
            $text .= $body;
            $body = '';
        }
    }
    <perl:print: $text />
}
</perl>\
<restore complete />\
</define-tag>

<let csc=sc />

#
#   Verbatim Code Text
#
<define-tag verbcode endtag=required>
<p*>
<over 30>
<b><verbatim>%body</verbatim></b>
</over>
</define-tag>

#
#   Headline
#   [german variant: "Überschrift"]
#
<define-tag headline endtag=required>
<if %0 "<a* name="%0">" />\
<font face="Arial,Helvetica" size=+4><b>%body</b></font>\
<if %0 "</a*>" />
<ds 5 />\
</define-tag>

<let ue=headline />

#
#   Sub Headline
#   [german variant: "Zwischenüberschrift"]
#
<define-tag subheadline endtag=required>
<if %0 "<a* name="%0">" />\
<font face="Arial,Helvetica" size=+2><b>%body</b></font>
<if %0 "</a*>" />
<ds 2 />\
</define-tag>

<let zwue=subheadline />

#
#   Emulation of the <ul>...</ul> environment in
#   a more typographically strong layout.
#
<define-tag tul endtag=required>
<preserve ps pi />
<set-var %attributes />
<defvar pi 30 />
<ps <get-var ps /> />
<table cellspacing=0 cellpadding=0 border=$(DEBUG:-0) summary="">
<tr>
<td valign=top><imgdot height=1 width=<get-var pi /> /></td><suck/>
<td valign=top><imgdot height=1 width=<get-var pi /> /><suck/>
%body<suck/>
</td>
</tr>
</table>
<restore  ps pi />
</define-tag>

<define-tag tli endtag=required>
<preserve pshape pcolor />
<set-var %attributes />
<defvar pshape box />
<defvar pcolor "#cccccc" />
<ps <get-var ps /> />
</td*>\
</tr*>
<tr*>\
<td valign=top align=right>\
<ifeq "<get-var pshape />" "box"
    <imgdot color="<get-var pcolor />" height=10 width=10 />
    "<font color="<get-var pcolor />">-</font>" />\
&nbsp;&nbsp;\
</td>\
<td*>
%body
<restore  pshape pcolor />
</define-tag>

#
#   the ``#use ... face_shortcuts'' support
#
<if "$(face_shortcuts)" <group
{: [[s/(face=)"?helvetica"?/face="Arial,Helvetica"/ig]]
{#TYPOGRAPHY_FACE_SHORTCUTS#}
:}
{#TYPOGRAPHY_FACE_SHORTCUTS#:
/>/>

##EOF##
