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