# module that exports some things of use when manipulating Braille

require 5;   # Time-stamp: "1999-09-10 20:55:58 MDT"

package Lingua::Braille::EN_US;
use strict;
use vars qw(@ISA $Debug $VERSION @EXPORT @EXPORT_OK 
	    @glyphs  %bascii2gn %gn2bascii
            %gn2unicode %dots2gn %bits2gn   %unicode2gn %gn2dots %gn2bits
            %flip_vertically %flip_horizontally %rotate_180
           );
require Exporter;
$VERSION = "0.11";
$Debug = 1 unless defined $Debug;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
	    @glyphs  %bascii2gn %gn2bascii
            %gn2unicode %dots2gn %bits2gn   %unicode2gn %gn2dots %gn2bits
            %flip_vertically %flip_horizontally %rotate_180
            print_banner_glyphs print_banner_bascii
);
@EXPORT = ();
use integer;

my $Dots = 6;

#==========================================================================
sub print_banner_bascii {
  print_banner_glyphs(map(exists($bascii2gn{$_}) ? $bascii2gn{$_} : (),
			  split('',
				join('', @_)
			       )
			 )
		     )
}

my @line_bits = ([1,4],
		 [2,5],
		 [3,6],
		 [7,8]);
sub print_banner_glyphs {
  my @out_lines = map([], @line_bits);
  foreach my $glyph (@_) {
    my $bits = ' ' . reverse $gn2bits{$glyph}; # so that dot nums = bit nums
    print "Glyph $glyph, $bits\n" if $Debug > 1;
    foreach my $line_i (0 .. $#line_bits) {
      push(@{ $out_lines[$line_i] },
	   join('',
		map
		{ #print "   i $_ in <$bits>\n";
		  (($_ < length($bits)) && substr($bits,$_,1)) ? '*' : ' '; }
		@{ $line_bits[$line_i] }
	       )
	  )
      ;
    }
  }
  return(  map { join('  ', @$_) . "\n" } @out_lines  );
}

#==========================================================================
@glyphs = ( 0 .. ((1 << $Dots) - 1) );

foreach my $gn (@glyphs) {
  my $b = unpack("b$Dots", pack("C", $gn));
    # Backwards binary expression:  0x03 -> '110000'

  $dots2gn{
	   join('', map(substr($b, $_, 1) ? ($_ + 1) : '', 0 .. ($Dots - 1)))
	  } = $gn;

  $bits2gn{ reverse $b } = $gn;    # Normal binary expression: 0x03 -> '000011'
  $unicode2gn{$gn + 0x2800} = $gn; # Unicode glyph number to braille glyphnum
}

%gn2dots    = reverse %dots2gn;
%gn2bits    = reverse %bits2gn;
%gn2unicode = reverse %unicode2gn;

die "Rewrite this for Dots > 6" unless $Dots == 6;
###########################################################################

%bascii2gn = (
    'A'  =>  1,  'B'  =>  3,  'C'  =>  9,  'D'  => 25,
    'E'  => 17,  'F'  => 11,  'G'  => 27,  'H'  => 19,
    'I'  => 10,  'J'  => 26,  'K'  =>  5,  'L'  =>  7,
    'M'  => 13,  'N'  => 29,  'O'  => 21,  'P'  => 15,
    'Q'  => 31,  'R'  => 23,  'S'  => 14,  'T'  => 30,
    'U'  => 37,  'V'  => 39,  'W'  => 58,  'X'  => 45,
    'Y'  => 61,  'Z'  => 53,

    '1'  =>  2,  '2'  =>  6,  '3'  => 18,  '4'  => 50,
    '5'  => 34,  '6'  => 22,  '7'  => 54,  '8'  => 38,
    '9'  => 20,  '0'  => 52,  

    ' '  =>  0,
    '&'  => 47,  '='  => 63,  '('  => 55,  '!'  => 46,
    ')'  => 62,  '*'  => 33,  '<'  => 35,  '%'  => 41,
    '?'  => 57,  ':'  => 49,  '$'  => 43,  ']'  => 59,
    '\\' => 51,  '['  => 42,
    '/'  => 12,  '+'  => 44,  '#'  => 60,  '>'  => 28,
    '\'' =>  4,  '-'  => 36,  '@'  =>  8,  '^'  => 24,
    '_'  => 56,  '"'  => 16,  '.'  => 40,  ';'  => 48,
    ','  => 32,
);
%gn2bascii = reverse %bascii2gn;

print
  "\%bascii2gn contains ", scalar(keys %bascii2gn ), " keys\n",
  "\%gn2bascii contains ", scalar(keys %gn2bascii ), " keys\n"
 if $Debug > 1;

###########################################################################
my @xforms =
  (
    [ [ [1,3],  [4,6]         ], \%flip_vertically,   'v' ],
    [ [ [1,4],  [2,5],  [3,6] ], \%flip_horizontally, 'h' ],
     # 180ing is just H then V -- do that later
  )
;

foreach my $orig_b (sort { $a <=> $b } keys %bits2gn) {
  foreach my $xform (@xforms) {
    my $bits = $orig_b; # copy
    foreach my $pair (@{$xform->[0]}) { # swap at each bit-pair in the xform
      my($x, $y) = @{$pair}[0,1]; # indexes of chars to swap
      (substr($bits, 6 - $x, 1), substr($bits, 6 - $y, 1), ) =
      (substr($bits, 6 - $y, 1), substr($bits, 6 - $x, 1), );
    }
    $xform->[1]{  $bits2gn{$orig_b}  }   =   $bits2gn{$bits};
    print
      " B$orig_b g$bits2gn{$orig_b} -> B$bits g$bits2gn{$bits} via ",
      $xform->[2], "\n\n" if $Debug > 1;
  }
}

%rotate_180 = map { $_ , $flip_vertically{$flip_horizontally{$_}} }
                  keys(%flip_horizontally);

###########################################################################
if($Debug > 1) {
  foreach my $g (@glyphs) {
    printf
     "%03i: %sB, u%04x, \%${Dots}sD ; fH %3i ; fV %3i; rot %3i\n",
      $g, $gn2bits{$g}, $gn2unicode{$g},
      $gn2dots{$g}, $flip_horizontally{$g}, $flip_vertically{$g}, 
      $rotate_180{$g}
  }
}

###########################################################################
1;

__END__