1#                                                         -*- Perl -*-
2# Copyright (c) 2000  Motoyuki Kasahara
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2, or (at your option)
7# any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14
15#
16# ������Ǽ�᤿�ե�������������륯�饹�Τ���δ��쥯�饹
17#
18package FreePWING::BaseUserChar;
19
20require 5.005;
21require Exporter;
22use FileHandle;
23use English;
24use strict;
25use integer;
26
27use vars qw(@ISA
28	    @EXPORT
29	    @EXPORT_OK
30	    $block_length
31	    $start_character_number
32	    $max_character_count);
33
34@ISA = qw(Exporter);
35
36#
37# �֥�å���Ĺ�� (�Х��ȿ�)
38#
39$block_length = 2048;
40
41#
42# �ǽ�˳�����Ƥ�ʸ���ֹ�
43#
44$start_character_number = 0xa121;
45
46#
47# �ǽ�˳�����Ƥ�ʸ���ֹ�
48#
49$max_character_count = 8192;
50
51#
52# ��:
53#	new()
54# �᥽�åɤζ�ʬ:
55# 	public ���饹�᥽�åɡ�
56# ����:
57# 	���������֥������Ȥ��롣
58# �����:
59# 	�����������֥������ȤؤΥ�ե�������֤���
60#
61sub new {
62    my $type = shift;
63    my $new = {
64	# ���������̾�ե�����Υϥ�ɥ�
65	'name_handle' => FileHandle->new(),
66
67	# ��������ե�����̾
68	'name_file_name' => '',
69
70	# �����ι⤵  (16 �� 48 �ɥå�)
71	'bitmap_heights' => [16, 24, 30, 48],
72
73	# ���� (�⤵ 16 �� 48 �ɥå�) ����
74	'bitmap_widths' => [0, 0, 0, 0],
75
76	# ���� (�⤵ 16 �� 48 �ɥå�) �Υӥåȥޥåפξ�������
77	#
78	#   �׻���: (width + 7) / 8 * height
79	#
80	'bitmap_sizes' => [0, 0, 0, 0],
81
82	# ���� (�⤵ 16 �� 48 �ɥå�) �ե�����Υϥ�ɥ�
83	'bitmap_handles' => [FileHandle->new(),
84			     FileHandle->new(),
85			     FileHandle->new(),
86			     FileHandle->new()],
87
88	# ���� (�⤵ 16 �� 48 �ɥå�) �ե�����̾
89	'bitmap_file_names' => ['', '', '', ''],
90
91	# �����Υӥåȥޥåפι⤵�̤μ���
92	'bitmap_height_count' => 0,
93
94	#
95	# ���� (�⤵ 16 �� 48 �ɥå�) �� 1 ����� (1024 �Х���) ��
96	# �˼��ޤ�Ŀ� (= �����������ݤˡ��ͤ�ʪ���Ƽ��Υ֥��
97	# ���˰ܤ�ʤ��Ȥ����ʤ�����)
98	#
99	#   �׻���: 1024 / ((width + 7) / 8 * height)
100	#
101	'bitmap_pad_cycles' => [0, 0, 0, 0],
102
103	#
104	# ���� (�⤵ 16 �� 48 �ɥå�) �������Ȥ��ˡ��ͤ�ʪ��
105	# �Ƽ��Υ�����˰ܤ���ˤ�����ͤ�ʪ�Υ�����
106	#
107	#   �׻���: 1024 % ((width + 7) / 8 * height)
108	#
109	'bitmap_pad_lengths' => [0, 0, 0, 0],
110
111	# ����ޤǤ˽����������ȥ��
112	'character_count' => 0,
113
114	# ��������׵᤬�褿�Ȥ��ˡ�ʸ���˳�����Ƥ�ʸ���ֹ�
115	'character_number' => $start_character_number,
116
117	# �������������̾��
118	'names' => {},
119
120	# ���顼��å�����
121	'error_message' => '',
122    };
123    return bless($new, $type);
124}
125
126#
127# ��:
128#	open(name_file_name, bitmap_16_file_name,
129#	    [bitmap_24_file_name, bitmap_30_file_name, bitmap_48_file_name])
130#           name_file_name
131#		����̾���ե�����̾
132#	    bitmap_16_file_name
133#		���� (�⤵ 16 �ɥå�) �Υӥåȥޥåץե�����̾
134#	    bitmap_24_file_name
135#		���� (�⤵ 24 �ɥå�) �Υӥåȥޥåץե�����̾
136#	    bitmap_30_file_name
137#		���� (�⤵ 30 �ɥå�) �Υӥåȥޥåץե�����̾
138#	    bitmap_48_file_name
139#		���� (�⤵ 48 �ɥå�) �Υӥåȥޥåץե�����̾
140# �᥽�åɤζ�ʬ:
141# 	public ���������᥽�å�
142# ����:
143# 	�������Ѥ˻��Ⱦ���ե����������
144# �����:
145#	��������� 1 ���֤������Ԥ���� 0 ���֤���
146#
147sub open {
148    my $self = shift;
149    my ($name_file_name, @bitmap_file_names) = @ARG;
150    my $i;
151
152    #
153    # ������̾���ե����������
154    #
155    $self->{'name_file_name'} = $name_file_name;
156    if (!$self->{'name_handle'}
157	->open($self->{'name_file_name'}, 'w')) {
158	$self->{'error_message'} = "failed to open the file, $ERRNO: "
159	    . $self->{'name_file_name'};
160	$self->close_internal();
161	return 0;
162    }
163
164    $self->{'bitmap_height_count'} = @bitmap_file_names;
165
166    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
167	#
168	# �����Υӥåȥޥåץե����������
169	#
170	$self->{'bitmap_file_names'}->[$i] = $bitmap_file_names[$i];
171	if (!$self->{'bitmap_handles'}->[$i]
172	    ->open($self->{'bitmap_file_names'}->[$i], 'w')) {
173	    $self->{'error_message'} = "failed to open the file, $ERRNO: "
174		. $self->{'bitmap_file_names'}->[$i];
175	    $self->close_internal();
176	    return 0;
177	}
178	binmode($self->{'bitmap_handles'}->[$i]);
179
180	#
181	# �����Υӥåȥޥåץե�����κǽ�Υ֥�å��� `\0' �����롣
182	#
183	if (!$self->{'bitmap_handles'}->[$i]
184	    ->print("\0" x $block_length)) {
185	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
186		. $self->{'bitmap_file_name'}->[$i];
187	    $self->close_internal();
188	    return 0;
189	}
190    }
191    return 1;
192}
193
194#
195# ��:
196#	close()
197# �᥽�åɤζ�ʬ:
198# 	public ���������᥽�åɡ�
199# ����:
200# 	���Ⱦ���ե�������Ĥ��롣�����Ƥ��ʤ���С����⤷�ʤ���
201# �����:
202#	��� 1 ���֤���
203#
204sub close {
205    my $self = shift;
206    my $data;
207    my $i;
208    my $block_pad;
209
210    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
211	#
212	# �֥�å��������ޤ� "\0" ������ࡣ
213	#
214	$block_pad = $block_length
215	    - $self->{'bitmap_handles'}->[$i]->tell() % $block_length;
216	if ($block_pad < $block_length
217	    && !$self->{'bitmap_handles'}->[$i]->print("\0" x $block_pad)) {
218	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
219		. $self->{'bitmap_file_names'}->[$i];
220	    $self->close_internal();
221	    return 0;
222	}
223
224	#
225	# �����Υӥåȥޥåץե��������Ƭ��������Ƥξ��������ࡣ
226	#
227	if (!$self->{'bitmap_handles'}->[$i]->seek(0, FileHandle->SEEK_SET)) {
228	    $self->{'error_message'} = "failed to seek the file, $ERRNO: "
229		. $self->{'bitmap_file_names'}->[$i];
230	}
231	$data = pack("C8 CC n n C2", 1, 0, 0, 0, 0, 0, 0, 0,
232		     $self->{'bitmap_widths'}->[$i],
233		     $self->{'bitmap_heights'}->[$i],
234		     $start_character_number,
235		     $self->{'character_count'},
236		     0, 0);
237	if (!$self->{'bitmap_handles'}->[$i]->print($data)) {
238	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
239		. $self->{'bitmap_file_names'}->[$i];
240	    $self->close_internal();
241	    return 0;
242	}
243    }
244
245    #
246    # �����Υӥåȥޥåץե�������Ĥ��롣
247    #
248    $self->close_internal();
249    return 1;
250}
251
252#
253# ��:
254#	close_internal()
255# �᥽�åɤζ�ʬ:
256# 	private ���������᥽�åɡ�
257# ����:
258#	close() �����������ѥ᥽�åɡ�
259#
260sub close_internal {
261    my $self = shift;
262    my $i;
263
264    #
265    # ������̾���ե�������Ĥ��롣
266    #
267    if ($self->{'name_handle'}->fileno()) {
268	$self->{'name_handle'}->close();
269    }
270
271    #
272    # �����Υӥåȥޥåץե�������Ĥ��롣
273    #
274    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
275	$self->{'bitmap_handles'}->[$i]->close();
276    }
277}
278
279#
280# ��:
281#	add_character(name, [xbm_16_file_name, xbm_24_file_name,
282#	    xbm_30_file_name, xbm_48_file_name])
283#           name
284#		������̾��
285#	    xbm_16_file_name
286#		���� (�⤵ 16 �ɥå�) �� XBM �ӥåȥޥåץե�����̾
287#	    xbm_24_file_name
288#		���� (�⤵ 24 �ɥå�) �� XBM �ӥåȥޥåץե�����̾
289#	    xbm_30_file_name
290#		���� (�⤵ 30 �ɥå�) �� XBM �ӥåȥޥåץե�����̾
291#	    xbm_48_file_name
292#		���� (�⤵ 48 �ɥå�) �� XBM �ӥåȥޥåץե�����̾
293# �᥽�åɤζ�ʬ:
294# 	public ���������᥽�åɡ�
295# ����:
296# 	���Ⱦ���ե�����˥֥�å����ȥ���ȥ�����ɲä��롣
297# �����:
298#	��������� 1 ���֤������Ԥ���� 0 ���֤���
299#
300sub add_character {
301    my $self = shift;
302    my ($name, @xbm_file_names) = @ARG;
303    my ($width, $height, $bitmap);
304    my $i;
305
306    #
307    # ��������Ͽʸ�������ǧ���롣
308    #
309    if ($max_character_count <= $self->{'character_count'}) {
310	$self->{'error_message'} = "define too many characters";
311	$self->close_internal();
312	return 0;
313    }
314
315    #
316    # ���ˤ���̾������ij�������Ͽ����Ƥ��뤫Ĵ�٤롣
317    #
318    if (defined($self->{'name'}->{$name})) {
319	$self->{'error_message'} = "character name has already been defined: "
320	    . $name;
321	$self->close_internal();
322	return 0;
323    }
324
325    #
326    # ̾���ե�����ˤ��γ��������������ࡣ
327    #
328    if (!$self->{'name_handle'}
329	->printf("%s\t%04x\n", $name, $self->{'character_number'})) {
330	$self->{'error_message'} = "failed to write the file, $ERRNO: "
331	    . $self->{'name_file_name'};
332	$self->close_internal();
333	return 0;
334    }
335
336    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
337	if (!defined($xbm_file_names[$i])) {
338	    $self->{'error_message'} =
339		sprintf("bitmap file (height=%s) not specified",
340			$self->{'bitmap_heights'}->[$i]);
341	    $self->close_internal();
342	    return 0;
343	}
344
345	#
346	# ������ XBM �ե�������ɤ߹��ࡣ
347	#
348	($width, $height, $bitmap) = $self->read_xbm_file($xbm_file_names[$i]);
349	if (!defined($bitmap)) {
350	    $self->close_internal();
351	    return 0;
352	}
353	if ($width != $self->{'bitmap_widths'}->[$i]
354	    || $height != $self->{'bitmap_heights'}->[$i]) {
355	    $self->{'error_message'} = "XBM file has incorrect size: "
356		. $xbm_file_names[$i];
357	    $self->close_internal();
358	    return 0;
359	}
360
361	#
362	# �����Υӥåȥޥåפ�����ࡣ
363	#
364	if (!$self->{'bitmap_handles'}->[$i]->print($bitmap)) {
365	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
366		. $self->{'bitmap_file_names'}->[$i];
367	    $self->close_internal();
368	    return 0;
369	}
370
371	#
372	# �֥�å��������ն����Ƥ�����ϡ��Ĥ�� "\0" �����Ƽ���
373	# �֥�å��˰ܤ롣
374	#
375	if (($self->{'character_count'} + 1)
376	    % $self->{'bitmap_pad_cycles'}->[$i] == 0) {
377	    if (!$self->{'bitmap_handles'}->[$i]
378		->print("\0" x $self->{'bitmap_pad_lengths'}->[$i])) {
379		$self->{'error_message'} = "failed to write the file, $ERRNO: "
380		    . $self->{'bitmap_file_names'}->[$i];
381		$self->close_internal();
382		return 0;
383	    }
384	}
385    }
386
387
388    $self->{'name'}->{$name} = 1;
389    $self->{'character_count'}++;
390    if (($self->{'character_number'} & 0x7f) == 0x7e) {
391	$self->{'character_number'} += 0xa3;
392    } else {
393	$self->{'character_number'}++;
394    }
395    return 1;
396}
397
398#
399# ��:
400#	read_xbm_file(file_name)
401#	    file_name
402#		�ɤ߹��� XBM �ե�����̾
403# �᥽�åɤζ�ʬ:
404# 	private ���������᥽�åɡ�
405# ����:
406#	XBM �ե�������ɤ߹��ࡣ
407# �����:
408#	���������Ȥ��ϡ����� 3 �Ĥ����Ǥ��ν�����¤٤��ꥹ�Ȥ��֤���
409#	    1. �ӥåȥޥåץǡ��������Υɥåȿ�
410#	    2. �ӥåȥޥåץǡ����ι⤵�Υɥåȿ�
411#           3. �ӥåȥޥåץǡ�����pack("C*") �dzƥХ��Ȥ�ͤ᤿��Ρ�
412#       ���Ԥ����Ȥ��ϡ�undef ���֤���
413# ����:
414#	X11R6.3 �� Xmu/RdBitF.c �� XmuReadBitmapData() ���ͤˤ�����
415#
416sub read_xbm_file {
417    my $self = shift;
418    my ($file_name) = @ARG;
419
420    #
421    # XBM �ե����������
422    #
423    my $handle = FileHandle->new();
424    if (!$handle->open($file_name, 'r')) {
425        $self->{'error_message'} =
426            "failed to open the file, $ERRNO: $file_name";
427        return;
428    }
429
430    #
431    # XBM ����ե�������ñ�̤��ɤ߹��ࡣ
432    # "bits[] = {" �ιԤ˽в��ޤǷ����֤���
433    #
434    my $line;
435    my ($name, $value);
436    my ($width, $height) = (0, 0);
437    for (;;) {
438        $line = $handle->getline();
439        if (!defined($line)) {
440	    $handle->close();
441	    $self->{'error_message'} = "broken XBM file: $file_name";
442            return;
443        }
444
445	if ($line =~ /^\#define[ \t]+(\S+)[ \t]+([0-9]+)/) {
446	    #
447	    # "#define ...." �ǻϤޤ�ԡ�
448	    #
449	    $name = $1;
450	    $value = $2;
451	    if ($name eq 'width' || $name =~ /_width$/) {
452		$width = $value;
453	    } elsif ($name eq 'height' || $name =~ /_height$/) {
454		$height = $value;
455	    }
456	} elsif ($line =~ /static[ \t]+char[ \t]+(\S+)[ \t]+=[ \t]+\{/) {
457	    #
458	    # "static char ...." �ǻϤޤ�ԡ�
459	    #
460	    $name = $1;
461	    if ($name eq 'bits[]' || $name =~ /_bits\[\]$/) {
462		last;
463	    }
464	} elsif ($line =~ /static unsigned char (\S+) = \{/) {
465	    #
466	    # "static unsigned char ...." �ǻϤޤ�ԡ�
467	    #
468	    $name = $1;
469	    if ($name eq 'bits[]' || $name =~ /_bits\[\]$/) {
470		last;
471	    }
472	}
473    }
474
475    #
476    # width, height ��������ʤ���Х��顼��
477    #
478    if ($width == 0 || $height == 0) {
479	$handle->close();
480	$self->{'error_message'} = "broken XBM file: $file_name";
481	return;
482    }
483
484    #
485    # �ӥåȥޥåפ� 16 �ʿ���ʬ�� 1 ʸ��ñ�̤��ɤ߹��ࡣ
486    #
487    my @values = ();
488    my $current_value = 0;
489    my $size = ($width + 7) / 8 * $height;
490    my $gotone = 0;
491    my $i = 0;
492    my $c;
493    while ($i < $size) {
494        $c = $handle->getc();
495        if ($c eq '') {
496	    #
497	    # ͽ�����Ƥ��ʤ� EOF
498	    #
499	    $handle->close();
500	    $self->{'error_message'} = "broken XBM file: $file_name";
501            return;
502        } elsif ($c =~ /^[0-9A-Fa-f]$/) {
503	    #
504	    # 16 �ʿ�����
505	    #
506	    $current_value = ($current_value << 4) + hex($c);
507	    $gotone++;
508	} elsif ($c =~ /^[ ,\}\t\n]$/ && $gotone) {
509	    #
510	    # 16 �ʿ����� 1 ���ʾ��ɤ߹������ζ��ڤ�ʸ����
511	    # 16 �ʿ��������ͤ��Ѵ������ӥåȤ��¤Ӥ��� (MSB �� LSB)
512	    # ���ž�����Ƥ��� @values �˵�Ͽ���롣
513	    #
514	    $values[$i] = 0;
515	    $values[$i] |= 0x80 if (($current_value & 0x01) != 0);
516	    $values[$i] |= 0x40 if (($current_value & 0x02) != 0);
517	    $values[$i] |= 0x20 if (($current_value & 0x04) != 0);
518	    $values[$i] |= 0x10 if (($current_value & 0x08) != 0);
519	    $values[$i] |= 0x08 if (($current_value & 0x10) != 0);
520	    $values[$i] |= 0x04 if (($current_value & 0x20) != 0);
521	    $values[$i] |= 0x02 if (($current_value & 0x40) != 0);
522	    $values[$i] |= 0x01 if (($current_value & 0x80) != 0);
523	    $current_value = 0;
524	    $gotone = 0;
525	    $i++;
526	}
527    }
528
529    #
530    # XBM �ե�������Ĥ��롣
531    #
532    $handle->close();
533
534    return ($width, $height, pack("C*", @values));
535}
536
537######################################################################
538# <���������ѿ����ͤ��֤��᥽�åɷ�>
539#
540# ��:
541#	���������ѿ�̾()
542# �᥽�åɤζ�ʬ:
543# 	public ���������᥽�åɡ�
544# �����:
545#	���������ѿ����ͤ��֤���
546#
547sub name_file_name {
548    my $self = shift;
549    return $self->{'name_file_name'};
550}
551sub bitmap_file_name {
552    my $self = shift;
553    my ($height) = @ARG;
554    return $self->{'bitmap_file_name'}->{$height};
555}
556sub character_count {
557    my $self = shift;
558    return $self->{'character_count'};
559}
560sub character_number {
561    my $self = shift;
562    return $self->{'character_number'};
563}
564sub error_message {
565    my $self = shift;
566    return $self->{'error_message'};
567}
568
5691;
570