PerlでZIP viewer
一日かけて、Perl/Tk使って、ZIPを読み込むビューワーを作っていましたよ、と。
GDでWindows BitMapを作成する。 - 永字八法はこれのための伏線でした。
特徴は、
- 今更だけれどもPerl/Tkであること。
- Image::Magick不使用
- 二枚並べてで見開き対応
- 先読み機能一応あり
こんなところかしら。
スクリプト
use strict; use warnings; use utf8; use Archive::Zip; use GD; use Tk; use Jcode; my $j = Jcode->new(); # 設定 my $long_length = 800; -e 'temp' or mkdir 'temp'; # ランダムファイルを作成する。 my @letters = ('a'..'z'); my %random_list = (); sub random_file { my $file = 'temp/'; map { $file .= $letters[int(rand()*(scalar @letters))]; } (1..12); -e $file and return &random_file(); $random_list{$file} = 1; return $file; } # 作ったランダムファイルは消しておく。 sub my_exit { while ( my ( $k, $v ) = each %random_list ) { unlink $k; unlink $k.'.bmp'; } exit; } sub GD::Image::bmp { my $self = shift; my ( $w, $h ) = $self->getBounds(); my $linelen = $w * 3; while ( 0 < $linelen % 4 ) { ++ $linelen; } my $bit = 14 + 40 + $linelen * $h; # BITMAPFILEHEADER my $res = pack("a2VvvV", "BM", $bit, 0, 0, 14 + 40); # BITMAPINFOHEADER $res .= pack("VVVvvVVVVVV", 40, $w, $h, 1, 24, 0, 0, 0, 0, 0, 0); foreach my $y ( reverse( (0..($h-1)) ) ) { my $line = ""; foreach my $x ( 0..($w-1) ) { $line .= pack( "CCC", ( reverse ( ($self->rgb( $self->getPixel($x, $y) ))[0..2] ) ) ); } $line .= pack("C", 0) while ( $linelen > length $line ); $res .= $line; } return $res; } # ウィンドウの作成 my $top = MainWindow->new(); $top->protocol('WM_DELETE_WINDOW', \&my_exit); # 終了時の動作を規定 my $arc = $top->getOpenFile( -title=>'zipを指定してください。', -initialdir=>"L:\\[0]My eBooks" ); # アーカイブの作成 my $zip = Archive::Zip->new($j->set($arc=>'utf8')->sjis()); # リストの取得 my %page = map { $_->fileName(), $_ } grep { !($_->fileName() =~ /\.db$/) } $zip->members(); my @page = grep { $page{$_} } map { $_->fileName() } $zip->members(); # ボタンの作成と配置 my $zipfile = $top->Entry( -textvariable=>\$arc ); $zipfile->grid( -row=>0, -column=>0, -columnspan=>2, -sticky=>'news' ); # スクロールリスト my $sc = $top->Listbox( -selectmode=>'extended' ); sub sc2image { &page_change($sc->curselection()->[0]); } map { $sc->insert('end', $_) } @page; $sc->bind( '<ButtonRelease-1>', \&sc2image ); $sc->grid( -row=>0, -column=>2, -rowspan=>3, -sticky=>'news' ); # スクロールバー my $bar = $top->Scrollbar( -orient=>'v', -command=>['yview', $sc] ); $sc->configure(-yscrollcommand=>['set', $bar]); $bar->grid( -row=>0, -column=>3, -rowspan=>3, -sticky=>'news' ); # 右ページの番号 my $rnum = 0; my $rp = $top->Entry( -textvariable=>\$rnum ); $rp->grid( -row=>1, -column=>1, -sticky=>'news' ); # 左ページの番号 my $lnum = 1; my $lp = $top->Entry( -textvariable=>\$lnum ); $lp->grid( -row=>1, -column=>0, -sticky=>'news' ); sub save_image { my $num = shift; my $ob = &load_image($num); my @t = reverse((localtime())[0..5]); $t[0] += 1900; ++ $t[1]; my $out = sprintf "%04d%02d%02d%02d%02d%02d", @t; $out .= '.png'; my $im = GD::Image->new($ob->[3]); open ( OUT, '>'.$out ); binmode( OUT ); print OUT $im->png(); close ( OUT ); } sub save_image2 { my $num = shift; my $ob = &load_image($num); print $ob->[0]->redither(); } my $num = 0; my $rpage; my $lpage; sub make_image { my ( $r, $l ) = @_; $rpage = $top->Label( -image=>$r->[0], -width=>$r->[1], -height=>$r->[2] ); $rpage->bind( '<ButtonRelease-1>', sub { &page_change($num-2); } ); $rpage->bind( '<ButtonRelease-3>', sub { &save_image($num); } ); $rpage->bind( '<Double-3>', sub { &save_image2($num); } ); $rpage->grid( -row=>2, -column=>1, -sticky=>'nw' ); $lpage = $top->Label( -image=>$l->[0], -width=>$l->[1], -height=>$l->[2] ); $lpage->bind( '<ButtonRelease-1>', sub { &page_change($num+2); } ); $lpage->bind( '<ButtonRelease-3>', sub { &save_image($num+1); } ); $lpage->bind( '<Double-3>', sub { &save_image2($num+1); } ); $lpage->grid( -row=>2, -column=>0, -sticky=>'ne' ); } # ページ変更 sub page_change { $num = 0 + shift; $num < 0 and $num = 0; $num < -1 + scalar @page or $num = -2 + scalar @page; # ページ表示変更 $rnum = $sc->get($num); $lnum = $sc->get($num+1); $sc->see($num); $sc->see($num+1); $sc->selectionClear(0, 'end'); $sc->selectionSet($num, $num+1); # ページ削除 $rpage and $rpage->destroy(); $lpage and $lpage->destroy(); # 実ページ変更 my $t1 = load_image($num); my $t2 = load_image($num+1); # 表示 &make_image($t1, $t2); $top->update(); &look_ahead(); } # 画像を読み込んで、ファイル名にして返す。 # 引数にページ番号を与える。 sub extract { my $num = shift; my $out = &random_file(); # アーカイブを解凍 $zip->extractMemberWithoutPaths($page[$num], $out); my $im = GD::Image->new($out); # 読み込み # サイズ取得 my ( $ow, $oh ) = $im->getBounds(); my $new; # 変換後サイズ決定 my ( $cw, $ch ) = ( $ow, $oh ); if ( $ow > 800 or $oh > 800 ) { if ( $ow > $oh ) { $cw = 800; $ch = int($oh * 800 / $ow); } else { $ch = 800; $cw = int($ow * 800 / $oh); } # 変換後画像作成 $new = GD::Image->new($cw, $ch, 1); # サイズ変換コピー $new->copyResampled($im, 0, 0, 0, 0, $cw, $ch, $ow, $oh); # コピーを保存。 } else { $new = $im; } my $orig = $out; $out .= '.bmp'; open ( OUT, '>'.$out ); binmode ( OUT ); print OUT $new->bmp(); close ( OUT ); return ($top->Photo(-file=>$out), $cw, $ch, $orig); } my @loaded = (); sub load_image { my $num = shift; $loaded[$num] ||= [extract($num)]; return $loaded[$num]; } page_change(0); my $timer = $top->repeat(3000, \&look_ahead); sub look_ahead { my $cursor = $num+1; while ( $cursor != $num ) { $page[$cursor] or $cursor = 0; if ( $loaded[$cursor] ) { ++ $cursor; } else { &load_image($cursor); return; } } $timer->cancel(); } MainLoop();