src/unifont-viewer

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Wx;
   6
   7 package Unifont;
   8
   9 use GD qw (:DEFAULT :cmp);
  10
  11 sub LoadHexFile {
  12         my ($input) = @_;
  13         my %hexlist = ();
  14
  15         open (HEXFILE, "$input") or die ("Cannot open file\n");
  16
  17         while (<HEXFILE>) {
  18                 chomp;
  19                 my @data = split (':', $_);
  20
  21                 my $codepoint = hex ($data[0]);
  22                 my $char = $data[1];
  23 #               my $display_width = $codepoint > 0xFFFF ? 6 : 4;
  24                 # Use 6-digit codepoint for all glyphs for now
  25                 my $display_width = 6;
  26
  27                 $hexlist{sprintf ("%0*X", $display_width, $codepoint)} = $char;
  28         }
  29
  30         return %hexlist;
  31 }
  32
  33 sub Hex2PNG {
  34         my ($hexlist_ref, $pagenum, $charheight) = @_;
  35         my %hexlist = %$hexlist_ref;
  36
  37         if ($pagenum > 0x10FF) {
  38                 die ("Invalid page\n");
  39         }
  40
  41         my $charxoffset = 4;
  42         my $gridxoffset = 48;
  43         my $gridyoffset = 32;
  44         my ($charyoffset, $boxsize, $xmax, $ymax, $charmaxwidth);
  45
  46         if (not $charheight) {
  47                 $charheight = 16;
  48         }
  49
  50         if ($charheight == 16) {
  51                 $charyoffset = 7;
  52                 $boxsize = 32;
  53                 $xmax = 2;
  54                 $ymax = 1;
  55                 $charmaxwidth = 6;
  56         } elsif ($charheight == 24) {
  57                 $charyoffset = 4;
  58                 $boxsize = 32;
  59                 $xmax = 2;
  60                 $ymax = 2;
  61                 $charmaxwidth = 6;
  62         } elsif ($charheight == 32) {
  63                 $charyoffset = 4;
  64                 $boxsize = 40;
  65                 $xmax = 3;
  66                 $ymax = 3;
  67                 $charmaxwidth = 8;
  68         } else {
  69                 die ("Invalid height\n");
  70         }
  71
  72         # Create box and set as tile pattern
  73
  74         my $box = new GD::Image ($boxsize, $boxsize);
  75
  76         my $black = $box->colorAllocate (0, 0, 0);
  77         my $white = $box->colorAllocate (255, 255, 255);
  78
  79         $box->filledRectangle (1, 1, $boxsize - 1, $boxsize - 1, $white);
  80
  81         # Draw dots at 8 pixel boundaries
  82          for (my $count = 0; $count <= $xmax; $count++) {
  83                 $box->setPixel (($count * 8) + $charxoffset + 1, 0, $white);
  84                 $box->setPixel (($count * 8) + $charxoffset + 8, 0, $white);
  85         }
  86
  87         for (my $count = 0; $count <= $ymax; $count++) {
  88                 $box->setPixel (0, ($count * 8) + $charyoffset + 1, $white);
  89                 $box->setPixel (0, ($count * 8) + $charyoffset + 8, $white);
  90         }
  91
  92         # Draw grid
  93
  94         my $im = new GD::Image ($boxsize * 16 + $gridxoffset, $boxsize * 16 + $gridyoffset);
  95
  96         $black = $im->colorAllocate (0, 0, 0);
  97         $white = $im->colorAllocate (255, 255, 255);
  98
  99         $im->fill (0, 0, $white);
 100
 101         for (my $xcount = 0; $xcount <= 16; $xcount++) {
 102                 for (my $ycount = 0; $ycount <= 16; $ycount++) {
 103                         $im->copy ($box, $xcount * $boxsize + $gridxoffset - 1, $ycount * $boxsize + $gridyoffset - 1, 0, 0, $boxsize, $boxsize);
 104                 }
 105         }
 106
 107         # Print plane
 108         $im->string (gdLargeFont, 8, 9, sprintf ('U+%02X', $pagenum >> 8), $black);
 109
 110         # Print row headers
 111         for (my $count = 0; $count <= 15; $count++) {
 112                 $im->string (gdLargeFont, 32, ($count * $boxsize) + (($boxsize - 16) / 2) + $gridyoffset, sprintf ('%X', $count), $black);
 113         }
 114
 115         # Print column headers
 116         for (my $count = 0; $count <= 15; $count++) {
 117                 $im->string (gdLargeFont, ($count * $boxsize) + (($boxsize - 24) / 2) + $gridxoffset, 9, sprintf ('%03X', (($pagenum & 0xFF) << 4) + $count), $black);
 118         }
 119
 120         while ((my $codepoint, my $char) = each %hexlist) {
 121                 if ($codepoint and $codepoint =~ m/^[0-9A-F]{4,6}$/) {
 122                         my $cp = hex ($codepoint);
 123
 124                         # Calculate if codepoint is within page
 125                         if ($cp >> 8 == $pagenum) {
 126                                 # Calculate character width, column and row
 127                                 my $charwidth = length ($char) / $charheight;
 128
 129                                 if ($charwidth <= $charmaxwidth) {
 130                                         my $col = ($cp >> 4) & 0xF;
 131                                         my $row = $cp & 0xF;
 132
 133                                         for (my $j = 0; $j < $charheight; $j++) {
 134                                                 # Get character row
 135                                                 my $r = hex (substr ($char, $j * $charwidth, $charwidth));
 136
 137                                                 # Draw character
 138                                                 for (my $i = 0; $i < $charwidth * 4; $i++) {
 139                                                         if ($r & 1 << $i) {
 140                                                                 $im->setPixel (($col * $boxsize) + ($charwidth * 4 - $i) + $charxoffset + $gridxoffset - 1, ($row * $boxsize) + $j + $charyoffset + $gridyoffset, $black);
 141                                                         }
 142                                                 }
 143                                         }
 144                                 }
 145                         }
 146                 }
 147         }
 148
 149         return $im;
 150 }
 151
 152 package UnifontViewer;
 153
 154 use base qw (Wx::App);
 155 use Wx qw (wxMINIMIZE_BOX wxSYSTEM_MENU wxCAPTION wxCLOSE_BOX wxCLIP_CHILDREN);
 156
 157 sub OnInit {
 158         my $self  = shift;
 159         my $frame = UnifontViewerFrame->new (
 160                 undef,
 161                 -1,
 162                 'Unifont Viewer',
 163                 [-1, -1],
 164                 [-1, -1],
 165                 wxMINIMIZE_BOX | wxSYSTEM_MENU | wxCAPTION | wxCLOSE_BOX | wxCLIP_CHILDREN
 166         );
 167
 168         $frame->Show (1);
 169         $self->SetTopWindow ($frame);
 170
 171         return 1;
 172 }
 173
 174 package ImagePanel;
 175
 176 use base qw (Wx::Panel);
 177 use fields qw (memdc);
 178 use Wx qw (wxCOPY);
 179 use Wx::Event qw (EVT_PAINT);
 180
 181 sub new {
 182         my $class = shift;
 183         my $self  = $class->SUPER::new (@_);
 184
 185         $self->{memdc} = Wx::MemoryDC->new ();
 186
 187         EVT_PAINT($self, \&OnPaint);
 188
 189         return $self;
 190 }
 191
 192 sub clear {
 193         my $self = shift;
 194
 195         $self->{memdc}->Clear ();
 196         $self->Refresh ();
 197 }
 198
 199 sub load {
 200         my ($self, $filename) = @_;
 201
 202         my $file = IO::File->new ($filename, 'r');
 203         binmode $file;
 204         my $handler = Wx::PNGHandler->new ();
 205         my $image = Wx::Image->new ();
 206         my $bitmap;
 207         $handler->LoadFile ($image, $file);
 208         $bitmap = Wx::Bitmap->new ($image);
 209
 210         if ($bitmap->Ok ()) {
 211                 $self->{memdc}->SelectObject ($bitmap);
 212                 $self->Refresh ();
 213         }
 214 }
 215
 216 sub load_gd {
 217         my ($self, $gd) = @_;
 218         my $png = $gd->png;
 219
 220         open my $fh, '<', \$png;
 221         my $handler = Wx::PNGHandler->new ();
 222         my $image = Wx::Image->new ();
 223         my $bitmap;
 224         $handler->LoadFile ($image, $fh);
 225         close $fh;
 226         $bitmap = Wx::Bitmap->new ($image);
 227
 228         if ($bitmap->Ok ()) {
 229                 $self->{memdc}->SelectObject ($bitmap);
 230                 $self->Refresh ();
 231         }
 232 }
 233
 234 sub OnPaint {
 235         my ($self, $event) = @_;
 236         my $size = $self->GetClientSize ();
 237
 238         my $dcPaint = Wx::PaintDC->new ($self);
 239         $dcPaint->Blit (0, 0, $size->x, $size->y, $self->{memdc}, 0, 0, wxCOPY, 0);
 240 }
 241
 242 package UnifontViewerFrame;
 243
 244 use base qw (Wx::Frame);
 245 use fields qw (filename hexlist charheight listbox imagepanel);
 246 use Wx::Event qw (EVT_MENU EVT_LISTBOX);
 247 use Wx qw (wxBORDER_SIMPLE wxID_OPEN wxID_SAVE wxID_EXIT wxID_OK wxHORIZONTAL wxEXPAND wxALL wxLB_SORT wxFD_OPEN wxFD_SAVE wxFD_FILE_MUST_EXIST wxFD_CHANGE_DIR);
 248
 249 our @id = (0 .. 100);
 250
 251 sub new {
 252         my $class = shift;
 253         my $self  = $class->SUPER::new (@_);
 254         $self->{filename} = '';
 255         $self->{charheight} = 16;
 256
 257         my $boxsizer = Wx::BoxSizer->new (wxHORIZONTAL);
 258
 259         $self->{listbox} = Wx::ListBox->new (
 260                 $self,
 261                 -1,
 262                 [-1, -1],
 263                 [64, -1],
 264                 [],
 265                 wxLB_SORT
 266         );
 267
 268         $self->{imagepanel} = ImagePanel->new (
 269                 $self,
 270                 -1,
 271                 [-1, -1],
 272                 [-1, -1],
 273                 wxBORDER_SIMPLE
 274         );
 275
 276         SetCharHeight ($self, $self->{charheight});
 277
 278         $boxsizer->Add (
 279                 $self->{listbox},
 280                 0,
 281                 wxEXPAND | wxALL,
 282                 0
 283         );
 284
 285         $boxsizer->Add (
 286                 $self->{imagepanel},
 287                 0,
 288                 wxALL,
 289                 1
 290         );
 291
 292         EVT_LISTBOX ($self->{listbox}, -1, sub {
 293                 my $selection = $self->{listbox}->GetStringSelection ();
 294                 SetPage ($self, $selection);
 295         });
 296
 297         my $menubar = Wx::MenuBar->new ();
 298         my $menu = Wx::Menu->new ();
 299
 300         $menu->Append (wxID_OPEN, "O&pen...\tCtrl+O");
 301         $menu->Append (wxID_SAVE, "S&ave As...\tCtrl+S");
 302         $menu->AppendSeparator ();
 303         $menu->AppendRadioItem ($id[0], "Glyph Height 16");
 304         $menu->AppendRadioItem ($id[1], "Glyph Height 24");
 305         $menu->AppendRadioItem ($id[2], "Glyph Height 32");
 306         $menu->AppendSeparator ();
 307         $menu->Append (wxID_EXIT, "E&xit\tCtrl+X");
 308         $menubar->Append ($menu, 'File');
 309
 310         $self->SetMenuBar ($menubar);
 311
 312         EVT_MENU ($self, wxID_OPEN, \&OpenFile);
 313         EVT_MENU ($self, wxID_SAVE, \&SaveFile);
 314         EVT_MENU ($self, $id[0], sub {SetCharHeight ($self, 16)});
 315         EVT_MENU ($self, $id[1], sub {SetCharHeight ($self, 24)});
 316         EVT_MENU ($self, $id[2], sub {SetCharHeight ($self, 32)});
 317         EVT_MENU ($self, wxID_EXIT, sub {$_[0]->Close (1)});
 318
 319         $self->SetSizerAndFit ($boxsizer);
 320
 321         return $self;
 322 }
 323
 324 sub OpenFile {
 325         my ($self, $event) = @_;
 326
 327         my $dlg = Wx::FileDialog->new (
 328                 $self,
 329                 'Open File',
 330                 '',
 331                 '',
 332                 'Hex files (*.hex)|*.hex',
 333                 wxFD_OPEN | wxFD_FILE_MUST_EXIST | wxFD_CHANGE_DIR
 334         );
 335
 336         if ($dlg->ShowModal == wxID_OK) {
 337                 $self->{imagepanel}->clear ();
 338
 339                 my %pages = ();
 340
 341                 $self->{filename} = $dlg->GetPath ();
 342                 $self->SetTitle ("Unifont Viewer - " . $dlg->GetFilename ());
 343
 344                 open HEXFILE, "<$self->{filename}" || die "Cannot open $self->{filename}\n";
 345
 346                 while (<HEXFILE>) {
 347                         chomp;
 348                         my ($codepoint, $char) = (split (':', $_));
 349                         # For now, list page numbers as 4 digits even for Plane 0 for sorting
 350                         if (length ($codepoint) == 4) {
 351                                 $codepoint = "00" . $codepoint;
 352                         }
 353
 354                         if ($codepoint and $codepoint =~ m/^[0-9A-F]{4,6}$/) {
 355                                 if (!($char eq '00542A542A542A542A542A542A542A00' || $char eq 'FFB9C5EDD5D5D5D5D5D5D5D5EDB991FF')) {
 356                                         my $page = substr ($codepoint, 0, -2);
 357                                         $pages{$page} = 1;
 358                                 }
 359                         }
 360                 }
 361
 362                 $self->{listbox}->Clear ();
 363                 for (keys %pages) {
 364                         $self->{listbox}->Append ($_, hex ($_));
 365                 }
 366
 367                 my %hexlist = Unifont::LoadHexFile ($self->{filename});
 368                 $self->{hexlist} = \%hexlist;
 369
 370                 $self->{listbox}->Select (0);
 371                 my $selection = $self->{listbox}->GetStringSelection ();
 372                 SetPage ($self, $selection);
 373         };
 374 }
 375
 376 sub SaveFile {
 377         my ($self, $event) = @_;
 378
 379         my $selection = $self->{listbox}->GetStringSelection ();
 380
 381         if ($selection) {
 382                 my $dlg = Wx::FileDialog->new (
 383                         $self,
 384                         'Save File',
 385                         '',
 386                         "$selection.png",
 387                         'PNG files (*.png)|*.png',
 388                         wxFD_SAVE
 389                 );
 390
 391                 if ($dlg->ShowModal == wxID_OK) {
 392                         my $im = Unifont::Hex2PNG ($self->{hexlist}, hex ($selection), $self->{charheight});
 393
 394                         my $filename = $dlg->GetPath ();
 395
 396                         $self->{imagepanel}->load_gd ($im);
 397
 398                         open (PICTURE, ">$filename") or die ("Cannot save image\n");
 399                         binmode PICTURE;
 400                         print PICTURE $im->png;
 401                         close PICTURE;
 402                 }
 403         }
 404 }
 405
 406 sub SetPage {
 407         my ($self, $selection) = @_;
 408
 409         if ($selection) {
 410                 my $im = Unifont::Hex2PNG ($self->{hexlist}, hex ($selection), $self->{charheight});
 411                 $self->{imagepanel}->load_gd ($im);
 412         } else {
 413                 $self->{imagepanel}->clear ();
 414         }
 415 }
 416
 417 sub SetCharHeight {
 418         my ($self, $charheight) = @_;
 419         my ($x, $y);
 420         my $selection = $self->{listbox}->GetStringSelection ();
 421
 422         $self->{charheight} = $charheight;
 423
 424         if ($charheight == 16 || $charheight == 24) {
 425                 $x = 562;
 426                 $y = 544;
 427         } elsif ($charheight == 32) {
 428                 $x = 688;
 429                 $y = 672;
 430         }
 431
 432         $self->{imagepanel}->SetMinSize ([-1, -1]);
 433         $self->{imagepanel}->SetClientSize ($x, $y);
 434         $self->{imagepanel}->SetMinSize ($self->{imagepanel}->GetSize ());
 435         $self->Fit ();
 436
 437         SetPage ($self, $selection);
 438 }
 439
 440 package main;
 441
 442 my ($app) = UnifontViewer->new ();
 443
 444 $app->MainLoop ();