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

Last change on this file since 25056 was 25056, checked in by davidb, 12 years ago

Program to generate the touch screen keyboard in expedtiee
  • Property svn:executable set to *
File size: 16.0 KB
RevLine 
[25056]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 repository browser.