add fraktur.pl (convert text to unicode fraktur/blackletter)

1 files changed, 45 insertions, 0 deletions

diff --git a/fraktur.pl b/fraktur.pl
new file mode 100755
index 0000000..817e409
--- /dev/null
+++ b/fraktur.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -CIOESA -w
+
+use utf8;
+
+our $fu = "𝔄𝔅ℭ𝔇𝔈𝔉𝔊ℌℑ𝔍𝔎𝔏𝔐𝔑𝔒𝔓𝔔ℜ𝔖𝔗𝔘𝔙𝔚𝔛𝔜ℨ";
+our $fl = "𝔞𝔟𝔠𝔡𝔢𝔣𝔤𝔥𝔦𝔧𝔨𝔩𝔪𝔫𝔬𝔭𝔮𝔯𝔰𝔱𝔲𝔳𝔴𝔵𝔶𝔷";
+our $fub = "𝕬𝕭𝕮𝕯𝕰𝕱𝕲𝕳𝕴𝕵𝕶𝕷𝕸𝕹𝕺𝕻𝕼𝕽𝕾𝕿𝖀𝖁𝖂𝖃𝖄𝖅";
+our $flb = "𝖆𝖇𝖈𝖉𝖊𝖋𝖌𝖍𝖎𝖏𝖐𝖑𝖒𝖓𝖔𝖕𝖖𝖗𝖘𝖙𝖚𝖛𝖜𝖝𝖞𝖟";
+
+sub frakturize {
+	my $text = shift;
+	my $bold = shift || 0;
+	my $out = "";
+	my $c;
+
+	for (split('', $text)) {
+		if($_ ge 'a' && $_ le 'z') {
+			$c = substr(($bold ? $flb : $fl), ord($_) - ord('a'), 1);
+		} elsif($_ ge 'A' && $_ le 'Z') {
+			$c = substr(($bold ? $fub : $fu), ord($_) - ord('A'), 1);
+		} else {
+			$c = $_;
+		}
+		$out .= $c;
+	}
+
+	return $out;
+}
+
+our $bold = 0;
+
+if(@ARGV && ($ARGV[0] =~ /-b/)) {
+	$bold = 1;
+	shift;
+}
+
+if(@ARGV) {
+	print frakturize($_, $bold) . " " for @ARGV;
+	print "\n";
+	exit 0;
+}
+
+while(<>) {
+	print frakturize($_, $bold);
+}