#                                                         -*- Perl -*-
# Copyright (c) 2000  Motoyuki Kasahara
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#

#
# 外字を納めたファイルを生成するクラスのための基底クラス
#
package FreePWING::BaseUserChar;

require 5.005;
require Exporter;
use FileHandle;
use English;
use strict;
use integer;

use vars qw(@ISA
	    @EXPORT
	    @EXPORT_OK
	    $block_length
	    $start_character_number
	    $max_character_count);

@ISA = qw(Exporter);

#
# ブロックの長さ (バイト数)
#
$block_length = 2048;

#
# 最初に割り当てる文字番号
#
$start_character_number = 0xa121;

#
# 最初に割り当てる文字番号
#
$max_character_count = 8192;

#
# 書式:
#	new()
# メソッドの区分:
# 	public クラスメソッド。
# 説明:
# 	新しいオブジェクトを作る。
# 戻り値:
# 	作成したオブジェクトへのリファレンスを返す。
#
sub new {
    my $type = shift;
    my $new = {
	# 外字の定義名ファイルのハンドラ
	'name_handle' => FileHandle->new(),

	# 外字定義ファイル名
	'name_file_name' => '',

	# 外字の高さ  (16 〜 48 ドット) 
	'bitmap_heights' => [16, 24, 30, 48],

	# 外字 (高さ 16 〜 48 ドット) の幅
	'bitmap_widths' => [0, 0, 0, 0],

	# 外字 (高さ 16 〜 48 ドット) のビットマップの消費サイズ
	#
	#   計算式: (width + 7) / 8 * height
	#
	'bitmap_sizes' => [0, 0, 0, 0],

	# 外字 (高さ 16 〜 48 ドット) ファイルのハンドラ
	'bitmap_handles' => [FileHandle->new(),
			     FileHandle->new(),
			     FileHandle->new(),
			     FileHandle->new()],

	# 外字 (高さ 16 〜 48 ドット) ファイル名
	'bitmap_file_names' => ['', '', '', ''],

	# 外字のビットマップの高さ別の種類
	'bitmap_height_count' => 0,

	#
	# 外字 (高さ 16 〜 48 ドット) が 1 チャンク (1024 バイト) 内
	# に収まる個数 (= 外字を書き込む際に、詰め物をして次のブロッ
	# クに移らないといけない周期)
	#
	#   計算式: 1024 / ((width + 7) / 8 * height)
	#
	'bitmap_pad_cycles' => [0, 0, 0, 0],

	#
	# 外字 (高さ 16 〜 48 ドット) を書き込むときに、詰め物をし
	# て次のチャンクに移る場合における詰め物のサイズ
	#
	#   計算式: 1024 % ((width + 7) / 8 * height)
	#
	'bitmap_pad_lengths' => [0, 0, 0, 0],

	# これまでに書き込んだエントリ数
	'character_count' => 0,

	# 次に定義要求が来たときに、文字に割り当てる文字番号
	'character_number' => $start_character_number,

	# 定義した外字の名前
	'names' => {},

	# エラーメッセージ
	'error_message' => '',
    };
    return bless($new, $type);
}

#
# 書式:
#	open(name_file_name, bitmap_16_file_name,
#	    [bitmap_24_file_name, bitmap_30_file_name, bitmap_48_file_name])
#           name_file_name
#		外字名前ファイル名
#	    bitmap_16_file_name
#		外字 (高さ 16 ドット) のビットマップファイル名
#	    bitmap_24_file_name
#		外字 (高さ 24 ドット) のビットマップファイル名
#	    bitmap_30_file_name
#		外字 (高さ 30 ドット) のビットマップファイル名
#	    bitmap_48_file_name
#		外字 (高さ 48 ドット) のビットマップファイル名
# メソッドの区分:
# 	public インスタンスメソッド
# 説明:
# 	書き込み用に参照情報ファイルを開く。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub open {
    my $self = shift;
    my ($name_file_name, @bitmap_file_names) = @ARG;
    my $i;

    #
    # 外字の名前ファイルを開く。
    #
    $self->{'name_file_name'} = $name_file_name;
    if (!$self->{'name_handle'}
	->open($self->{'name_file_name'}, 'w')) {
	$self->{'error_message'} = "failed to open the file, $ERRNO: "
	    . $self->{'name_file_name'};
	$self->close_internal();
	return 0;
    }

    $self->{'bitmap_height_count'} = @bitmap_file_names;

    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
	#
	# 外字のビットマップファイルを開く。
	#
	$self->{'bitmap_file_names'}->[$i] = $bitmap_file_names[$i];
	if (!$self->{'bitmap_handles'}->[$i]
	    ->open($self->{'bitmap_file_names'}->[$i], 'w')) {
	    $self->{'error_message'} = "failed to open the file, $ERRNO: "
		. $self->{'bitmap_file_names'}->[$i];
	    $self->close_internal();
	    return 0;
	}
	binmode($self->{'bitmap_handles'}->[$i]);

	#
	# 外字のビットマップファイルの最初のブロックを `\0' で埋める。
	#
	if (!$self->{'bitmap_handles'}->[$i]
	    ->print("\0" x $block_length)) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $self->{'bitmap_file_name'}->[$i];
	    $self->close_internal();
	    return 0;
	}
    }
    return 1;
}

#
# 書式:
#	close()
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	参照情報ファイルを閉じる。開いていなければ、何もしない。
# 戻り値:
#	常に 1 を返す。
#
sub close {
    my $self = shift;
    my $data;
    my $i;
    my $block_pad;

    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
	#
	# ブロックの末尾まで "\0" を書き込む。
	#
	$block_pad = $block_length
	    - $self->{'bitmap_handles'}->[$i]->tell() % $block_length;
	if ($block_pad < $block_length
	    && !$self->{'bitmap_handles'}->[$i]->print("\0" x $block_pad)) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $self->{'bitmap_file_names'}->[$i];
	    $self->close_internal();
	    return 0;
	}
	
	#
	# 外字のビットマップファイルの先頭に定義内容の情報を書き込む。
	#
	if (!$self->{'bitmap_handles'}->[$i]->seek(0, FileHandle->SEEK_SET)) {
	    $self->{'error_message'} = "failed to seek the file, $ERRNO: "
		. $self->{'bitmap_file_names'}->[$i];
	}
	$data = pack("C8 CC n n C2", 1, 0, 0, 0, 0, 0, 0, 0,
		     $self->{'bitmap_widths'}->[$i],
		     $self->{'bitmap_heights'}->[$i],
		     $start_character_number,
		     $self->{'character_count'},
		     0, 0);
	if (!$self->{'bitmap_handles'}->[$i]->print($data)) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $self->{'bitmap_file_names'}->[$i];
	    $self->close_internal();
	    return 0;
	}
    }

    #
    # 外字のビットマップファイルを閉じる。
    #
    $self->close_internal();
    return 1;
}

#
# 書式:
#	close_internal()
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
#	close() の内部処理用メソッド。
#
sub close_internal {
    my $self = shift;
    my $i;

    #
    # 外字の名前ファイルを閉じる。
    #
    if ($self->{'name_handle'}->fileno()) {
	$self->{'name_handle'}->close();
    }

    #
    # 外字のビットマップファイルを閉じる。
    #
    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
	$self->{'bitmap_handles'}->[$i]->close();
    }
}

#
# 書式:
#	add_character(name, [xbm_16_file_name, xbm_24_file_name,
#	    xbm_30_file_name, xbm_48_file_name])
#           name
#		外字の名前
#	    xbm_16_file_name
#		外字 (高さ 16 ドット) の XBM ビットマップファイル名
#	    xbm_24_file_name
#		外字 (高さ 24 ドット) の XBM ビットマップファイル名
#	    xbm_30_file_name
#		外字 (高さ 30 ドット) の XBM ビットマップファイル名
#	    xbm_48_file_name
#		外字 (高さ 48 ドット) の XBM ビットマップファイル名
# メソッドの区分:
# 	public インスタンスメソッド。
# 説明:
# 	参照情報ファイルにブロック参照エントリを一つ追加する。
# 戻り値:
#	成功すれば 1 を返す。失敗すれば 0 を返す。
#
sub add_character {
    my $self = shift;
    my ($name, @xbm_file_names) = @ARG;
    my ($width, $height, $bitmap);
    my $i;

    #
    # 外字の登録文字数を確認する。
    #
    if ($max_character_count <= $self->{'character_count'}) {
	$self->{'error_message'} = "define too many characters";
	$self->close_internal();
	return 0;
    }

    #
    # 既にこの名前を持つ外字が登録されているか調べる。
    #
    if (defined($self->{'name'}->{$name})) {
	$self->{'error_message'} = "character name has already been defined: "
	    . $name;
	$self->close_internal();
	return 0;
    }

    #
    # 名前ファイルにこの外字の定義を書き込む。
    #
    if (!$self->{'name_handle'}
	->printf("%s\t%04x\n", $name, $self->{'character_number'})) {
	$self->{'error_message'} = "failed to write the file, $ERRNO: "
	    . $self->{'name_file_name'};
	$self->close_internal();
	return 0;
    }

    for ($i = 0; $i < $self->{'bitmap_height_count'}; $i++) {
	if (!defined($xbm_file_names[$i])) {
	    $self->{'error_message'} =
		sprintf("bitmap file (height=%s) not specified",
			$self->{'bitmap_heights'}->[$i]);
	    $self->close_internal();
	    return 0;
	}

	#
	# 外字の XBM ファイルを読み込む。
	#
	($width, $height, $bitmap) = $self->read_xbm_file($xbm_file_names[$i]);
	if (!defined($bitmap)) {
	    $self->close_internal();
	    return 0;
	}
	if ($width != $self->{'bitmap_widths'}->[$i]
	    || $height != $self->{'bitmap_heights'}->[$i]) {
	    $self->{'error_message'} = "XBM file has incorrect size: "
		. $xbm_file_names[$i];
	    $self->close_internal();
	    return 0;
	}

	#
	# 外字のビットマップを書き込む。
	#
	if (!$self->{'bitmap_handles'}->[$i]->print($bitmap)) {
	    $self->{'error_message'} = "failed to write the file, $ERRNO: "
		. $self->{'bitmap_file_names'}->[$i];
	    $self->close_internal();
	    return 0;
	}

	#
	# ブロックの末尾付近に来ている場合は、残りを "\0" で埋めて次の
	# ブロックに移る。
	#
	if (($self->{'character_count'} + 1)
	    % $self->{'bitmap_pad_cycles'}->[$i] == 0) {
	    if (!$self->{'bitmap_handles'}->[$i]
		->print("\0" x $self->{'bitmap_pad_lengths'}->[$i])) {
		$self->{'error_message'} = "failed to write the file, $ERRNO: "
		    . $self->{'bitmap_file_names'}->[$i];
		$self->close_internal();
		return 0;
	    }
	}
    }


    $self->{'name'}->{$name} = 1;
    $self->{'character_count'}++;
    if (($self->{'character_number'} & 0x7f) == 0x7e) {
	$self->{'character_number'} += 0xa3;
    } else {
	$self->{'character_number'}++;
    }
    return 1;
}

#
# 書式:
#	read_xbm_file(file_name)
#	    file_name
#		読み込む XBM ファイル名
# メソッドの区分:
# 	private インスタンスメソッド。
# 説明:
#	XBM ファイルを読み込む。
# 戻り値:
#	成功したときは、次の 3 つの要素をこの順序で並べたリストを返す。
#	    1. ビットマップデータの幅のドット数
#	    2. ビットマップデータの高さのドット数
#           3. ビットマップデータ。pack("C*") で各バイトを詰めたもの。
#       失敗したときは、undef を返す。
# 備考:
#	X11R6.3 の Xmu/RdBitF.c の XmuReadBitmapData() を参考にした。
#
sub read_xbm_file {
    my $self = shift;
    my ($file_name) = @ARG;

    #
    # XBM ファイルを開く。
    #
    my $handle = FileHandle->new();
    if (!$handle->open($file_name, 'r')) {
        $self->{'error_message'} = 
            "failed to open the file, $ERRNO: $file_name";
        return;
    }

    #
    # XBM 定義ファイルを行単位で読み込む。
    # "bits[] = {" の行に出会うまで繰り返す。
    #
    my $line;
    my ($name, $value);
    my ($width, $height) = (0, 0);
    for (;;) {
        $line = $handle->getline();
        if (!defined($line)) {
	    $handle->close();
	    $self->{'error_message'} = "broken XBM file: $file_name";
            return;
        }

	if ($line =~ /^\#define[ \t]+(\S+)[ \t]+([0-9]+)/) {
	    #
	    # "#define ...." で始まる行。
	    #
	    $name = $1;
	    $value = $2;
	    if ($name eq 'width' || $name =~ /_width$/) {
		$width = $value;
	    } elsif ($name eq 'height' || $name =~ /_height$/) {
		$height = $value;
	    }
	} elsif ($line =~ /static[ \t]+char[ \t]+(\S+)[ \t]+=[ \t]+\{/) {
	    #
	    # "static char ...." で始まる行。
	    #
	    $name = $1;
	    if ($name eq 'bits[]' || $name =~ /_bits\[\]$/) {
		last;
	    }
	} elsif ($line =~ /static unsigned char (\S+) = \{/) {
	    #
	    # "static unsigned char ...." で始まる行。
	    #
	    $name = $1;
	    if ($name eq 'bits[]' || $name =~ /_bits\[\]$/) {
		last;
	    }
	}
    }

    #
    # width, height の定義がなければエラー。
    #
    if ($width == 0 || $height == 0) {
	$handle->close();
	$self->{'error_message'} = "broken XBM file: $file_name";
	return;
    }

    #
    # ビットマップの 16 進数部分を 1 文字単位で読み込む。 
    # 
    my @values = ();
    my $current_value = 0;
    my $size = ($width + 7) / 8 * $height;
    my $gotone = 0;
    my $i = 0;
    my $c;
    while ($i < $size) {
        $c = $handle->getc();
        if ($c eq '') {
	    #
	    # 予期していない EOF
	    #
	    $handle->close();
	    $self->{'error_message'} = "broken XBM file: $file_name";
            return;
        } elsif ($c =~ /^[0-9A-Fa-f]$/) {
	    #
	    # 16 進数字。
	    #
	    $current_value = ($current_value << 4) + hex($c);
	    $gotone++;
	} elsif ($c =~ /^[ ,\}\t\n]$/ && $gotone) {
	    #
	    # 16 進数字を 1 字以上読み込んだ後の区切り文字。
	    # 16 進数字列を数値に変換し、ビットの並びを左右 (MSB → LSB)
	    # を逆転させてから @values に記録する。
	    #
	    $values[$i] = 0;
	    $values[$i] |= 0x80 if (($current_value & 0x01) != 0);
	    $values[$i] |= 0x40 if (($current_value & 0x02) != 0);
	    $values[$i] |= 0x20 if (($current_value & 0x04) != 0);
	    $values[$i] |= 0x10 if (($current_value & 0x08) != 0);
	    $values[$i] |= 0x08 if (($current_value & 0x10) != 0);
	    $values[$i] |= 0x04 if (($current_value & 0x20) != 0);
	    $values[$i] |= 0x02 if (($current_value & 0x40) != 0);
	    $values[$i] |= 0x01 if (($current_value & 0x80) != 0);
	    $current_value = 0;
	    $gotone = 0;
	    $i++;
	}
    }

    #
    # XBM ファイルを閉じる。
    #
    $handle->close();

    return ($width, $height, pack("C*", @values));
}

######################################################################
# <インスタンス変数の値を返すメソッド群>
#
# 書式:
#	インスタンス変数名()
# メソッドの区分:
# 	public インスタンスメソッド。
# 戻り値:
#	インスタンス変数の値を返す。
#
sub name_file_name {
    my $self = shift;
    return $self->{'name_file_name'};
}
sub bitmap_file_name {
    my $self = shift;
    my ($height) = @ARG;
    return $self->{'bitmap_file_name'}->{$height};
}
sub character_count {
    my $self = shift;
    return $self->{'character_count'};
}
sub character_number {
    my $self = shift;
    return $self->{'character_number'};
}
sub error_message {
    my $self = shift;
    return $self->{'error_message'};
}

1;
