PANODSSL.pl - Script for converting Panorama stylesheets to DSSSL specifications; see the URL below for canonical version of this script
#!/store/bin/perl

# ============================================================================
# PANODSSL.pl - Script for converting
#               Panorama stylesheets to DSSSL specifications
#
#       usage :	perl panodssl.pl foo.ssh > foo.dsl
#
#               Written by Geir O. Grønmo (geirog@falch.no), Falch Infotek as
#               http://www.falch.no/people/geirog/panodssl/panodssl.pl
#               20th october 1996
# ============================================================================


# -------------------------------------------------------------------------
#  Main section
# -------------------------------------------------------------------------

$userdefinedcolors = 0;
$colortable = "";

undef $/;
$panoramastylesheet = <>;

while ($panoramastylesheet =~ /(<STYLE TAG.*?<\/STYLE>)/gs) {
    push (@styles, $1);
}

&output_doctype;

foreach $style (@styles) {
    %style = ();
    $before = "";
    $after = "";
	$style{'element-break'} = 0;
	&analyze_input_spec;
	&output_spec;
}

&output_colortable;

# -------------------------------------------------------------------------
#  Subroutines
# -------------------------------------------------------------------------

sub strip {
# === Remove "\n" "\n" and "\att(gi)" from strings
	my($strtmp) = @_;
	$strtmp =~ s/\\(\d+)/chr(\1)/e;
	$strtmp =~ s/\\t;?/\t/g;
	$strtmp =~ s/\\n;?//g; # ??? Replace this with "(make paragraph-break)"	
	$strtmp =~ s/\\att\(\w+\)//g; # ???Allow attributes to be used in prefix' or suffix'
    return($strtmp);
}

sub check_value {
# === Check if value is inherited (relative)
    my ($value, $property) = @_;
    if ($value =~ /^([+-])=(\d+)/) {
	return ("($1 (inherited-$property) $2pt)");
    }
    elsif ($value =~ /(\d+)/) {
	return ("$1pt");
    }
}

sub strip_value {
# === Remove noise (?)
    my ($value) = @_;
	if ($value =~ /(\d+)/) {
		return ("$1pt");
    }
}

sub colors {
# === Map colors to predefined or userdefined colortable
    my ($colortmp) = @_;
	my ($red, $green, $blue);
	if ($colortmp =~ /aqua/i) {return ("*aqua*")}
	elsif ($colortmp =~ /black/i) {return ("*black*")}
	elsif ($colortmp =~ /blue/i) {return ("*blue*")}
	elsif ($colortmp =~ /fuchsia/i) {return ("*fuchsia*")}
	elsif ($colortmp =~ /gray/i) {return ("*gray*")}
	elsif ($colortmp =~ /green/i) {return ("*green*")}
	elsif ($colortmp =~ /lime/i) {return ("*lime*")}
	elsif ($colortmp =~ /maroon/i) {return ("*maroon*")}
	elsif ($colortmp =~ /navy/i) {return ("*navy*")}
	elsif ($colortmp =~ /olive/i) {return ("*olive*")}
	elsif ($colortmp =~ /purple/i) {return ("*purple*")}
	elsif ($colortmp =~ /red/i) {return ("*red*")}
	elsif ($colortmp =~ /silver/i) {return ("*silver*")}
	elsif ($colortmp =~ /teal/i) {return ("*teal*")}
	elsif ($colortmp =~ /white/i) {return ("*white*")}
	elsif ($colortmp =~ /yellow/i) {return ("*yellow*")}
	elsif ($colortmp =~ /\#([A-F0-9]{2})([A-F0-9]{2})([A-F0-9]{2})/) {
		$red = hex($1);
		$green = hex($2);
		$blue = hex($3);
		$userdefinedcolors++;
		$colortable .= "(define *userdefinedcolor$userdefinedcolors*\n";
		$colortable .= "(color *rgb-color-space* (/ $red 255) (/ $green 255) (/ $blue 255)))\n\n";
		return ("*userdefinedcolor$userdefinedcolors*")
	}
	else {print STDERR "I don't understand: $colortmp\n"; return ("*black*");}
}

sub calculate_fontsize {
    foreach $tmp (font,afont,bfont) {
	if ($style{"$tmp-scale"}) {
		if ($style{"$tmp-size"}) {
			$style{"$tmp-size"} = int($style{"$tmp-size"} * ($style{"$tmp-scale"} / 100)) . "pt";
		}
		else {
			$style{"$tmp-size"} = "(* (inherited-font-size) " . ($style{"$tmp-scale"} / 100) . ")";
		}
	}
	elsif ($style{"$tmp-size"}) {
		$style{"$tmp-size"} .= "pt";
	}
	}
}

sub analyze_input_spec {
# === RECOGNIZE ALL STYLESPECIFICATIONS

# --- Element qualification

    if ($style =~ /<STYLE\s+TAG=[\s\"\']*([^\"]+)[\s\"\']*>/i) {
	$style{"tag"} = $1;
    # Clean up and reverse qualified elements
    	@temptag = split(/,/,$style{'tag'});
    	$style{'tag'} = join (" ", @temptag);
        if (scalar(@temptag) > 1) {
	    $style{'tag'} = "(" . $style{'tag'} . ")";
	}
    }
    else {
	next;
    }

# === Remove Qualified style (not implemented yet)

	if ($style =~ s/(<QUAL-STYLE.*?<\/QUAL-STYLE>)//gs) {
		$qualstyle = $1;
	}
 
# === Analyse BEFORE- and AFTER-specs

    # --- Analyze before-content
    if ($style =~ s/(<BEFORE>.*?<\/BEFORE>)//gs) {
	$before = $1;

    if ($before =~ /<FONT-FAMILY\s+V=[\s\"\']*([^\"]+)[\s\"\']*>/i) {
		$style{'bfont-family'} = $1;
    }
    if ($before =~ /<FONT-SIZE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'bfont-size'} = $1;
    }
    if ($before =~ /<FONT-SLANT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Roman") {
			$style{'bfont-slant'} = "upright";
		}
		elsif ($tmp eq "Italic") {
			$style{'bfont-slant'} = "italic";
		}
		elsif ($tmp eq "Emphas") {
			$style{'bfont-slant'} = "oblique";
		}
    }
    if ($before =~ /<FONT-WEIGHT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Medium") {
			$style{'bfont-weight'} = "medium";
		}
		elsif ($tmp eq "Bold") {
			$style{'bfont-weight'} = "bold";
		}
    }
    if ($before =~ /<FONT-COLOR\s+V=[\s\"\']*([\#\d+\w]+)[\s\"\']*>/i) {
		$style{'bfont-color'} = colors($1);
	}
    if ($before =~ /<FONT-SCALE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'bfont-scale'} = $1;
    }
    if ($before =~ /<FONT-OFFS\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'bfont-offs'} = $1;
    }
    }

    # --- Analyze after-content
    if ($style =~ s/(<AFTER>.*?<\/AFTER>)//gs) {
		$after = $1;
    if ($after =~ /<FONT-FAMILY\s+V=[\s\"\']*([^\"]+)[\s\"\']*>/i) {
		$style{'afont-family'} = $1;
    }
    if ($after =~ /<FONT-SIZE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'afont-size'} = $1;
    }
    if ($after =~ /<FONT-SLANT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Roman") {
			$style{'afont-slant'} = "upright";
		}
		elsif ($tmp eq "Italic") {
			$style{'afont-slant'} = "italic";
		}
		elsif ($tmp eq "Emphas") {
			$style{'afont-slant'} = "oblique";
		}
    }
    if ($after =~ /<FONT-WEIGHT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Medium") {
			$style{'afont-weight'} = "medium";
		}
		elsif ($tmp eq "Bold") {
			$style{'afont-weight'} = "bold";
		}
    }
    if ($after =~ /<FONT-COLOR\s+V=[\s\"\']*([\#\d+\w]+)[\s\"\']*>/i) {
		$style{'afont-color'} = colors($1);
    }
    if ($after =~ /<FONT-SCALE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'afont-scale'} = $1;
    }
    if ($after =~ /<FONT-OFFS\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'afont-offs'} = $1;
    }
    }

# --- Before: text and ruler

    if ($style =~ /<A-TEXT\s+V=[\s\"\']*([^\']+)[\s\"\']*/i) { # Bug in Panorama: it doesn't write a ">"
		$style{'text-before'} = strip($1);
	}
    if ($style =~ /<A-RULER\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'ruler-before'} = strip_value($1);
    }

# --- After: text and ruler

    if ($style =~ /<Z-TEXT\s+V=[\s\"\']*([^\']+)[\s\"\']*/i) {
		$style{'text-after'} = strip($1);
    }
    if ($style =~ /<Z-RULER\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'ruler-after'} = strip_value($1);
    }

# --- Content

    if ($style =~ /<FONT-FAMILY\s+V=[\s\"\']*([^\"]+)[\s\"\']*>/i) {
		$style{'font-family'} = $1;
    }
    if ($style =~ /<FONT-SIZE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'font-size'} = $1;
    }
    if ($style =~ /<FONT-SLANT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Roman") {
			$style{'font-slant'} = "upright";
		}
		elsif ($tmp eq "Italic") {
			$style{'font-slant'} = "italic";
		}
		elsif ($tmp eq "Emphas") {
			$style{'font-slant'} = "oblique";
		}
    }
    if ($style =~ /<FONT-WEIGHT\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Medium") {
			$style{'font-weight'} = "medium";
		}
		elsif ($tmp eq "Bold") {
			$style{'font-weight'} = "bold";
		}
    }
    if ($style =~ /<FONT-COLOR\s+V=[\s\"\']*([\#\d+\w]+)[\s\"\']*>/i) {
		$style{'font-color'} = colors($1);
    }
    if ($style =~ /<FONT-SCALE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'font-scale'} = $1;
    }
    if ($style =~ /<FONT-OFFS\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'font-offs'} = $1;
    }
    if ($style =~ /<VISIBLE\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$style{'visible'} = $1;
    }

# --- Paragraph

    if ($style =~ /<JUSTIFY\s+V=[\s\"\']*(\w+)[\s\"\']*>/i) {
		$tmp = $1;
		if ($tmp eq "Left") {
			$style{'justify'} = "start";
		}
		elsif ($tmp eq "Right") {
			$style{'justify'} = "end";
		}
		elsif ($tmp eq "Center") {
			$style{'justify'} = "center";
		}
		elsif ($tmp eq "Justify") {
			$style{'justify'} = "page-inside";
		}
    }
    if ($style =~ /<LEADING\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'leading'} = check_value($1,"line-spacing");
    }
    if ($style =~ /<BREAK-BEFORE>/ && $style =~ /<BREAK-AFTER>/i) {
		$style{'element-break'} = 3;
    }
    elsif ($style =~ /<BREAK-BEFORE>/i) {
		$style{'element-break'} = 1;
    }
    elsif ($style =~ /<BREAK-AFTER>/i) {
		$style{'element-break'} = 2;
    }
    if ($style =~ /<SPC-ABOVE\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'space-above'} = strip_value($1);
    }
    if ($style =~ /<SPC-BELOW\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'space-below'} = strip_value($1);
    }
    if ($style =~ /<SPC-INDENT\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'space-indent'} = check_value($1,"first-line-start-indent");
    }
    if ($style =~ /<SPC-LEFT\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'space-left'} = check_value($1,"start-indent");
    }
    if ($style =~ /<SPC-RIGHT\s+V=[\s\"\']*([-+=\d]+)[\s\"\']*>/i) {
		$style{'space-right'} = check_value($1,"end-indent");
    }
}

sub output_spec {
# === Output appropriate DSSSL specification
	$elemspec = "";
	$paraspec = "";
	$seqspec = "";
	$beforespec = "";
	$afterspec = "";
	$elemspec .= "(element $style{'tag'}\n";

	&calculate_fontsize;

	if ($style{'text-before'}) { # text-before
		$beforespec .= "        (make sequence\n";
		# content
		$beforespec .= "            font-family-name: \"$style{'bfont-family'}\"\n" if $style{'bfont-family'};
		$beforespec .= "            font-size: $style{'bfont-size'}\n" if $style{'bfont-size'};
		$beforespec .= "            font-posture: '$style{'bfont-slant'}\n" if $style{'bfont-slant'};
		$beforespec .= "            font-weight: '$style{'bfont-weight'}\n" if $style{'bfont-weight'};
		$beforespec .= "            color: $style{'bfont-color'}\n" if $style{'bfont-color'};
		# text
		$beforespec .= "            (literal \"$style{'text-before'}\")\n" if $style{'text-before'};
		$beforespec .= "        )\n";
	}

	if ($style{'text-after'}) { # text-after
		$afterspec .= "        (make sequence\n";
		# content
		$afterspec .= "            font-family-name: \"$style{'afont-family'}\"\n" if $style{'afont-family'};
		$afterspec .= "            font-size: $style{'afont-size'}\n" if $style{'afont-size'};
		$afterspec .= "            font-posture: '$style{'afont-slant'}\n" if $style{'afont-slant'};
		$afterspec .= "            font-weight: '$style{'afont-weight'}\n" if $style{'afont-weight'};
		$afterspec .= "            color: $style{'afont-color'}\n" if $style{'afont-color'};
		#text
		$afterspec .= "            (literal \"$style{'text-after'}\")\n" if $style{'text-after'};
		$afterspec .= "        )\n";
	}

    if ($style{'element-break'} == 3) { # paragraphs
		$paraspec .= "(sosofo-append\n" if ($style{'ruler-before'} || $style{'ruler-after'});
		#insert ruler above
		if ($style{'ruler-before'}) {
			$paraspec .= "    (make rule\n";
			$paraspec .= "    orientation: 'horizontal\n";
			$paraspec .= "    space-before: $style{'ruler-before'}\n";
			$paraspec .= "    space-after: 5pt\n";
			$paraspec .= "    line-thickness: 1pt\n";
			$paraspec .= "    )\n";
		}
		$paraspec .= "    (make paragraph\n";
		# content
		$paraspec .= "        font-family-name: \"$style{'font-family'}\"\n" if $style{'font-family'};
		$paraspec .= "        font-size: $style{'font-size'}\n" if $style{'font-size'};
		$paraspec .= "        font-posture: '$style{'font-slant'}\n" if $style{'font-slant'};
		$paraspec .= "        font-weight: '$style{'font-weight'}\n" if $style{'font-weight'};
		$paraspec .= "        color: $style{'font-color'}\n" if $style{'font-color'};
		# paragraph
		$paraspec .= "        quadding: '$style{'justify'}\n" if $style{'justify'};
		$paraspec .= "        line-spacing: (+ (inherited-font-size) $style{'leading'})\n" if $style{'leading'};
		$paraspec .= "        space-before: $style{'space-above'}\n" if $style{'space-above'};
		$paraspec .= "        space-after: $style{'space-below'}\n" if $style{'space-below'};
		$paraspec .= "        first-line-start-indent: $style{'space-indent'}\n" if $style{'space-indent'};
		$paraspec .= "        start-indent: $style{'space-left'}\n" if $style{'space-left'};
		$paraspec .= "        end-indent: $style{'space-right'}\n" if $style{'space-right'};
		$paraspec .= $beforespec if ($beforespec ne "");
		$paraspec .= "        (process-children)\n";
		$paraspec .= $afterspec if ($afterspec ne "");
		$paraspec .= "    )\n";
		#insert ruler above
		if ($style{'ruler-after'}) {
			$paraspec .= "    (make rule\n";
			$paraspec .= "    orientation: 'horizontal\n";
			$paraspec .= "    space-before: 5pt\n";
			$paraspec .= "    space-after: $style{'ruler-after'}\n";
			$paraspec .= "    line-thickness: 1pt\n";
			$paraspec .= "    )\n";
		}
		$paraspec .= ")\n" if ($style{'ruler-before'} || $style{'ruler-after'});
    }
	else { # inline sequences
		$seqspec .= "    (make sequence\n";
		# content
		$seqspec .= "        font-family-name: \"$style{'font-family'}\"\n" if $style{'font-family'};
		$seqspec .= "        font-size: $style{'font-size'}\n" if $style{'font-size'};
		$seqspec .= "        font-posture: '$style{'font-slant'}\n" if $style{'font-slant'};
		$seqspec .= "        font-weight: '$style{'font-weight'}\n" if $style{'font-weight'};
		$seqspec .= "        color: $style{'font-color'}\n" if $style{'font-color'};
		if ($style{'element-break'} == 1) {$seqspec .= "        (make paragraph-break)\n";}
		$seqspec .= "        (process-children)\n";
		if ($style{'element-break'} == 2) {$seqspec .= "        (make paragraph-break)\n";}
		$seqspec .= "    )\n";
	}

	if ($style{'visible'} eq "Hide") {
		$elemspec .= "    (empty-sosofo)\n";
	}
	else {
		if ($paraspec ne "") {
			$elemspec .= $paraspec;
		}
		elsif ($seqspec ne "") {
			$elemspec .= $seqspec;
		}
	}

	$elemspec .= ")\n\n";
	print $elemspec;
}

sub output_doctype {
# === Output prolog and spec for root-element

    print '<!doctype dsssl-spec [
<!element dsssl-spec o o
  (char-repertoire?, style-specification,
	(style-specification|external-specification)*)>
<!element style-specification o o (style-specification-body)>
<!element style-specification-body o o (#pcdata)>
<?ArcBase dsssl>
<!notation dsssl PUBLIC
  "ISO/IEC 10179:1996//NOTATION DSSSL Architecture Definition Document//EN">
<!entity % dssslDtd system "dsssl.dtd">
<!attlist #notation dsssl
  ArcDocF NAME #FIXED dsssl-specification
  ArcDTD CDATA "%dssslDtd"
  ArcQuant CDATA "NAMELEN 64"
>
]>

(root (make simple-page-sequence
            font-family-name: "Arial"
            font-size: 10pt
		    input-whitespace-treatment: \'collapse
		    header-margin: .5in
	    	footer-margin: .5in
		    left-margin: 1in
		    right-margin: 1in
	    	top-margin: 1in
		    line-thickness: (* (actual-font-size) .05)
		    bottom-margin: 1in
	    	page-width: 211mm
		    page-height: 297mm))

';
}

sub output_colortable {
# === Output colortable definitions

    print ';; Predefined colors

(define *rgb-color-space*
  (color-space "ISO/IEC 10179:1996//Color-Space Family::Device RGB"))

(define *fuchsia*
  (color *rgb-color-space* (/ 255 255) (/ 0 255) (/ 255 255)))
(define *gray*
  (color *rgb-color-space* (/ 128 255) (/ 128 255) (/ 128 255)))
(define *green*
  (color *rgb-color-space* (/ 0 255) (/ 104 255) (/ 18 255)))
(define *lime*
  (color *rgb-color-space* (/ 0 255) (/ 255 255) (/ 32 255)))
(define *maroon*
  (color *rgb-color-space* (/ 132 255) (/ 8 255) (/ 8 255)))
(define *navy*
  (color *rgb-color-space* (/ 30 255) (/ 7 255) (/ 141 255)))
(define *olive*
  (color *rgb-color-space* (/ 111 255) (/ 124 255) (/ 14 255)))
(define *purple*
  (color *rgb-color-space* (/ 128 255) (/ 0 255) (/ 128 255)))
(define *red*
  (color *rgb-color-space* (/ 255 255) (/ 0 255) (/ 0 255)))
(define *silver*
  (color *rgb-color-space* (/ 192 255) (/ 192 255) (/ 192 255)))
(define *teal*
  (color *rgb-color-space* (/ 0 255) (/ 128 255) (/ 128 255)))
(define *white*
  (color *rgb-color-space* (/ 255 255) (/ 255 255) (/ 255 255)))
(define *yellow*
  (color *rgb-color-space* (/ 255 255) (/ 255 255) (/ 0 255)))
(define *blue*
  (color *rgb-color-space* (/ 0 255) (/ 0 255) (/ 255 255)))
(define *aqua*
  (color *rgb-color-space* (/ 70 255) (/ 255 255) (/ 245 255)))
(define *black*
  (color *rgb-color-space* (/ 0 255) (/ 0 255) (/ 0 255)))

';
	print ";; User defined colors\n\n$colortable\n\n";
}