flip.pl

#!/usr/bin/env perl
# 𐑑𐑻𐑯 𐑖𐑱𐑝𐑾𐑯 𐑢𐑻𐑛𐑟 𐑳𐑐𐑕𐑲𐑛 𐑛𐑬𐑯
# klg, 𐑪𐑒𐑑 2024
use strict;
use utf8;
use open qw/:std :utf8/;
use Carp;
use Getopt::Std;

# 43-𐑤𐑧𐑑𐑼 𐑖𐑱𐑝𐑾𐑯 𐑨𐑤𐑓𐑩𐑚𐑧𐑑:
# 𐑐 𐑚 𐑑 𐑛 𐑒 𐑜 𐑓 𐑝 𐑔 𐑞 𐑕 𐑟 𐑖 𐑠 𐑗 𐑡 𐑘 𐑢 𐑙 𐑣 𐑤 𐑮 𐑥 𐑯 𐑦 𐑰 𐑧 𐑱 𐑨 𐑲 𐑩 𐑳 𐑪 𐑴 𐑫 𐑵 𐑬 𐑶 𐑭 𐑷   𐑾
# 𐑚 𐑐 𐑛 𐑑 𐑜 𐑒 𐑝 𐑓 𐑞 𐑔 - - 𐑠 𐑖 𐑡 𐑗 - - 𐑣 𐑙 𐑮 𐑤 𐑥 𐑯 𐑦 𐑰 𐑪 - 𐑩 - 𐑨 - 𐑧 𐑴 𐑵 𐑫 𐑶 𐑬 𐑭 𐑷 - - -
#                     𐑕 𐑟         𐑘 𐑢  - 𐑞𐑰𐑟 4 𐑕𐑑𐑱 𐑞 𐑕𐑱𐑥, 𐑚𐑳𐑑 𐑸 𐑥𐑦𐑕𐑐𐑤𐑱𐑕𐑑

# 48-𐑤𐑧𐑑𐑼 ·𐑨𐑯𐑛𐑮𐑩𐑒𐑤𐑰𐑟 𐑝𐑻𐑠𐑩𐑯 (-a):
# 𐑐 𐑚 𐑑 𐑛 𐑒 𐑜 𐑓 𐑝 𐑔 𐑞 𐑕 𐑟 𐑖 𐑠 𐑗 𐑡 𐑘 𐑢 𐑙 𐑣 𐑤 𐑮 𐑥 𐑯 𐑦 𐑰 𐑧 𐑱 𐑨 𐑲 𐑩 𐑳 𐑪 𐑴 𐑫 𐑵 𐑬 𐑶 𐑭 𐑷 𐑸 𐑹 𐑺 𐑻 𐑼 𐑽 𐑾 𐑿 
# 𐑚 𐑐 𐑛 𐑑 𐑜 𐑒 𐑝 𐑓 𐑞 𐑔 - - 𐑠 𐑖 𐑡 𐑗 - - 𐑣 𐑙 𐑮 𐑤 𐑥 𐑯 𐑦 𐑰 𐑪 - 𐑩 - 𐑨 - 𐑧 𐑴 𐑵 𐑫 𐑶 𐑬 𐑭 𐑷 - - - - - - - -

my %flip = map {((split//)[0,-1,-1,0])} ' ',
qw(𐑐𐑚 𐑑𐑛 𐑒𐑜 𐑓𐑝 𐑔𐑞 𐑖𐑠 𐑗𐑡 𐑙𐑣 𐑤𐑮 𐑥 𐑯 𐑦 𐑰 𐑧𐑪 𐑨𐑩 𐑴 𐑵𐑫 𐑶𐑬 𐑭 𐑷 - /);

my %misplaced = qw(𐑕 𐑕 𐑟 𐑟 𐑘 𐑘 𐑢 𐑢);

return 1 unless __FILE__ eq $0;

getopts('aehmiq', \our %opt) or die;
exit print << "END" if $opt{h};
$0 [𐑪𐑐𐑖𐑩𐑯𐑟] ...
  -a  𐑛𐑴𐑯𐑑 𐑕𐑐𐑤𐑦𐑑 ·𐑨𐑯𐑛𐑮𐑩𐑒𐑤𐑰𐑟 𐑒𐑩𐑥𐑐𐑬𐑯𐑛𐑟
  -e  𐑐𐑮𐑦𐑯𐑑 𐑴𐑯𐑤𐑦 𐑢𐑻𐑛𐑟 𐑞𐑨𐑑 𐑮𐑰𐑛 𐑞 𐑕𐑱𐑥
  -h  𐑖𐑴 𐑞𐑦𐑕 𐑣𐑧𐑤𐑐
  -m  𐑥𐑦𐑕𐑐𐑤𐑱𐑕𐑑 𐑴𐑒𐑱
  -i  𐑿𐑟 ·𐑦𐑯𐑑𐑼 𐑱𐑤𐑾 𐑦𐑯𐑒𐑴𐑛𐑦𐑙
  -q  𐑒𐑢𐑲𐑩𐑑
END

while (<<>>) {
  chomp;
  eval {
    my $ft = shaw_flip($_, %opt);
    printf "%s\n", $ft if $ft eq $_ or not $opt{e};
  };
  warn $@ if $@ and not $opt{q};
}

sub shaw_flip {
  my ($str, %opt) = @_;
  my %f = %flip;
  %f= (%f, %misplaced) if $opt{m};
  $str = ucs_denorm($str) unless $opt{a};
  $str = join('', reverse
    map {$f{$_} // croak "𐑯𐑪𐑑 𐑦𐑯𐑝𐑻𐑑𐑩𐑚𐑩𐑤: $_"}
    split //, $str);
  return ucs_norm($str, %opt);
}

sub ucs_norm {
  (local $_, my %opt) = @_;
  s/𐑮/𐑺/g; s/𐑮/𐑻/g;
  s/𐑭𐑮/𐑸/g; s/𐑷𐑮/𐑹/g;
  s/𐑾𐑮/𐑽/g; s/𐑩𐑮/𐑼/g;
  s/𐑘𐑵/𐑿/g;
  s//𐑺\x{fe00}/g, s//𐑻\x{fe00}/g if $opt{i};
  croak "𐑳𐑯𐑦𐑒𐑕𐑐𐑧𐑒𐑑𐑩𐑛 𐑐𐑮𐑲𐑝𐑩𐑑-𐑿𐑕 𐑒𐑨𐑮𐑩𐑒𐑑𐑼" if /[\x{e000}-\x{f8ff}]/;
  return $_;
}

sub ucs_denorm {
  local $_ = shift;
  s/𐑺/𐑮/g; s/𐑻/𐑮/g;
  s/𐑸/𐑭𐑮/g; s/𐑹/𐑷𐑮/g;
  s/𐑽/𐑾𐑮/g; s/𐑼/𐑩𐑮/g;
  s/𐑿/𐑘𐑵/g;
  s/𐑺\x{fe00}//g; # ·𐑦𐑯𐑑𐑼 𐑱𐑤𐑾 𐑦𐑒𐑕𐑑𐑧𐑯𐑖𐑩𐑯𐑟
  s/𐑻\x{fe00}//g;
  croak "𐑳𐑯𐑦𐑒𐑕𐑐𐑧𐑒𐑑𐑩𐑛 𐑝𐑺𐑾𐑯𐑑 𐑕𐑦𐑤𐑧𐑒𐑑𐑼" if /\x{fe00}/;
  return $_;
}

1;