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

Revision 25056, 16.0 KB (checked in by davidb, 8 years ago)

Program to generate the touch screen keyboard in expedtiee

  • 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 $textAttr = {};
231    $textAttr->{'f'} = "tb30";
232
233    $expeditee_frame_io->addText($x,$y,$searchBoxText,undef,$textAttr);
234   
235    #add button images for 'Search' button and 'Reset' button.
236    $x = ($x - 5) + $xr + 10;
237    $y -= 55;               #reset y to original value so buttons align with search box.
238
239    $textAttr->{'X'} = "runFrame";
240    $textAttr->{'x'} = "false";     #set action mark.
241    $textAttr->{'n'} = "false";     #set link mark.
242
243    my $imgBtn = "\@i: images/buttons/search_controls.png";
244    my $width = 145;
245
246        $textAttr->{'F'} = "Keyboard-Actions31";            #link to frame containing Search SIMPLE program.
247
248    $expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);    #add image text annotation to frame.
249   
250    $x += 25;
251    $y += 55;
252   
253    my $searchBtnText = "Search";
254        $textAttr->{'d'} = "100 100 100";           #set text color
255    $expeditee_frame_io->addText($x,$y,$searchBtnText,undef,$textAttr);
256   
257    $x = ($x - 25) + $width + 10;
258    $y -= 55;
259        $textAttr->{'F'} = "Keyboard-Actions12";            #link to frame containing Reset SIMPLE program.
260    $expeditee_frame_io->addText($x,$y,$imgBtn,undef,$textAttr);
261   
262    $x += 25;
263    $y += 55;
264   
265    my $resetBtnText = "Reset";
266       
267    $expeditee_frame_io->addText($x,$y,$resetBtnText,undef,$textAttr); 
268
269}
270
271
272###
273#
274# Subroutine that gets a key and adds it to the keyboard.
275#
276###
277
278sub add_key
279{
280    my ($expeditee_frame_io,$label,$char,$x,$y) =@_;
281
282    my $imgBtn = "";
283    my $textAttr = {};
284    my $imgBtnAttr = {};
285
286    my $width = 0;
287    my $height = 85;
288
289    $imgBtnAttr->{'X'} = "runFrame";
290    $imgBtnAttr->{'F'} = "Keyboard-Actions7";
291    $imgBtnAttr->{'x'} = "false";           #set action mark
292    $imgBtnAttr->{'n'} = "false";           #set link mark
293
294    $textAttr->{'X'} = "runFrame";
295    $textAttr->{'F'} = "Keyboard-Actions7";
296    $textAttr->{'x'} = "false";             #set action mark
297    $textAttr->{'n'} = "false";             #set link mark
298    $textAttr->{'d'} = "100 100 100";           #set text color
299 
300    #if we are adding in space bar then add the space bar image instead of the usual key button image.
301    if($label eq "\@Space") {
302        $imgBtn = "\@i: images/buttons/key_space.png";
303        $textAttr->{'f'} = "tb48";
304       
305        $width = 420;
306    }
307    #if we are adding in a shift or macron or backspace button then use following image instead.
308    elsif(($label eq "macron") || ($label eq "shift")) {
309                       
310         
311        $imgBtn = "\@i: images/buttons/key_special.png";
312
313        $textAttr->{'f'} = "tb32";
314        $width = 145;
315       
316    }
317    elsif($label eq "Bksp"){
318       
319        $imgBtn = "\@i: images/buttons/key_bksp.png";
320        $textAttr ->{'f'} = "tb28";
321        $width = 145;
322    }
323    #otherwise we are just adding in a normal key.
324    else {
325        $imgBtn = "\@i: images/buttons/key_letter.png";
326        $textAttr->{'f'} = "tb48";
327
328#TODO: Change this code so it's much tidier...
329        if(($label eq 'ā') || ($label eq 'ē') || ($label eq 'Ä«') || ($label eq 'ō') || ($label eq 'Å«') || ($label eq 'Ā') || ($label eq 'Ē') || ($label eq 'Ī') || ($label eq 'Ō') || ($label eq 'Ū')) {
330
331            $textAttr->{'d'} = "100 0 0";
332        }
333
334        $width = 85;
335    }
336   
337    $default_key_width = $width;
338    $default_key_height = $height;
339
340    my $xl = $x;
341    my $xr = $xl + $width;
342    my $yt = $y;
343    my $yb = $yt + $height;
344
345    $expeditee_frame_io->addText($xl,$yt,$imgBtn,undef,$imgBtnAttr);    #adds image annotations to frame.
346
347    #used for positioning letters as centre to their keys as possible.
348    if($label eq "macron") {
349    $xl += 10;
350        $yt += 55;
351    }
352    elsif($label eq "shift") {
353    $xl += 35;
354        $yt += 55;
355    }
356    elsif($label eq "Bksp") {
357    $xl += 55;
358        $yt += 50;
359    }
360    else {
361    $xl += 20;
362        $yt += 55;
363    }
364
365
366
367
368   
369    if ($label =~ m/^ /) {
370    # compensate for any labels that start with a space
371    # (i.e. on the @ key, where a space is needed for Expeditee so it doesn't treat it as an annotation)
372    $xl -= 20;
373    }
374
375    $expeditee_frame_io->addText($xl,$yt,$label,undef,$textAttr);
376
377}
378
379###
380#
381# Subroutine that generates an expeditee frame
382# for each keyboard.
383#
384###
385sub generate_expeditee_frame
386{
387    my ($expeditee_frame_io,$keyboard) = @_;
388
389    my $fn = $keyboard->{'frame-number'};
390    my $keys = $keyboard->{'keys'};
391   
392    my $y = 300;
393    my $offSetX = 0;
394
395    if ($fn != 0 && $fn != 5) {
396
397    add_overlay_frame($expeditee_frame_io);
398    add_search_controls($expeditee_frame_io);
399
400#   add_background($expeditee_frame_io);
401
402    foreach my $row (@$keys) {
403   
404     my $x = 20 + $offSetX;
405         
406     foreach my $letter_rec (@$row) {
407
408         my $letter_rec_type = ref($letter_rec);
409       
410         if ($letter_rec_type eq "") {
411        my $letter = $letter_rec;
412        add_key($expeditee_frame_io,$letter,$letter,$x,$y,$default_key_width,$default_key_height); 
413                print " $letter ";
414        }
415        elsif ($letter_rec_type eq "HASH") {
416        if (defined $letter_rec->{'char'}) {
417            my $label = $letter_rec->{'label'};
418            my $char  = $letter_rec->{'char'};
419
420            add_key($expeditee_frame_io,$label,$char,$x,$y);
421
422            print " $label ";
423        }
424        else {
425          # assume we're a linked keyboard
426            my $label = $letter_rec->{'label'};
427            my $goto_keyboard = $letter_rec->{'link'};
428            my $goto_keyboard_title = $goto_keyboard->{'title'};
429
430            add_key($expeditee_frame_io,$label,$label,$x,$y);
431
432            print " $label ";
433        }
434        }
435        else {
436        print STDERR "Warning: unrecognized letter record type: $letter_rec_type\n";
437        }
438
439        $x += $default_key_width + 5;
440    }
441
442    $y += $default_key_height + 5;
443        $offSetX += 25;
444        print "\n";
445    }
446
447    }
448    elsif($fn == 5) {   #create overlay frame.
449    add_background($expeditee_frame_io);
450
451    }
452
453    if ($expeditee_frame_io->saveFrame("$fn.exp")) {
454   
455    # write out next free frame num
456    $expeditee_frame_io->saveLastFrameNumber($fn);
457    print "Frame $fn written successfully\n";
458    }
459    else {
460    print STDERR "Error writing frame $fn.exp\n";
461    }
462}
463
464
465sub main
466{
467    my (@argv) = @_;
468
469    binmode(STDOUT,":utf8");
470
471    my $home_dir = (defined $ENV{'EXPEDITEE_HOME'}) ? $ENV{'EXPEDITEE_HOME'} : ".";
472    my $output_dir = util::filename_cat($home_dir,"expeditee","framesets","keyboard");
473 
474    if (-e $output_dir) {
475    util::mk_all_dir($output_dir);
476    }
477
478    print "Saving output to directory: $output_dir\n";
479
480    my $expeditee_frame_io = new ExpediteeFrameIO($output_dir);
481
482    #used for creating zero frame - won't actually contain anything.
483    my $zero_keyboard
484    = { 'frame-number' => 0,
485        'title' => "keyboard0",
486        'keys' => [] };
487
488    my $main_keyboard
489    = { 'frame-number' => 1,
490        'title' => "Main keyboard",
491        'keys' => [ \@main_number_line,
492            \@main_lc_letters_row1,
493            \@main_lc_letters_row2,
494            \@main_lc_letters_row3 ] };
495   
496# my @main_lc_letters_row1 = @$lc_letters_row1
497# \@main_lc_letters_row1
498
499    my $shift_keyboard
500    = { 'frame-number' => 2,
501        'title' => "Shift keyboard",
502        'keys' => [ \@shift_punct_line,
503            \@shift_uc_letters_row1,
504            \@shift_uc_letters_row2,
505            \@shift_uc_letters_row3 ] };
506
507    my $macron_keyboard
508    = { 'frame-number' => 3,
509        'title' => "Macron keyboard",
510        'keys' => [ \@macron_number_line,
511            \@macron_lc_letters_row1,
512            \@macron_lc_letters_row2,
513            \@macron_lc_letters_row3 ] };
514       
515    my $shift_macron_keyboard
516    = { 'frame-number' => 4,
517        'title' => "Shift macron keyboard",
518        'keys' => [ \@shift_macron_punct_line,
519            \@shift_macron_uc_letters_row1,
520            \@shift_macron_uc_letters_row2,
521            \@shift_macron_uc_letters_row3 ] };
522
523    #add background on to this overlay frame.
524    my $overlay_frame
525    = { 'frame-number' => 5,
526        'title' => "keyboard5",
527            'keys' => [] };
528
529
530    # dynamically add in macron mappings
531    foreach my $keyboard ($macron_keyboard, $shift_macron_keyboard) {
532
533    foreach my $row (@{$keyboard->{'keys'}}) {
534
535        for (my $i = 0; $i<scalar(@$row); $i++) {
536        my $letter = $row->[$i];
537        if (defined $macron_mapping->{$letter}) {
538            $row->[$i] = $macron_mapping->{$letter};
539        }
540        }
541    }
542    }
543
544    my $main_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0", 'link' => $macron_keyboard };
545    my $main_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0", 'link' => $shift_keyboard };
546 
547    my $macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $main_keyboard };
548    my $macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "0 0 0",       'link' => $shift_macron_keyboard };
549
550    my $shift_keyboard_press_macron = { 'label' => "macron", 'color' => "0 0 0",       'link' => $shift_macron_keyboard };
551    my $shift_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $main_keyboard };
552
553    my $shift_macron_keyboard_press_macron = { 'label' => "macron", 'color' => "100 100 100", 'link' => $macron_keyboard };
554    my $shift_macron_keyboard_press_shift  = { 'label' => "shift",  'color' => "100 100 100", 'link' => $shift_keyboard };
555
556    my $main_spacebar_line         = [ $main_keyboard_press_macron,         @$spacebar_line, $main_keyboard_press_shift         ];
557    my $shift_spacebar_line        = [ $shift_keyboard_press_macron,        @$spacebar_line, $shift_keyboard_press_shift        ];
558    my $macron_spacebar_line       = [ $macron_keyboard_press_macron,       @$spacebar_line, $macron_keyboard_press_shift       ];
559    my $shift_macron_spacebar_line = [ $shift_macron_keyboard_press_macron, @$spacebar_line, $shift_macron_keyboard_press_shift];
560
561    push(@{$main_keyboard->{'keys'}},         $main_spacebar_line);
562    push(@{$shift_keyboard->{'keys'}},        $shift_spacebar_line);
563    push(@{$macron_keyboard->{'keys'}},       $macron_spacebar_line);
564    push(@{$shift_macron_keyboard->{'keys'}}, $shift_macron_spacebar_line);
565
566
567
568    foreach my $keyboard ($zero_keyboard,$main_keyboard, $shift_keyboard, $macron_keyboard, $shift_macron_keyboard, $overlay_frame) {
569    generate_expeditee_frame($expeditee_frame_io,$keyboard);
570    print "-" x 40, "\n";
571    }
572
573
574}
575
576
577main(@ARGV);
Note: See TracBrowser for help on using the browser.