#!/usr/bin/perl -w

###########################################################################
#
# keyboard.pl -- generate a set of Expeditee frames to implement a 
#                touch-screen keyboard
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

BEGIN {
    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugouts");

    if (defined $ENV{'GSDLEXTS'}) {
	my @extensions = split(/:/,$ENV{'GSDLEXTS'});
	foreach my $e (@extensions) {
	    my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";

	    unshift (@INC, "$ext_prefix/perllib");
	    unshift (@INC, "$ext_prefix/perllib/cpan");
	    unshift (@INC, "$ext_prefix/perllib/plugins");
	    unshift (@INC, "$ext_prefix/perllib/plugouts");
	}
    }
    if (defined $ENV{'GSDL3EXTS'}) {
	my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
	foreach my $e (@extensions) {
	    my $ext_prefix = "$ENV{'GSDL3SRCHOME'}/ext/$e";

	    unshift (@INC, "$ext_prefix/perllib");
	    unshift (@INC, "$ext_prefix/perllib/cpan");
	    unshift (@INC, "$ext_prefix/perllib/plugins");
	    unshift (@INC, "$ext_prefix/perllib/plugouts");
	}
    }

    if ((defined $ENV{'DEBUG_UNICODE'}) && (defined $ENV{'DEBUG_UNICODE'})) {
	binmode(STDERR,":utf8");
    }
}

use utf8;
use strict;

use ExpediteeFrameIO;
use util;


my $default_key_width  = 85;
my $default_key_height = 85;

my $number_line = [ "`", "1", "2",  "3", "4", "5", "6", "7", "8", "9", "0", "-", "=" ];
my $punct_line  = [ "~", "!", " \@", "\#", "\$", "\%", "^", "\&", "*", "(", ")", "_", "+" ];

my $lc_letters_row1 = [ "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "\\" ];
my $lc_letters_row2 = [ "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'" ];
my $lc_letters_row3 = [ "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "Bksp" ];

my $uc_letters_row1 = [ "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "|" ];
my $uc_letters_row2 = [ "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", "\"" ];
my $uc_letters_row3 = [ "Z", "X", "C", "V", "B", "N", "M", "<", ">", "?", "Bksp" ];

my $spacebar_line = [ { 'label' => "\@Space", 'char' => " " } ];
#my $backspace_line = [ "Bksp" ];

my $macron_mapping = { 'a' => 'ā',
		       'e' => 'ē',
		       'i' => 'ī',
		       'o' => 'ō',
		       'u' => 'ū',
		       'A' => 'Ā',
		       'E' => 'Ē',
		       'I' => 'Ī',
		       'O' => 'Ō',
		       'U' => 'Ū'  };

my @main_number_line   = @$number_line;
my @macron_number_line = @$number_line;

my @shift_punct_line        = @$punct_line;
my @shift_macron_punct_line = @$punct_line;

my @main_lc_letters_row1         = @$lc_letters_row1;
my @shift_uc_letters_row1        = @$uc_letters_row1;
my @macron_lc_letters_row1       = @$lc_letters_row1;
my @shift_macron_uc_letters_row1 = @$uc_letters_row1;

my @main_lc_letters_row2         = @$lc_letters_row2;
my @shift_uc_letters_row2        = @$uc_letters_row2;
my @macron_lc_letters_row2       = @$lc_letters_row2;
my @shift_macron_uc_letters_row2 = @$uc_letters_row2;

my @main_lc_letters_row3         = @$lc_letters_row3;
my @shift_uc_letters_row3        = @$uc_letters_row3;
my @macron_lc_letters_row3       = @$lc_letters_row3;
my @shift_macron_uc_letters_row3 = @$uc_letters_row3;



sub print_keyboard
{
    my ($keyboard) = @_;

    print "Title: $keyboard->{'title'}\n";

    my $keys = $keyboard->{'keys'};

    foreach my $row (@$keys) {

	foreach my $letter_rec (@$row) {

	    my $letter_rec_type = ref($letter_rec);

	    if ($letter_rec_type eq "") {
		my $letter = $letter_rec;
		print " '$letter'";
	    }
	    elsif ($letter_rec_type eq "HASH") {
	 	if (defined $letter_rec->{'char'}) {
			my $label = $letter_rec->{'label'};
			my $char  = $letter_rec->{'char'};
			print " $label=>'$char'";
		}
		else {
		  # assume we're a linked keyboard 
		    my $label = $letter_rec->{'label'};
		    my $goto_keyboard = $letter_rec->{'link'};
		    my $goto_keyboard_title = $goto_keyboard->{'title'};
		    
		    print " ${label}->[$goto_keyboard_title]";
		}
	    }
	    else {
		print STDERR "Warning: unrecognized letter record type: $letter_rec_type\n";
	    }
	}
	print "\n";
    }
    
}

##
#
# Subroutine to add overlay frame to frameset.
# This frame contains the wooden desktop background,
# which will display behind the keyboard.
#
##
sub add_overlay_frame
{
       my ($expeditee_frame_io) = @_;
       my $x = 20;
       my $y = 20;
       my $linkText = "\@o";
       my $attr = {};

       $attr->{'F'} = "keyboard5";
       $expeditee_frame_io->addText($x,$y,$linkText,undef,$attr);
}

##
#
# Subroutine to add wooden desktop background
# to the back of the keyboard.
#
##
sub add_background
{
	my ($expeditee_frame_io) = @_;
	my $x = 5;
	my $y = 60;
	my $bgImg = "\@i: images/backgrounds/wood-keyboard.png";

	$expeditee_frame_io->addText($x,$y,$bgImg,undef,{});
}

##
#
# Subroutine to add search controls. These include
# the search box, search button and reset button.
#
##
sub add_search_controls
{
	my ($expeditee_frame_io) = @_;

	my $x = 20;
	my $y = 100;	

	#add in search box.
	my $xr = $x + 600;
	my $yb = $y + 85;
	
	my $searchBoxAttr = {};
	$searchBoxAttr->{'d'} = "0 0 0";		#set line colour
	$searchBoxAttr->{'h'} = "2.0";			#set line thickness
        $searchBoxAttr->{'e'} = "87 76 49";			#set rectangle fill colour
	
	$expeditee_frame_io->addRect($x,$y,$xr,$yb,$searchBoxAttr);
	
	#add in text to go inside search box.
	$x += 5;
	$y += 55;
	my $searchBoxText = "Search text goes here";
	
	my $textAttr = {};
	$textAttr->{'f'} = "tb30";

	$expeditee_frame_io->addText($x,$y,$searchBoxText,undef,$textAttr);
	
	#add button images for 'Search' button and 'Reset' button.
	$x = ($x - 5) + $xr + 10;
	$y -= 55;				#reset y to original value so buttons align with search box.

	$textAttr->{'X'} = "runFrame";
	$textAttr->{'x'} = "false";		#set action mark.
	$textAttr->{'n'} = "false";		#set link mark.

	my $imgBtn = "\@i: images/buttons/search_controls.png";
	my $width = 145;

        $textAttr->{'F'} = "Keyboard-Actions31";			#link to frame containing Search SIMPLE program.

	$expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);	#add image text annotation to frame.
	
	$x += 25;
	$y += 55;
	
	my $searchBtnText = "Search";
        $textAttr->{'d'} = "100 100 100";			#set text color 
	$expeditee_frame_io->addText($x,$y,$searchBtnText,undef,$textAttr);
	
	$x = ($x - 25) + $width + 10;
	$y -= 55;
        $textAttr->{'F'} = "Keyboard-Actions12";			#link to frame containing Reset SIMPLE program.
	$expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);
	
	$x += 25;
	$y += 55;
	
	my $resetBtnText = "Reset";
        
	$expeditee_frame_io->addText($x,$y,$resetBtnText,undef,$textAttr);	

}


###
#
# Subroutine that gets a key and adds it to the keyboard.
#
###

sub add_key
{
    my ($expeditee_frame_io,$label,$char,$x,$y) =@_;

    my $imgBtn = "";
    my $textAttr = {};
    my $imgBtnAttr = {};

    my $width = 0;
    my $height = 85;

    $imgBtnAttr->{'X'} = "runFrame";
    $imgBtnAttr->{'F'} = "Keyboard-Actions7";
    $imgBtnAttr->{'x'} = "false";			#set action mark
    $imgBtnAttr->{'n'} = "false";			#set link mark

    $textAttr->{'X'} = "runFrame";
    $textAttr->{'F'} = "Keyboard-Actions7";
    $textAttr->{'x'} = "false";				#set action mark
    $textAttr->{'n'} = "false";				#set link mark
    $textAttr->{'d'} = "100 100 100";			#set text color
 
    #if we are adding in space bar then add the space bar image instead of the usual key button image.
    if($label eq "\@Space") {
		$imgBtn = "\@i: images/buttons/key_space.png";
		$textAttr->{'f'} = "tb48";
		
		$width = 420;
    }
    #if we are adding in a shift or macron or backspace button then use following image instead.
    elsif(($label eq "macron") || ($label eq "shift")) {
                       
         
		$imgBtn = "\@i: images/buttons/key_special.png";

		$textAttr->{'f'} = "tb32";
		$width = 145;
		
    }
    elsif($label eq "Bksp"){
		
		$imgBtn = "\@i: images/buttons/key_bksp.png";
		$textAttr ->{'f'} = "tb28";
		$width = 145;
    }
    #otherwise we are just adding in a normal key.
    else {
		$imgBtn = "\@i: images/buttons/key_letter.png";
		$textAttr->{'f'} = "tb48";

#TODO: Change this code so it's much tidier...
		if(($label eq 'ā') || ($label eq 'ē') || ($label eq 'ī') || ($label eq 'ō') || ($label eq 'ū') || ($label eq 'Ā') || ($label eq 'Ē') || ($label eq 'Ī') || ($label eq 'Ō') || ($label eq 'Ū')) {

			$textAttr->{'d'} = "100 0 0";
		}

		$width = 85;
    }
    
    $default_key_width = $width;
    $default_key_height = $height;

    my $xl = $x;
    my $xr = $xl + $width;
    my $yt = $y;
    my $yb = $yt + $height;

    $expeditee_frame_io->addText($xl,$yt,$imgBtn,undef,$imgBtnAttr);	#adds image annotations to frame.

    #used for positioning letters as centre to their keys as possible.
    if($label eq "macron") {
	$xl += 10;
        $yt += 55;
    }
    elsif($label eq "shift") {
	$xl += 35;
        $yt += 55;
    }
    elsif($label eq "Bksp") {
	$xl += 55;
        $yt += 50;
    }
    else {
	$xl += 20;
        $yt += 55;
    }




    
    if ($label =~ m/^ /) {
	# compensate for any labels that start with a space 
	# (i.e. on the @ key, where a space is needed for Expeditee so it doesn't treat it as an annotation)
	$xl -= 20;
    }

    $expeditee_frame_io->addText($xl,$yt,$label,undef,$textAttr);

}

###
#
# Subroutine that generates an expeditee frame
# for each keyboard.
#
###
sub generate_expeditee_frame
{
    my ($expeditee_frame_io,$keyboard) = @_;

    my $fn = $keyboard->{'frame-number'};
    my $keys = $keyboard->{'keys'};
   
    my $y = 300;
    my $offSetX = 0;

    if ($fn != 0 && $fn != 5) {

	add_overlay_frame($expeditee_frame_io);
	add_search_controls($expeditee_frame_io);

#	add_background($expeditee_frame_io);

    foreach my $row (@$keys) {
	
	 my $x = 20 + $offSetX;
         
	 foreach my $letter_rec (@$row) {

	     my $letter_rec_type = ref($letter_rec);
		
	     if ($letter_rec_type eq "") {
		my $letter = $letter_rec;
		add_key($expeditee_frame_io,$letter,$letter,$x,$y,$default_key_width,$default_key_height);	
                print " $letter "; 
	    }
	    elsif ($letter_rec_type eq "HASH") {
	 	if (defined $letter_rec->{'char'}) {
			my $label = $letter_rec->{'label'};
			my $char  = $letter_rec->{'char'};

			add_key($expeditee_frame_io,$label,$char,$x,$y);

			print " $label ";
		}
		else {
		  # assume we're a linked keyboard 
		    my $label = $letter_rec->{'label'};
		    my $goto_keyboard = $letter_rec->{'link'};
		    my $goto_keyboard_title = $goto_keyboard->{'title'};

		    add_key($expeditee_frame_io,$label,$label,$x,$y);

		    print " $label ";
		}
	    }
	    else {
		print STDERR "Warning: unrecognized letter record type: $letter_rec_type\n";
	    }

	    $x += $default_key_width + 5;
	}

	$y += $default_key_height + 5;
        $offSetX += 25;
        print "\n";
    }

    }
    elsif($fn == 5) {   #create overlay frame.
	add_background($expeditee_frame_io);

    }

    if ($expeditee_frame_io->saveFrame("$fn.exp")) {
	
	# write out next free frame num
	$expeditee_frame_io->saveLastFrameNumber($fn);
	print "Frame $fn written successfully\n";
    }
    else {
	print STDERR "Error writing frame $fn.exp\n";
    }
}


sub main
{
    my (@argv) = @_;

    binmode(STDOUT,":utf8");

    my $home_dir = (defined $ENV{'EXPEDITEE_HOME'}) ? $ENV{'EXPEDITEE_HOME'} : ".";
    my $output_dir = util::filename_cat($home_dir,"expeditee","framesets","keyboard");
 
    if (-e $output_dir) {
	util::mk_all_dir($output_dir);
    }

    print "Saving output to directory: $output_dir\n";

    my $expeditee_frame_io = new ExpediteeFrameIO($output_dir);

    #used for creating zero frame - won't actually contain anything.
    my $zero_keyboard
	= { 'frame-number' => 0,
	    'title' => "keyboard0",
	    'keys' => [] };

    my $main_keyboard 
	= { 'frame-number' => 1,
	    'title' => "Main keyboard",
	    'keys' => [ \@main_number_line,
			\@main_lc_letters_row1,
			\@main_lc_letters_row2,
			\@main_lc_letters_row3 ] };
    
# my @main_lc_letters_row1 = @$lc_letters_row1
# \@main_lc_letters_row1

    my $shift_keyboard 
	= { 'frame-number' => 2,
	    'title' => "Shift keyboard",
	    'keys' => [ \@shift_punct_line,
			\@shift_uc_letters_row1,
			\@shift_uc_letters_row2,
			\@shift_uc_letters_row3 ] };

    my $macron_keyboard 
	= { 'frame-number' => 3,
	    'title' => "Macron keyboard",
	    'keys' => [ \@macron_number_line,
			\@macron_lc_letters_row1,
			\@macron_lc_letters_row2,
			\@macron_lc_letters_row3 ] };
	    
    my $shift_macron_keyboard 
	= { 'frame-number' => 4,
	    'title' => "Shift macron keyboard",
	    'keys' => [ \@shift_macron_punct_line,
			\@shift_macron_uc_letters_row1,
			\@shift_macron_uc_letters_row2,
			\@shift_macron_uc_letters_row3 ] };

    #add background on to this overlay frame.
    my $overlay_frame
	= { 'frame-number' => 5,
	    'title' => "keyboard5",
            'keys' => [] };


    # dynamically add in macron mappings
    foreach my $keyboard ($macron_keyboard, $shift_macron_keyboard) {

	foreach my $row (@{$keyboard->{'keys'}}) {

	    for (my $i = 0; $i<scalar(@$row); $i++) {
		my $letter = $row->[$i];
		if (defined $macron_mapping->{$letter}) {
		    $row->[$i] = $macron_mapping->{$letter};
		}
	    }
	}
    }

    my $main_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0", 'link' => $macron_keyboard };
    my $main_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0", 'link' => $shift_keyboard };
  
    my $macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $main_keyboard };
    my $macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0",       'link' => $shift_macron_keyboard };

    my $shift_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0",       'link' => $shift_macron_keyboard };
    my $shift_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $main_keyboard };

    my $shift_macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $macron_keyboard };
    my $shift_macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $shift_keyboard };

    my $main_spacebar_line         = [ $main_keyboard_press_macron,         @$spacebar_line, $main_keyboard_press_shift         ];
    my $shift_spacebar_line        = [ $shift_keyboard_press_macron,        @$spacebar_line, $shift_keyboard_press_shift        ];
    my $macron_spacebar_line       = [ $macron_keyboard_press_macron,       @$spacebar_line, $macron_keyboard_press_shift       ];
    my $shift_macron_spacebar_line = [ $shift_macron_keyboard_press_macron, @$spacebar_line, $shift_macron_keyboard_press_shift];

    push(@{$main_keyboard->{'keys'}},         $main_spacebar_line);
    push(@{$shift_keyboard->{'keys'}},        $shift_spacebar_line);
    push(@{$macron_keyboard->{'keys'}},       $macron_spacebar_line);
    push(@{$shift_macron_keyboard->{'keys'}}, $shift_macron_spacebar_line);



    foreach my $keyboard ($zero_keyboard,$main_keyboard, $shift_keyboard, $macron_keyboard, $shift_macron_keyboard, $overlay_frame) {
	generate_expeditee_frame($expeditee_frame_io,$keyboard);
	print "-" x 40, "\n";
    }


}


main(@ARGV);