root/gs3-extensions/html-to-expeditee/trunk/src/bin/script/keyboard.pl @ 25077

Revision 25077, 16.7 KB (checked in by davidb, 8 years ago)

Coloured shift and macron buttons

  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# keyboard.pl -- generate a set of Expeditee frames to implement a
6#                touch-screen keyboard
7#
8# A component of the Greenstone digital library software
9# from the New Zealand Digital Library Project at the
10# University of Waikato, New Zealand.
11#
12# Copyright (C) 1999 New Zealand Digital Library Project
13#
14# This program is free software; you can redistribute it and/or modify
15# it under the terms of the GNU General Public License as published by
16# the Free Software Foundation; either version 2 of the License, or
17# (at your option) any later version.
18#
19# This program is distributed in the hope that it will be useful,
20# but WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22# GNU General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with this program; if not, write to the Free Software
26# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
27#
28###########################################################################
29
30BEGIN {
31    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
32    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
33    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
34    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
35    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
36    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugouts");
37
38    if (defined $ENV{'GSDLEXTS'}) {
39    my @extensions = split(/:/,$ENV{'GSDLEXTS'});
40    foreach my $e (@extensions) {
41        my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
42
43        unshift (@INC, "$ext_prefix/perllib");
44        unshift (@INC, "$ext_prefix/perllib/cpan");
45        unshift (@INC, "$ext_prefix/perllib/plugins");
46        unshift (@INC, "$ext_prefix/perllib/plugouts");
47    }
48    }
49    if (defined $ENV{'GSDL3EXTS'}) {
50    my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
51    foreach my $e (@extensions) {
52        my $ext_prefix = "$ENV{'GSDL3SRCHOME'}/ext/$e";
53
54        unshift (@INC, "$ext_prefix/perllib");
55        unshift (@INC, "$ext_prefix/perllib/cpan");
56        unshift (@INC, "$ext_prefix/perllib/plugins");
57        unshift (@INC, "$ext_prefix/perllib/plugouts");
58    }
59    }
60
61    if ((defined $ENV{'DEBUG_UNICODE'}) && (defined $ENV{'DEBUG_UNICODE'})) {
62    binmode(STDERR,":utf8");
63    }
64}
65
66use utf8;
67use strict;
68
69use ExpediteeFrameIO;
70use util;
71
72
73my $default_key_width  = 85;
74my $default_key_height = 85;
75
76my $number_line = [ "`", "1", "2",  "3", "4", "5", "6", "7", "8", "9", "0", "-", "=" ];
77my $punct_line  = [ "~", "!", " \@", "\#", "\$", "\%", "^", "\&", "*", "(", ")", "_", "+" ];
78
79my $lc_letters_row1 = [ "q", "w", "e", "r", "t", "y", "u", "i", "o", "p", "[", "]", "\\" ];
80my $lc_letters_row2 = [ "a", "s", "d", "f", "g", "h", "j", "k", "l", ";", "'" ];
81my $lc_letters_row3 = [ "z", "x", "c", "v", "b", "n", "m", ",", ".", "/", "Bksp" ];
82
83my $uc_letters_row1 = [ "Q", "W", "E", "R", "T", "Y", "U", "I", "O", "P", "{", "}", "|" ];
84my $uc_letters_row2 = [ "A", "S", "D", "F", "G", "H", "J", "K", "L", ":", "\"" ];
85my $uc_letters_row3 = [ "Z", "X", "C", "V", "B", "N", "M", "<", ">", "?", "Bksp" ];
86
87my $spacebar_line = [ { 'label' => "\@Space", 'char' => " " } ];
88#my $backspace_line = [ "Bksp" ];
89
90my $macron_mapping = { 'a' => 'ā',
91               'e' => 'ē',
92               'i' => 'Ä«',
93               'o' => 'ō',
94               'u' => 'Å«',
95               'A' => 'Ā',
96               'E' => 'Ē',
97               'I' => 'Ī',
98               'O' => 'Ō',
99               'U' => 'Ū'  };
100
101my @main_number_line   = @$number_line;
102my @macron_number_line = @$number_line;
103
104my @shift_punct_line        = @$punct_line;
105my @shift_macron_punct_line = @$punct_line;
106
107my @main_lc_letters_row1         = @$lc_letters_row1;
108my @shift_uc_letters_row1        = @$uc_letters_row1;
109my @macron_lc_letters_row1       = @$lc_letters_row1;
110my @shift_macron_uc_letters_row1 = @$uc_letters_row1;
111
112my @main_lc_letters_row2         = @$lc_letters_row2;
113my @shift_uc_letters_row2        = @$uc_letters_row2;
114my @macron_lc_letters_row2       = @$lc_letters_row2;
115my @shift_macron_uc_letters_row2 = @$uc_letters_row2;
116
117my @main_lc_letters_row3         = @$lc_letters_row3;
118my @shift_uc_letters_row3        = @$uc_letters_row3;
119my @macron_lc_letters_row3       = @$lc_letters_row3;
120my @shift_macron_uc_letters_row3 = @$uc_letters_row3;
121
122
123
124sub print_keyboard
125{
126    my ($keyboard) = @_;
127
128    print "Title: $keyboard->{'title'}\n";
129
130    my $keys = $keyboard->{'keys'};
131
132    foreach my $row (@$keys) {
133
134    foreach my $letter_rec (@$row) {
135
136        my $letter_rec_type = ref($letter_rec);
137
138        if ($letter_rec_type eq "") {
139        my $letter = $letter_rec;
140        print " '$letter'";
141        }
142        elsif ($letter_rec_type eq "HASH") {
143        if (defined $letter_rec->{'char'}) {
144            my $label = $letter_rec->{'label'};
145            my $char  = $letter_rec->{'char'};
146            print " $label=>'$char'";
147        }
148        else {
149          # assume we're a linked keyboard
150            my $label = $letter_rec->{'label'};
151            my $goto_keyboard = $letter_rec->{'link'};
152            my $goto_keyboard_title = $goto_keyboard->{'title'};
153           
154            print " ${label}->[$goto_keyboard_title]";
155        }
156        }
157        else {
158        print STDERR "Warning: unrecognized letter record type: $letter_rec_type\n";
159        }
160    }
161    print "\n";
162    }
163   
164}
165
166##
167#
168# Subroutine to add overlay frame to frameset.
169# This frame contains the wooden desktop background,
170# which will display behind the keyboard.
171#
172##
173sub add_overlay_frame
174{
175       my ($expeditee_frame_io) = @_;
176       my $x = 20;
177       my $y = 20;
178       my $linkText = "\@o";
179       my $attr = {};
180
181       $attr->{'F'} = "keyboard5";
182       $expeditee_frame_io->addText($x,$y,$linkText,undef,$attr);
183}
184
185##
186#
187# Subroutine to add wooden desktop background
188# to the back of the keyboard.
189#
190##
191sub add_background
192{
193    my ($expeditee_frame_io) = @_;
194    my $x = 5;
195    my $y = 60;
196    my $bgImg = "\@i: images/backgrounds/wood-keyboard.png";
197
198    $expeditee_frame_io->addText($x,$y,$bgImg,undef,{});
199}
200
201##
202#
203# Subroutine to add search controls. These include
204# the search box, search button and reset button.
205#
206##
207sub add_search_controls
208{
209    my ($expeditee_frame_io) = @_;
210
211    my $x = 20;
212    my $y = 100;   
213
214    #add in search box.
215    my $xr = $x + 600;
216    my $yb = $y + 85;
217   
218    my $searchBoxAttr = {};
219    $searchBoxAttr->{'d'} = "0 0 0";        #set line colour
220    $searchBoxAttr->{'h'} = "2.0";          #set line thickness
221        $searchBoxAttr->{'e'} = "87 76 49";         #set rectangle fill colour
222   
223    $expeditee_frame_io->addRect($x,$y,$xr,$yb,$searchBoxAttr);
224   
225    #add in text to go inside search box.
226    $x += 5;
227    $y += 55;
228    my $searchBoxText = "Search text goes here";
229   
230    my $searchTextAttr = {};
231    $searchTextAttr->{'f'} = "tb30";
232    $searchTextAttr->{'D'} = "search text";
233
234    $expeditee_frame_io->addText($x,$y,$searchBoxText,undef,$searchTextAttr);
235   
236    #add button images for 'Search' button,'Reset' button & 'Constraint Search' button.
237    $x = ($x - 5) + $xr + 10;
238    $y -= 55;               #reset y to original value so buttons align with search box.
239
240    my $textAttr = {};
241    $textAttr->{'X'} = "runFrame";
242    $textAttr->{'x'} = "false";     #set action mark.
243    $textAttr->{'n'} = "false";     #set link mark.
244
245    my $imgBtn = "\@i: images/buttons/search_controls.png";
246    my $width = 145;
247
248        $textAttr->{'F'} = "Keyboard-Actions31";            #link to frame containing Search SIMPLE program.
249
250    $expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);    #add image text annotation to frame.
251   
252    $x += 25;
253    $y += 55;
254   
255    my $searchBtnText = "Search";
256        $textAttr->{'d'} = "100 100 100";               #set text color
257    $expeditee_frame_io->addText($x,$y,$searchBtnText,undef,$textAttr);
258   
259    $x = ($x - 25) + $width + 10;
260    $y -= 55;
261        $textAttr->{'F'} = "Keyboard-Actions12";            #link to frame containing Reset SIMPLE program.
262    $expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);
263   
264    $x += 25;
265    $y += 55;
266   
267    my $resetBtnText = "Reset";
268       
269    $expeditee_frame_io->addText($x,$y,$resetBtnText,undef,$textAttr);
270
271    $x += 160;
272
273    my $constraintsBtnText = "Constraints";
274    $textAttr->{'F'} = "Keyboard-Actions52";            #link to frame containing Constraint Search code.
275    $expeditee_frame_io->addText($x,$y,$constraintsBtnText,undef,$textAttr);
276
277    $x = ($x - 25 - 160) + $width + 10;
278    $y -= 55;
279    $expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);   
280
281}
282
283
284###
285#
286# Subroutine that gets a key and adds it to the keyboard.
287#
288###
289
290sub add_key
291{
292    my ($expeditee_frame_io,$label,$char,$x,$y,$fn) =@_;
293
294    my $imgBtn = "";
295    my $textAttr = {};
296    my $imgBtnAttr = {};
297
298    my $width = 0;
299    my $height = 85;
300
301    $imgBtnAttr->{'X'} = "runFrame";
302    $imgBtnAttr->{'F'} = "Keyboard-Actions7";
303    $imgBtnAttr->{'x'} = "false";           #set action mark
304    $imgBtnAttr->{'n'} = "false";           #set link mark
305
306    $textAttr->{'X'} = "runFrame";
307    $textAttr->{'F'} = "Keyboard-Actions7";
308    $textAttr->{'x'} = "false";             #set action mark
309    $textAttr->{'n'} = "false";             #set link mark
310    $textAttr->{'d'} = "100 100 100";           #set text color
311 
312    #if we are adding in space bar then add the space bar image instead of the usual key button image.
313    if($label eq "\@Space") {
314        $imgBtn = "\@i: images/buttons/key_space.png";
315        $textAttr->{'f'} = "tb48";
316       
317        $width = 420;
318    }
319    #if we are adding in a shift or macron or backspace button then use following image instead.
320    elsif(($label eq "macron") || ($label eq "shift")) {
321                       
322            my $yellowText = "100 84 16";
323        $imgBtn = "\@i: images/buttons/key_special.png";
324
325        $textAttr->{'f'} = "tb32";
326       
327        if($fn == 2 && $label eq "shift") {
328                $textAttr->{'d'} = $yellowText;
329        }
330        elsif($fn == 3 && $label eq "macron") {
331                $textAttr->{'d'} = $yellowText;
332        }
333        elsif($fn == 4) {
334            $textAttr->{'d'} = $yellowText;
335        }
336
337        $width = 145;
338       
339    }
340    elsif($label eq "Bksp") {
341       
342        $imgBtn = "\@i: images/buttons/key_bksp.png";
343        $textAttr ->{'f'} = "tb28";
344        $width = 145;
345    }
346    #otherwise we are just adding in a normal key.
347    else {
348        $imgBtn = "\@i: images/buttons/key_letter.png";
349        $textAttr->{'f'} = "tb48";
350
351#TODO: Change this code so it's much tidier...
352        if(($label eq 'ā') || ($label eq 'ē') || ($label eq 'Ä«') || ($label eq 'ō') || ($label eq 'Å«') || ($label eq 'Ā') || ($label eq 'Ē') || ($label eq 'Ī') || ($label eq 'Ō') || ($label eq 'Ū')) {
353
354            $textAttr->{'d'} = "100 0 0";
355        }
356
357        $width = 85;
358    }
359   
360    $default_key_width = $width;
361    $default_key_height = $height;
362
363    my $xl = $x;
364    my $xr = $xl + $width;
365    my $yt = $y;
366    my $yb = $yt + $height;
367
368    $expeditee_frame_io->addText($xl,$yt,$imgBtn,undef,$imgBtnAttr);    #adds image annotations to frame.
369
370    #used for positioning letters as centre to their keys as possible.
371    if($label eq "macron") {
372    $xl += 10;
373    }
374    elsif($label eq "shift") {
375    $xl += 35;
376    }
377    elsif($label eq "Bksp") {
378    $xl += 50;
379    }
380    else {
381    $xl += 20;
382    }
383
384    $yt += 55;
385
386
387   
388    if ($label =~ m/^ /) {
389    # compensate for any labels that start with a space
390    # (i.e. on the @ key, where a space is needed for Expeditee so it doesn't treat it as an annotation)
391    $xl -= 20;
392    }
393
394    $expeditee_frame_io->addText($xl,$yt,$label,undef,$textAttr);
395
396}
397
398###
399#
400# Subroutine that generates an expeditee frame
401# for each keyboard.
402#
403###
404sub generate_expeditee_frame
405{
406    my ($expeditee_frame_io,$keyboard) = @_;
407
408    my $fn = $keyboard->{'frame-number'};
409    my $keys = $keyboard->{'keys'};
410   
411    my $y = 300;
412    my $offSetX = 0;
413
414    if ($fn != 0 && $fn != 5) {
415
416    add_overlay_frame($expeditee_frame_io);
417    add_search_controls($expeditee_frame_io);
418
419#   add_background($expeditee_frame_io);
420
421    foreach my $row (@$keys) {
422   
423     my $x = 20 + $offSetX;
424         
425     foreach my $letter_rec (@$row) {
426
427         my $letter_rec_type = ref($letter_rec);
428       
429         if ($letter_rec_type eq "") {
430        my $letter = $letter_rec;
431        add_key($expeditee_frame_io,$letter,$letter,$x,$y,$default_key_width,$default_key_height,$fn); 
432                print " $letter ";
433        }
434        elsif ($letter_rec_type eq "HASH") {
435        if (defined $letter_rec->{'char'}) {
436            my $label = $letter_rec->{'label'};
437            my $char  = $letter_rec->{'char'};
438
439            add_key($expeditee_frame_io,$label,$char,$x,$y,$fn);
440
441            print " $label ";
442        }
443        else {
444          # assume we're a linked keyboard
445            my $label = $letter_rec->{'label'};
446            my $goto_keyboard = $letter_rec->{'link'};
447            my $goto_keyboard_title = $goto_keyboard->{'title'};
448
449            add_key($expeditee_frame_io,$label,$label,$x,$y,$fn);
450
451            print " $label ";
452        }
453        }
454        else {
455        print STDERR "Warning: unrecognized letter record type: $letter_rec_type\n";
456        }
457
458        $x += $default_key_width + 5;
459    }
460
461    $y += $default_key_height + 5;
462        $offSetX += 25;
463        print "\n";
464    }
465
466    }
467    elsif($fn == 5) {   #create overlay frame.
468    add_background($expeditee_frame_io);
469
470    }
471
472    if ($expeditee_frame_io->saveFrame("$fn.exp")) {
473   
474    # write out next free frame num
475    $expeditee_frame_io->saveLastFrameNumber($fn);
476    print "Frame $fn written successfully\n";
477    }
478    else {
479    print STDERR "Error writing frame $fn.exp\n";
480    }
481}
482
483
484sub main
485{
486    my (@argv) = @_;
487
488    binmode(STDOUT,":utf8");
489
490    my $home_dir = (defined $ENV{'EXPEDITEE_HOME'}) ? $ENV{'EXPEDITEE_HOME'} : ".";
491    my $output_dir = util::filename_cat($home_dir,"expeditee","framesets","keyboard");
492 
493    if (-e $output_dir) {
494    util::mk_all_dir($output_dir);
495    }
496
497    print "Saving output to directory: $output_dir\n";
498
499    my $expeditee_frame_io = new ExpediteeFrameIO($output_dir);
500
501    #used for creating zero frame - won't actually contain anything.
502    my $zero_keyboard
503    = { 'frame-number' => 0,
504        'title' => "keyboard0",
505        'keys' => [] };
506
507    my $main_keyboard
508    = { 'frame-number' => 1,
509        'title' => "Main keyboard",
510        'keys' => [ \@main_number_line,
511            \@main_lc_letters_row1,
512            \@main_lc_letters_row2,
513            \@main_lc_letters_row3 ] };
514   
515# my @main_lc_letters_row1 = @$lc_letters_row1
516# \@main_lc_letters_row1
517
518    my $shift_keyboard
519    = { 'frame-number' => 2,
520        'title' => "Shift keyboard",
521        'keys' => [ \@shift_punct_line,
522            \@shift_uc_letters_row1,
523            \@shift_uc_letters_row2,
524            \@shift_uc_letters_row3 ] };
525
526    my $macron_keyboard
527    = { 'frame-number' => 3,
528        'title' => "Macron keyboard",
529        'keys' => [ \@macron_number_line,
530            \@macron_lc_letters_row1,
531            \@macron_lc_letters_row2,
532            \@macron_lc_letters_row3 ] };
533       
534    my $shift_macron_keyboard
535    = { 'frame-number' => 4,
536        'title' => "Shift macron keyboard",
537        'keys' => [ \@shift_macron_punct_line,
538            \@shift_macron_uc_letters_row1,
539            \@shift_macron_uc_letters_row2,
540            \@shift_macron_uc_letters_row3 ] };
541
542    #add background on to this overlay frame.
543    my $overlay_frame
544    = { 'frame-number' => 5,
545        'title' => "keyboard5",
546            'keys' => [] };
547
548
549    # dynamically add in macron mappings
550    foreach my $keyboard ($macron_keyboard, $shift_macron_keyboard) {
551
552    foreach my $row (@{$keyboard->{'keys'}}) {
553
554        for (my $i = 0; $i<scalar(@$row); $i++) {
555        my $letter = $row->[$i];
556        if (defined $macron_mapping->{$letter}) {
557            $row->[$i] = $macron_mapping->{$letter};
558        }
559        }
560    }
561    }
562
563    my $main_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0", 'link' => $macron_keyboard };
564    my $main_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0", 'link' => $shift_keyboard };
565 
566    my $macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $main_keyboard };
567    my $macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0",       'link' => $shift_macron_keyboard };
568
569    my $shift_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0",       'link' => $shift_macron_keyboard };
570    my $shift_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $main_keyboard };
571
572    my $shift_macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $macron_keyboard };
573    my $shift_macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $shift_keyboard };
574
575    my $main_spacebar_line         = [ $main_keyboard_press_macron,         @$spacebar_line, $main_keyboard_press_shift         ];
576    my $shift_spacebar_line        = [ $shift_keyboard_press_macron,        @$spacebar_line, $shift_keyboard_press_shift        ];
577    my $macron_spacebar_line       = [ $macron_keyboard_press_macron,       @$spacebar_line, $macron_keyboard_press_shift       ];
578    my $shift_macron_spacebar_line = [ $shift_macron_keyboard_press_macron, @$spacebar_line, $shift_macron_keyboard_press_shift];
579
580    push(@{$main_keyboard->{'keys'}},         $main_spacebar_line);
581    push(@{$shift_keyboard->{'keys'}},        $shift_spacebar_line);
582    push(@{$macron_keyboard->{'keys'}},       $macron_spacebar_line);
583    push(@{$shift_macron_keyboard->{'keys'}}, $shift_macron_spacebar_line);
584
585
586
587    foreach my $keyboard ($zero_keyboard,$main_keyboard, $shift_keyboard, $macron_keyboard, $shift_macron_keyboard, $overlay_frame) {
588    generate_expeditee_frame($expeditee_frame_io,$keyboard);
589    print "-" x 40, "\n";
590    }
591
592
593}
594
595
596main(@ARGV);
Note: See TracBrowser for help on using the browser.