1#!/usr/bin/perl -w
2
3# converts from ktouch's OLD .ktouch (<<1.6) to gtypist's .typ-file
4# send comments and suggestions to bug-gtypist@gnu.org
5
6# This program is free software; you can redistribute it and/or
7# modify it under the terms of the GNU General Public License
8# as published by the Free Software Foundation, either version 3
9# of the License, or (at your option) any later version.
10#
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with this program; if not, write to the Free Software
18# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
20use strict qw(subs vars refs);
21use Cwd; # Cwd::getcwd
22use gtypist;
23
24# configurable variables
25my $lines_per_drill = 4; # 1-11 for [Dd]: and D:, 1-22 for [Ss]:
26my $drill_type = "D:"; # [DdSs]
27
28
29my $ktouchfilename = undef;
30my $typfilename = undef;
31my $KTOUCHFILE = undef;
32my $TYPFILE = undef;
33
34# some sanity checks
35if ($lines_per_drill < 1) {
36    die "Invalid lines_per_drill: $lines_per_drill\n";
37}
38if ($drill_type eq "D:" || $drill_type eq "d:") {
39    if ($lines_per_drill > 11) {
40	die "Invalid lines_per_drill for [Dd]:: $lines_per_drill\n";
41    }
42} else {
43    if ($drill_type ne "S:" && $drill_type ne "s:") {
44	die "Invalid drill_type: $drill_type\n";
45    }
46    if ($lines_per_drill > 22) {
47	die "Invalid lines_per_drill for [Ss]:: $lines_per_drill\n";
48    }
49}
50
51# this reads from KTOUCHFILE until it finds a blank line or a comment
52sub convert_lesson($**)
53{
54    my $lesson_counter = shift;
55    my $ktouchfile = shift;
56    my $typfile = shift;
57    my $line = undef;
58    my $line_counter = 0;
59    my $drill_counter = 1;
60
61    while (defined($line = <$ktouchfile>) && !isBlankorComment($line))
62    {
63	chomp($line);
64	if ($line_counter == 0) {
65	    print $typfile "*:LESSON${lesson_counter}_D$drill_counter\n";
66	    print $typfile "I:($drill_counter)\n";
67	    print $typfile "${drill_type}$line\n";
68	} else {
69	    print $typfile " :$line\n";
70	}
71
72	++$line_counter;
73	if ($line_counter == $lines_per_drill) {
74# this is not necessary any more: it's implied in D:
75#	    print $typfile
76#		"Q: Press Y to continue, N to repeat, or Fkey 12 to exit\n";
77#	    print $typfile "N:LESSON${lesson_counter}_D$drill_counter\n";
78	    $line_counter = 0; ++$drill_counter;
79	}
80    }
81# this is not necessary any more: it's implied in D:
82#   print $typfile "Q: Press Y to continue, N to repeat, or Fkey 12 to exit\n";
83#    print $typfile "N:LESSON${lesson_counter}_D$drill_counter\n";
84}
85
86
87while(defined($ktouchfilename = shift(@ARGV)))
88{
89    if (substr($ktouchfilename, rindex($ktouchfilename, ".")) ne ".ktouch" ||
90	! (-f $ktouchfilename)) {
91	print "Skipping $ktouchfilename.\n";
92	next;
93    }
94    $typfilename = $ktouchfilename;
95    substr($typfilename, rindex($typfilename, ".")) = ".typ";
96    print "Converting $ktouchfilename to $typfilename...\n";
97
98    open(KTOUCHFILE, "$ktouchfilename") ||
99	die "Couldn't open $ktouchfilename for reading: $!";
100    open(TYPFILE, ">$typfilename") ||
101	die "Couldn't open $typfilename for writing: $!";
102
103    print TYPFILE "# created by ktouch2typ.pl from " .
104	getAbsoluteFilename($ktouchfilename) . "\n# on " . `date`;
105    print TYPFILE "# ktouch2typ.pl is part of gtypist (http://www.gnu.org/software/gtypist/)\n";
106    print TYPFILE "# ktouch can be found at http://ktouch.sourceforge.net\n";
107    print TYPFILE "# If you have suggestions about these lessons,\n";
108    print TYPFILE "# please send mail to haavard\@users.sourceforge.net\n";
109    print TYPFILE "# (or whoever is the current ktouch maintainer), with\n";
110    print TYPFILE "# cc to bug-gtypist\@gnu.org\n\n";
111    print TYPFILE "G:MENU\n\n";
112
113    my $line = undef;
114    my $done = 0;
115    my $lesson_counter = 1;
116    my @lesson_names = (); # this is needed for the menu
117    while (!$done)
118    {
119	while (defined($line = <KTOUCHFILE>) && isBlankorComment($line)) {
120	    if (isComment($line)) {
121		# make sure that '#' is at the beginning of the line
122		$line =~ s/^\s*//;
123		print TYPFILE $line;
124	    }
125	}
126	if (!defined($line)) { $done = 1; next;	}
127
128	print TYPFILE "*:S_LESSON$lesson_counter\n";
129	print TYPFILE "K:12:MENU\n";
130	# $line contains the first non-blank, non-comment line (which is the
131	# name of the lesson)
132	chomp($line);
133	$lesson_names[$lesson_counter] = $line;
134	print TYPFILE getBanner("Lesson $lesson_counter: " . $line);
135
136	convert_lesson($lesson_counter, \*KTOUCHFILE, \*TYPFILE);
137
138	print TYPFILE "G:E_LESSON$lesson_counter\n\n";
139
140	if (!defined($line)) {
141	    $done = 1;
142	}
143	++$lesson_counter;
144    }
145
146    --$lesson_counter;
147
148    generate_jump_table($lesson_counter, \*TYPFILE);
149    generate_menu("ktouch lesson ($ktouchfilename)",
150		  $lesson_counter, \*TYPFILE, @lesson_names);
151
152    close(TYPFILE) || die "Couldn't close $typfilename: $!";
153    close(KTOUCHFILE) || die "Couldn't close $ktouchfilename: $!";
154}
155
156
157
158# Local Variables:
159# compile-command: "./ktouch2typ.pl german.ktouch norwegian.ktouch g.ktouch"
160# End:
161