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

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

Coloured shift and macron buttons
  • Property svn:executable set to *
File size: 16.7 KB
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 repository browser.