#======================================================== # TkPlotWindow2 #======================================================== package TkPlotWindow2; use MyTk::MyMainWindow; @ISA = qw(MyMainWindow); use strict; #use utf8; use Jcode; use Tk; use Tk::Balloon; use MyTk::Dialog; use MyTk::MyNotebook; use MyTk::MyFrame; use MyTk::MyLabel; use MyTk::MyEntry; use MyTk::MyListbox; use MyTk::MyBrowseEntry; use MyTk::MyText; use MyTk::MyButton; use MyTk::MyCheckbutton; use MyTk::MyMenubutton; use MyTk::MyCanvas; use MyTk::MyAdjuster; use MyTk::GraphFrameArray; use Sci::GeneralFileFormat; #============================================================ # 変数等取得関数 #============================================================ sub FileName { return shift->{FileName}; } sub SetFileName { my ($this,$f)=@_; return $this->{FileName} = $f; } sub ClearAll { my $this=shift; undef $this->{FileType}; } sub SetSampleName { my ($this,$s)=@_; return $this->{SampleName} = $s; } sub SampleName { return shift->{SampleName}; } sub FileType { my ($this) = @_; return $this->{FileType} if($this->{FileType}); return $this->{FileType}; } sub SetFileType { my ($this,$t)=@_; return shift->{FileType} = $t; } sub SetFilePath { my ($this,$t)=@_; return shift->{FileEntry} = $t; } sub SetProgram { my ($this,$p)=@_; return shift->{Program} = $p; } sub DataArray { my ($this) = @_; return $this->{DataArray}; } sub SetDataArray { my ($this, $da) = @_; return $this->{DataArray} = $da; } sub Canvas { my ($this, $canvas) = @_; return $canvas if($canvas); return $this->{GraphCanvas}; } sub RefreshCanvas { my ($this, $f) = @_; return $this->Canvas()->ClearAll(); } sub SetCanvas { my ($this, $canvas) = @_; return $this->{GraphCanvas} = $canvas; } sub GetGraphFrameArray { my ($this) = @_; return $this->{GraphFrameArray}; } sub SetGraphFrameArray { my($this, $pga) = @_; return $this->{GraphFrameArray}; } sub GetGraphFrame { my ($this, $idx) = @_; $idx = 0 unless($idx); my $GraphFrameArray = $this->GetGraphFrameArray(); my $GraphFrame = $GraphFrameArray->GetGraphFrame($idx); return $GraphFrame; } sub SectionListBox { return shift->{SectionListbox}; } sub FileContentTextBox { return shift->{FileContentText}; } sub ShowMousePosition { return shift->App()->{ShowMousePosition}; } sub SetShowMousePosition { my ($this,$f)=@_; return $this->App()->{ShowMousePosition} = $f; } sub GetFilePathFromFileListbox { my ($this) = @_; return undef if(!defined $this->{FileEntry}); my $flbox = $this->{FileListbox}; my $filename = $flbox->GetText(); my $dir = $this->{FileEntry}->GetText(); return undef if(!$filename or !$dir); my $path = Deps::MakePath($dir, $filename); return $path; } #============================================================ # #============================================================ sub DeleteWidget($) { my ($this, $Frame) = @_; return undef unless($Frame); return 1; } sub AddWidget($) { my ($this, $Frame) = @_; return undef unless($Frame); return 1; } sub CreateWidgets { my ($this, $CreateLeftWidgets, $CreateRightWidgets) = @_; $CreateLeftWidgets = 1 if(!defined $CreateLeftWidgets); $CreateRightWidgets = 1 if(!defined $CreateRightWidgets); my $App = $this->App(); my $args = $App->Args(); #Paneの設定 $this->set('IsVertical', 0); my $ConfigSide = "left"; my $GraphSide = "right"; my @args = (-expand => 'yes', -fill => 'both'); if(defined $args->GetGetArg("vertical")) { $this->set('IsVertical', 1); $ConfigSide = "top"; $GraphSide = "bottom"; @args = (-fill => 'x'); } $this->{StatusBar} = $this->CreateStatusBar('bottom'); $this->{ToolBar} = $this->CreateToolBar('top'); my $balloon = $this->Balloon(-statusbar => $this->StatusBar() ); $this->SetBalloon($balloon); $this->{LeftFrame1} = $this->CreateLeftFrame($ConfigSide, @args); $this->CreateSelectFilePane() if($CreateLeftWidgets); $this->CreateFileContentPane() if($CreateLeftWidgets); if($CreateRightWidgets) { $this->CreateCanvasPane(); $this->InitCreateGraphFrameArray($this->Canvas()); } #=================================================== # コマンドラインオプションの処理 #=================================================== if(defined $this->GetGetArg("WorkDir")) { my $WorkDir = $this->GetGetArg("WorkDir"); if(-d $WorkDir) { $App->print("Read --WorkDir=[$WorkDir].\n"); $this->ReadDirectory($WorkDir); } } elsif(defined $this->GetGetArg("ReadPrev")) { my $WorkDir = $App->{'WorkDir'}; if(-d $WorkDir) { $App->print("Read Previous Dir=[$WorkDir].\n"); $this->ReadDirectory($WorkDir); } } #=================================================== # 小さくなり過ぎないように設定 #=================================================== $this->SetMinSize(); #=================================================== # ウィンドウを更新する #=================================================== $this->update(); #=================================================== # 引数にファイルが指定されていた場合 #=================================================== $this->ConfigureInitialBind(); #=================================================== #Windowが初めて表示されたときに、InitWindowを実行する #=================================================== $this->CheckArguments(); $this->InitWindowPosition() if($^O ne 'MSWin32'); return $this; } # mw()->CreateWidgets()の最後で、bindを設定する際に呼び出される sub ConfigureInitialBind { my ($this) = @_; $this->bind('', [ \&InitWindow, $this ] ); } # CreateWidgesの最後で、に対するbindで呼び出される sub InitWindow { my ($this) = @_; #各widgetに応答する必要がないので何もしない return; #Windowが初めて表示されたときだけ、InitWindowを実行する return if($this->{Initialized}); $this->{Initialized} = 1; #App()が定義されていない場合でもInitWindowが呼ばれるので、Hash変数として取得する my $App = $this->{Application}; return unless($App); # ウィンドウサイズの変更に対するbind # $this->bind( "", [ \&Draw, $this ]); } # 引数にファイルが指定されていた場合の処理 # InitCreateWidgetsから呼び出される sub CheckArguments { my ($this) = @_; return if(!defined $this->{FileListbox}); my $filepath = $this->GetGetArg(0); if($filepath) { unless(-f $filepath) { print "\nWarning: [$filepath] does not exist.\n"; # exit 1; } my ($drive, $dir, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($filepath); $dir = Deps::MakePath($drive, $dir); return if(!-e $dir); $this->ReadDirectory($dir); $this->{FileListbox}->SetText($filename); return if(!-e $filepath); $this->ReadFile($filepath); # この時点ではCanvas sizeが未確定なので、1秒後に再描画する # $this->after(1000, sub { $this->Draw(); } ); # afterIdleを使う方法はうまくいかなかった # $this->{IdleProcId} = $this->afterIdle( # sub { $this->Draw(); $this->{IdleProcId}->cancel(); } # ); } } sub CreateMenu { my ($this) = @_; my $IniFile = $this->IniFile()->IniFile(); my $Editor = $this->App()->{'EditorPath'}; my $menu = $this->CreateMainMenu(); # メニュー作成 my $FileInfoMenu = [ [command => 'Environment Vars', -underline => 0, -command => sub { Dialog::ShowEnvDialog($this); } ], [command => 'Information', -underline => 0, -command => sub { $this->App()->ShowInfoDialog($this); } ], ]; my $FileMenu = $menu->cascade( -label => 'File', -underline => 0, -tearoff => 'no', -menuitems => [ [command => 'Make Clone', -underline => 0, -command => [ \&MakeClone, $this ] ], [command => 'IniFile', -underline => 0, -command => sub { system("$Editor $IniFile"); } ], [command => 'Option', -underline => 0, -command => [\&SetupOption, $this] ], "separator", [cascade => 'Info', -underline => 2, -tearoff => 'no', -menuitems => $FileInfoMenu], [command => 'Close', -underline => 0, -accelerator => "Ctrl+X", -command => [\&Close, $this, 0] ], ]); $this->bind("", sub { $this->Close(1); } ); my $ViewMenu = $menu->cascade( -label => 'View', -underline => 0, -tearoff => 'no', -menuitems => [ [command => 'Restore scale', -underline => 8, -command => sub { $this->RestoreViewScale(); } ], [command => 'Redraw', -underline => 0, -command => sub { $this->Redraw(); } ], ]); my $HelpMenu = $menu->cascade( -label => 'Help', -underline => 0, -tearoff => 'no', -menuitems => [ [command => 'About', -underline => 0, -command => sub { $this->About(); } ], ]); return $this->MainMenu(); } sub CreateToolBar { my ($this, $position) = @_; # 枠作成 $this->{ToolBarFrame} = $this->MyFrame( -borderwidth => 2, -relief => 'groove', )->pack(-side => $position, -fill => 'x'); $this->{OpenButton} = $this->{ToolBarFrame}->MyButton( -text => 'Open', -takefocus => 1, -command => [ \&ChooseFile, $this ], )->pack(-side => 'left', -fill => 'x'); $this->InsertToolBar($this->{ToolBarFrame}); my $spb = $this->{ShowPosButton} = $this->{ToolBarFrame}->MyCheckbutton( -text => 'Show Position', -takefocus => 1, -indicatoron => 0, )->pack(-side => 'left', -fill => 'x'); $spb->bind('' => sub { $this->ToggleShowMousePosition(); } ); if($this->ShowMousePosition()) { $spb->select(); } else { $spb->deselect(); } $this->{PlotButton} = $this->{ToolBarFrame}->MyButton( -text => 'Plot', -takefocus => 1, -command => sub { $this->CreateGraphFrame() if(!defined $this->{GraphFrameArray}); $this->AssignGraphData(1); $this->Draw(); } )->pack(-side => 'left', -fill => 'x'); $this->{RestoreScaleButton} = $this->{ToolBarFrame}->MyButton( -text => 'Restore Scale', -takefocus => 1, -command => sub { $this->RestoreScale(); }, #[\&RestoreViewScale, $this], )->pack(-side => 'left', -fill => 'x'); $this->{SetupOptionButton} = $this->{ToolBarFrame}->MyButton( -text => 'Setup', -takefocus => 1, -command => [\&SetupOption, $this], )->pack(-side => 'left', -fill => 'x'); $this->{CloseButton} = $this->{ToolBarFrame}->MyButton( -text => 'Close', -takefocus => 1, -command => [ \&Close, $this, 1 ], )->pack(-side => 'left', -fill => 'x'); my $balloon = $this->Balloon(); $balloon->attach($this->{OpenButton}, -msg => "Open directory", -balloonposition => 'mouse'); $balloon->attach($this->{ShowPosButton}, -msg => "Toggle Show Mouse Poisition", -balloonposition => 'mouse'); } # ステータスバーを作成する sub CreateStatusBar { my ($this, $position) = @_; return $this->SUPER::CreateStatusBar($position); } # 左枠を作る sub CreateLeftFrame { my ($this, $ConfigSide, @args) = @_; my $App = $this->App(); $ConfigSide = 'left' if(!$ConfigSide); $App->{LeftFrameWidth} = 50 if(!$App->{LeftFrameWidth}); $this->{LeftFrame1} = $this->MyFrame( -width => $App->{'LeftFrameWidth'}, )->pack(-side => $ConfigSide, @args); # データファイル処理クラスで使えるように余計な枠を作成 $this->{DataClassFrame} = $this->{LeftFrame1}->MyFrame( )->pack(-anchor => 'nw', -fill => 'x'); } # 初期のグラフ枠を作成する # グラフ表示をしないアプリケーションでは何もせずにundefを返す sub InitCreateGraphFrameArray { my ($this, $canvas) = @_; # return $this->CreateGraphFrame($canvas); return undef; } #=================================================== # ファイル選択ペイン #=================================================== sub CreateSelectFilePane { my ($this) = @_; return if(!$this->{LeftFrame1}); my $App = $this->App(); my $Args = $App->Args(); my $balloon = $this->Balloon(); # 左枠1列目作成 $this->{FileFrame} = $this->{LeftFrame1}->MyFrame( -width => $App->{LeftFrameWidth}, )->pack(-anchor => 'nw', -fill => 'x'); #, -expand => 'yes', -fill => 'x'); my $FilePathPaneStyle = $Args->GetGetArg("FilePathPane"); $FilePathPaneStyle = 'TkPlot' if(!defined $FilePathPaneStyle); #print "FilePathPaneStyle: $FilePathPaneStyle\n"; if(defined $FilePathPaneStyle and $FilePathPaneStyle eq 'Conventional') { $this->{FileLabel} = $this->{FileFrame}->MyLabel( -text => 'Dir:' )->pack(-side => 'left'); $this->{FileEntry} = $this->{FileFrame}->MyEntry( -width => $App->{'LeftFrameWidth'}, -takefocus => 1, )->pack(-side => 'left', -expand => 'yes', -fill => 'x'); $this->{FileEntry}->focus(); $balloon->attach($this->{FileEntry}, -msg => "Data directory", -balloonposition => 'mouse'); $this->{FilePathButton} = $this->{FileFrame}->MyButton( -text => '&Choose', -takefocus => 1, -command => [ \&ChooseFile, $this, , undef, "ChooseDir"], )->pack(-side => 'left'); $balloon->attach($this->{FilePathButton}, -msg => "Choose data directory", -balloonposition => 'mouse'); # 左枠2列目作成: ファイルを選択するドロップダウンリストボックス $this->{FileListFrame} = $this->{LeftFrame1}->MyFrame( -width => $App->{'LeftFrameWidth'}, )->pack(-side => 'top', -fill => 'x'); #, -expand => 'yes', -fill => 'x'); $this->{FileListbox} = $this->{FileListFrame}->MyBrowseEntry( -label => "Files:", -state => "readonly", # -setgrid => 1, # -height => 6, # -width => $App->{LeftFrameWidth}, # -scrollbars => 'e', -takefocus => 1, -browsecmd => [\&SelChangeFileListBox, "", $this], )->pack(-side => 'left', -expand => 'yes', -fill => 'x'); $balloon->attach($this->{FileListbox}, -msg => "Choose data to show", -balloonposition => 'mouse'); } elsif(!defined $FilePathPaneStyle or $FilePathPaneStyle eq 'TkPlot') { $this->{FileLabel} = $this->{FileFrame}->MyLabel( -text => 'Path:' )->pack(-side => 'left'); $this->{FileEntry} = $this->{FileFrame}->MyEntry( -width => $App->{'LeftFrameWidth'}, -takefocus => 1, )->pack(-side => 'left', -expand => 'yes', -fill => 'x'); $this->{FileEntry}->focus(); $balloon->attach($this->{FileEntry}, -msg => "Data File Path", -balloonposition => 'mouse'); $this->{FilePathButton} = $this->{FileFrame}->MyButton( -text => '&Choose', -takefocus => 1, -command => [ \&ChooseFile, $this , $this->{FileEntry}, undef, "ChooseFile"], )->pack(-side => 'left'); $balloon->attach($this->{FilePathButton}, -msg => "Choose data directory", -balloonposition => 'mouse'); } else { $App->print("Error in TkPlotModule::InitCreateSelectFilePane: Invalid FilePathPaneStyle [$FilePathPaneStyle].\n"); exit; } } #=================================================== # ファイル内容ペイン #=================================================== sub CreateFileContentPane { my ($this) = @_; if(!$this->get('IsVertical',0)) { # 左枠3列目作成: ファイルの内容を表示するセクションリストボックス $this->CreateSectionListBox(); # 左枠4列目作成: ファイルの内容を表示するテキストボックス $this->CreateFileContentTextBox(); } } sub CreateSectionListBox() { my ($this) = @_; return if(!$this->{LeftFrame1}); my $App = $this->App(); $this->{SectionListbox} = $this->{LeftFrame1}->Scrolled( 'MyListbox', -setgrid => 1, -width => $App->{LeftFrameWidth}, -height => 6, -scrollbars => 'e', -takefocus => 1, )->pack(-side => 'top', -fill => 'x'); #, -expand => 'yes', -fill => 'x'); # $this->{SectionListbox}->focus; $this->{SectionListbox}->bind('' => [\&SelChangeSectionListBox, $this]); $this->{SectionListbox}->bind('' => [\&SelChangeSectionListBox, $this]); $this->{SectionListbox}->bind('' => [\&DBLClickSectionListbox, $this]); $this->{SectionListbox}->SetCurSel(0); return 1; } sub CreateFileContentTextBox() { my ($this) = @_; return if(!$this->{LeftFrame1}); my $App = $this->App(); $this->{FileContentText} = $this->{LeftFrame1}->Scrolled( 'MyText', # -readonly => 1, -width => $App->{LeftFrameWidth}, -height => 20, -scrollbars => 'e', -takefocus => 1, )->pack(-side => 'top', -expand => 'yes', -fill => 'both'); if($App->{FileContentFontName}) { $this->{FileContentText}->configure( -font => [ $App->{FileContentFontName}, $App->{FileContentFontSize}, $App->{FileContentFontStyle} ], ); } # 左下枠作成: ファイル内容テキストボックスボタン $this->{BottomFrame1} = $this->{LeftFrame1}->MyFrame() ->pack(-side => 'bottom'); $this->{FontButton} = $this->{BottomFrame1}->MyButton( -text => "Font", -command => [ \&SelectFileContentFont, $this, $this->{FileContentText}, "FileContentFont" ], )->pack(-side => 'left'); $this->Balloon()->attach($this->{FontButton}, -msg => "Change FileContent Font", -balloonposition => 'mouse'); return 1; } #=================================================== # キャンバスペイン #=================================================== sub CreateCanvasPane { my ($this) = @_; my $App = $this->App(); my $args = $App->Args(); my $balloon = $this->Balloon(); my $ConfigSide = "left"; my $GraphSide = "right"; my @args = (-expand => 'yes', -fill => 'both'); if(defined $args->GetGetArg("vertical")) { $ConfigSide = "top"; $GraphSide = "bottom"; @args = (-fill => 'x'); } # 右枠作成 $this->{RightFrame1} = $this->MyFrame() ->pack(-side => $GraphSide, -expand => 'yes', -fill => 'both'); my $canvas = $this->{RightFrame1}->MyCanvas( -background => 'white', -width => 500, # -height => 500, -relief => 'groove', -borderwidth => 3, -cursor => 'crosshair', #'cross', 'tcross' )->pack(-expand => 'yes', -fill => 'both'); $this->SetCanvas($canvas); if(!$this->get('IsVertical',0) and $this->{LeftFrame1}) { # $this->{LeftFrameAdjusterLeft} # = $this->Adjuster()->packAfter($this->{LeftFrame1}, -side => 'left'); } # キャンバス下枠作成: フォントボタン $this->{RightBottomFrame1} = $this->{RightFrame1}->MyFrame() ->pack(-side => 'bottom', -fill => 'x'); $this->{CanvasFontButton} = $this->{RightBottomFrame1}->MyButton( -text => "GraphFrame Font", -takefocus => 1, -command => [ \&SelectCanvasFont, $this, $this->{GraphCanvas}, "GraphFrameFont" ], )->pack(-side => 'left'); $balloon->attach($this->{CanvasFontButton}, -msg => "Change Canvas Font", -balloonposition => 'mouse'); $this->{ReplotButton} = $this->{RightBottomFrame1}->MyButton( -text => "&Replot", -takefocus => 1, -command => sub { $this->Draw(); }, #[ \&Draw, $this ], )->pack(-side => 'left'); $balloon->attach($this->{ReplotButton}, -msg => "Redraw Graph", -balloonposition => 'mouse'); $this->{SavePSButton} = $this->{RightBottomFrame1}->MyButton( -text => "Save &PS", -takefocus => 1, -command => sub { $this->SavePSFile($this->{GraphCanvas}); }, )->pack(-side => 'left'); $balloon->attach($this->{SavePSButton}, -msg => "Save Graph as PostScript file", -balloonposition => 'mouse'); my @CommandList; if($App->{PSViewer1Name} and $App->{PSViewer1Path}) { my $cmd = [ 'command' => $App->{PSViewer1Name}, -command => sub { $this->Canvas()->SavePostScript($App->{PSViewer1Path}, $App->{StartAppPath}); }, ]; push(@CommandList, $cmd); } if($App->{PSViewer2Name} and $App->{PSViewer2Path}) { my $cmd = [ 'command' => $App->{PSViewer2Name}, -command => sub { $this->Canvas()->SavePostScript( $App->{PSViewer2Path}, $App->{StartAppPath}); }, ]; push(@CommandList, $cmd); } $this->{OpenPSMenuButton} = $this->{RightBottomFrame1}->MyMenubutton( -text => 'Open PS', -underline => 0, -tearoff => 'no', -relief => 'raised', -direction => 'above', -indicatoron => 'yes', -menuitems => \@CommandList, # -takefocus => 1, )->pack(-side => 'left'); $balloon->attach($this->{OpenPSMenuButton}, -msg => "Open Graph by PostScript Viewer", -balloonposition => 'mouse'); $this->{SaveCSVButton} = $this->{RightBottomFrame1}->MyButton( -text => "Save &CSV", -takefocus => 1, # -command => sub { print "CSVButton\n"; &SaveCSVFile($this); }, -command => [ \&SaveCSVFile, $this], )->pack(-side => 'left'); $balloon->attach($this->{SaveCSVButton}, -msg => "Save Graph as CSV file", -balloonposition => 'mouse'); $this->{RefleshButton} = $this->{RightBottomFrame1}->MyButton( -text => "Reflesh", -takefocus => 1, -command => sub { $this->RefleshCanvas(1); }, )->pack(-side => 'right'); $this->RefleshCanvas(); $balloon->attach($this->{RefleshButton}, -msg => "Remake Canvas: does not have an effect", -balloonposition => 'mouse'); } # 初期のウィンドウサイズを設定する sub InitWindowPosition { my ($this, $geo) = @_; my $App = $this->App(); return unless($App->{SetWindowPos}); $geo = $App->{geometry}; if($geo) { # $geo =~ s/^(\d+x\d+)\+/\+/ if($geo); $App->print("geometry in IniFile: $geo\n"); return unless($App->{'SetWindowPos'}); $this->SetGeometry($geo); my ($w, $h, $x, $y) = ($geo =~ /^(\d+)x(\d+)([\+-]\d+)([\+-]\d+)$/); print "wh: $w $h $x $y\n"; $this->configure(-width => $w, -height => $h) if($w and $h); $this->geometry("$x$y"); # $this->configure(-x, $x); # $this->configure(-y, $y); } } #============================================================ # コンストラクタ、デストラクタ #============================================================ sub new { my ($class, $App, @a) = @_; my $self = MyMainWindow->new(@a); my $this = bless $self, $class; $this->SetApplication($App); # $this->SetCanvas($canvas); $this->protocol('WM_DELETE_WINDOW' => sub { $this->Close(0); }); ## $this->bind(, sub { &Close(1) if(Ev{'K'} eq 'Escape'); print Ev{'K'} . "\n"; } ); return $this; } sub DESTROY { my $this = shift; # $this->SUPER::DESTROY(@_); } sub Close { my ($this, $DoConfirm) = @_; my $App = $this->App(); my $geo; if($App) { my $w = $this->width(); my $h = $this->height(); my $x = $this->x(); #rootx(); my $y = $this->y(); #rooty(); $geo = "${w}x$h+$x+$y"; $App->print("Current geometry from whxy: $geo\n"); # $geo = $this->geometry(); $App->{geometry} = $geo if($this->IsValidGeometry($geo)); my $textbox = $this->{FileContentText}; if($textbox) { # $App->{LeftFrameWidth} = $textbox->width(); } } $App->SaveSetting(); if($DoConfirm) { my $button = $this->messageBox( -icon => 'warning', -type => 'YesNo', -default => 'No', -title => 'Confirm', -message => 'Really quit?'); return if($button eq 'No'); } $this->destroy(); } #============================================================ # 起動時引数の設定、読み込み #============================================================ sub ReadArgs { my ($this) = @_; my $App = $this->App(); my $Args = $App->Args(); # 新しい引数設定で読み込み直すため、初期化する # $Args->InitializeArgs(); # 以前の$Args->Read()で、設定されていない引数はファイル名リストに入っているかもしれない # ファイル名リストだけ初期化するときはこちらを呼び出す $Args->InitializeFiles(); # 必要なら引数設定をやり直す $App->AddArgument("--abc", "--abc : Set dummy", ''); # 最後に1を指定すると、エラーメッセージとusageを表示する my $ret = $Args->Read(\@ARGV, 1); # 設定されていない引数があると、1以外を返す # ここでは、引数エラーの場合はプログラムを停止する exit 1 if($ret != 1); return $ret; } # Iniファイルの設定、読み込み sub ConfigureIniFileVariables { my ($this) = @_; my $App = $this->App(); my $Args = $App->Args(); my $Style = $Args->GetGetArg("style"); $Style = "General" unless($Style); $App->ConfigureIniFileVariables(); # 必要に応じてIniFileの設定を変え、読み込む # 以前の読み込みの後で変数が変更されている可能性がある場合は、 # SaveSetting()を呼び出す # $App->SaveSetting(); # $App->AddIniFileVariable("\\$Style\\WorkDir", "WorkDir"); # $App->ReadSetting(); return 1; } #============================================================ # bind関数 #============================================================ sub About { my ($this) = @_; Dialog::ShowAboutDialog($this, ucfirst $this->Program()); } sub MakeClone { my ($this) = @_; my $args = $this->App()->Args(); my $command = $args->BuildCommandLine(); $command = "perl.exe $command"; Deps::ExecBackground($command); } sub SetupOption { my ($this) = @_; my $App = $this->App(); my $dlg = $this->DialogBox( -title => "Setup Option", -default_button => 'OK', -buttons => ['OK', 'Cancel'], ); my $width = 50; my $MainFrame = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame1 = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame2 = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame3a = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame3b = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame4a = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'x'); # my $Frame4b = $dlg->add('Frame')->pack(-expand => 'yes', -fill => 'both'); my $ChildFrame = $this->MakeSetupOptionFrame($MainFrame, $width); $ChildFrame->pack(-expand => 'yes', -fill => 'x'); my $ret = $dlg->Show; if($ret eq 'OK') { $App->{EditorPath} = $ChildFrame->{EditorText}->GetText(); $App->{StartAppPath} = $ChildFrame->{StartAppText}->GetText(); $App->{PSViewer1Path} = $ChildFrame->{PSView1Text}->GetText(); $App->{PSViewer1Name} = $ChildFrame->{PSView1NameText}->GetText(); $App->{PSViewer2Path} = $ChildFrame->{PSView2Text}->GetText(); $App->{PSViewer2Name} = $ChildFrame->{PSView2NameText}->GetText(); } } sub MakeSetupOptionFrame { my ($this, $MainFrame, $width) = @_; my $App = $this->App(); my $ChildFrame = $MainFrame->MyFrame(); my $Frame1 = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'x'); my $Frame2 = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'x'); my $Frame3a = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'x'); my $Frame3b = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'x'); my $Frame4a = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'x'); my $Frame4b = $ChildFrame->MyFrame()->pack(-expand => 'yes', -fill => 'both'); my $EditorLabel = $Frame1->Label(-text => "Editor Path:")->pack(-side => 'left'); my $EditorText = $ChildFrame->{EditorText} = $Frame1->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, ); my $EditorPathButton = $Frame1->MyButton( -text => "Path", -command => [ \&ChooseFile, $this, $EditorText ], )->pack(-side => 'right'); $EditorText->pack(-side => 'right', -fill => 'x'); $EditorText->focus; my $StartAppLabel = $Frame2->Label(-text => "Start App Path:")->pack(-side => 'left'); my $StartAppText = $ChildFrame->{StartAppText} = $Frame2->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, ); my $StartAppPathButton = $Frame2->MyButton( -text => "Path", -command => [ \&ChooseFile, $this, $StartAppText ], )->pack(-side => 'right'); $StartAppText->pack(-side => 'right', -fill => 'x'); my $PSView1NameLabel = $Frame3a->Label(-text => "PS Viewer1 Name:" )->pack(-side => 'left', -fill => 'x'); my $PSView1NameText = $ChildFrame->{PSView1NameText} = $Frame3a->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, )->pack(-side => 'left', -fill => 'x'); my $PSView1Label = $Frame3b->Label(-text => " Path:" )->pack(-side => 'left', -fill => 'x'); my $PSView1Text = $ChildFrame->{PSView1Text} = $Frame3b->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, ); my $PSView1PathButton = $Frame3b->MyButton( -text => "Path", -command => [ \&ChooseFile, $this, $PSView1Text ], )->pack(-side => 'right'); $PSView1Text->pack(-side => 'right'); my $PSView2NameLabel = $Frame4a->Label(-text => "PS Viewer2 Name:" )->pack(-side => 'left', -fill => 'x'); my $PSView2NameText = $ChildFrame->{PSView2NameText} = $Frame4a->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, )->pack(-side => 'left', -fill => 'x'); my $PSView2Label = $Frame4b->Label(-text => " Path:" )->pack(-side => 'left', -fill => 'x'); my $PSView2Text = $ChildFrame->{PSView2Text} = $Frame4b->MyEntry( -relief => 'sunken', -takefocus => 1, -width => $width, ); my $PSView2PathButton = $Frame4b->MyButton( -text => "Path", -command => [ \&ChooseFile, $this, $PSView2Text ], )->pack(-side => 'right'); $PSView2Text->pack(-side => 'right'); $EditorText->SetText( $App->{EditorPath}); $StartAppText->SetText( $App->{StartAppPath}); $PSView1Text->SetText( $App->{PSViewer1Path}); $PSView1NameText->SetText($App->{PSViewer1Name}); $PSView2Text->SetText( $App->{PSViewer2Path}); $PSView2NameText->SetText($App->{PSViewer2Name}); return $ChildFrame; } #======================================================================= # bindされた応答関数 #======================================================================= sub SelChangeFileListBox { my ($listbox, $this, $buttonstate) = @_; my $path = $this->GetFilePathFromFileListbox(); return undef unless($path); return $this->ReadFile($path); } sub SelChangeSectionListBox { my ($listbox, $this) = @_; my $lbox = $this->{SectionListbox}; return undef unless($lbox); my $sel = $lbox->get('active'); $this->Draw($this->Canvas(), $sel); } sub DBLClickSectionListbox { my ($listbox, $this) = @_; my $lbox = $this->{SectionListbox}; return undef unless($lbox); my $sel = $lbox->get('active'); # $this->ExecuteScript("DBLClick.$sel"); } sub ToggleShowMousePosition { my ($this) = @_; my $f = $this->ShowMousePosition(); my ($gfa) = $this->GetGraphFrameArray(); return unless($gfa); if($f) { $this->SetShowMousePosition(0); $gfa->SetShowMousePosition(0); } else { $this->SetShowMousePosition(1); $gfa->SetShowMousePosition(1); } } sub SelectCanvasFont { my ($this, $widget, $VarName) = @_; my $App = $this->App(); return undef unless($App); my ($FontName, $FontSize, $FontStyle) = ("times", 10.5, "normal"); ($FontName, $FontSize, $FontStyle) = split(/,/, $App->{$VarName}) if($App->{$VarName}); ($FontName, $FontSize, $FontStyle) = Dialog::ShowFontDialog($this, $FontName, $FontSize, $FontStyle); if($FontName) { $App->{$VarName} = "$FontName,$FontSize,$FontStyle"; if($widget) { $widget->UpdateFont($FontName, $FontSize, $FontStyle); # $widget->Update(); } my @font = ($FontName, $FontSize, $FontStyle); $this->Canvas()->SetFont(\@font); $this->GetGraphFrameArray()->SetFont(\@font); $this->Redraw(); } return $App->{$VarName}; } sub SelectFileContentFont { my ($this, $widget, $VarName) = @_; my $App = $this->App(); return undef unless($App); my $textbox = $this->{FileContentText}; return undef unless($textbox); my ($FontName, $FontSize, $FontStyle) = ("times", 10.5, "normal"); ($FontName, $FontSize, $FontStyle) = split(/,/, $App->{$VarName}) if($App->{$VarName}); ($FontName, $FontSize, $FontStyle) = Dialog::ShowFontDialog($this, $FontName, $FontSize, $FontStyle); if($FontName) { $App->{$VarName} = "$FontName,$FontSize,$FontStyle"; if($widget) { $widget->UpdateFont($FontName, $FontSize, $FontStyle); # $widget->Update(); } } return $App->{$VarName}; } sub ChooseFile { my ($this, $widget, $DefPath, $Action) = @_; #print "t=$this, $widget, $DefPath, $Action\n"; $DefPath = '' if(!$DefPath); my $dir = ''; unless($widget) { $dir = $this->App()->{WorkDir}; chdir($dir); } my $fmask = '*.*'; my $defstr = $DefPath; my $message = 'Choose file'; my $filepath = Dialog::OpenFileDialog($this, 'open', $fmask, $defstr, $message, $dir); if($filepath) { if(!defined $Action or $Action eq 'ChooseDir') { my $DirPath = $this->SetWorkDir($filepath); $this->ReadDirectory($DirPath); } else { $this->ReadFile($filepath); } if($widget) { $widget->SetText($filepath); } } return $filepath; } #============================================================ # bind関数 #============================================================ sub Draw { my ($this, $keyword) = @_; $this->ExecDraw($this->Canvas(), $keyword); } sub Redraw { my ($this) = @_; return $this->Draw(); } sub SavePSFile { my ($this, $canvas, $DefPath) = @_; $DefPath = 'Figure.ps' if(!$DefPath); $canvas->SavePostScript(undef, undef, $DefPath); } sub SaveCSVFile { my ($this, $DefPath) = @_; $DefPath = 'Data.csv' if(!$DefPath); my $App = $this->App(); my $pGraphFrameArray = $this->GetGraphFrameArray(); my $dir = ''; my $fmask = '*.csv'; my $defstr = $DefPath; my $message = 'Choose CSV file name'; chdir($dir) if($dir); my $filepath = Dialog::OpenFileDialog($this, 'save', $fmask, $defstr, $message, $dir); return undef unless($filepath); my $ret = $pGraphFrameArray->SaveCSVFile($filepath, 1); return $ret; } #============================================================ # グラフ関係 #============================================================ sub CreateGraphFrame($) { my ($this, $canvas) = @_; $canvas = $this->Canvas(); my $App = $this->App(); my $FileType = $this->FileType(); my $font = $App->{'GraphFrameFont'}; my @font = split(/,/, $font) if($font); my $w = $canvas->width(); my $h = $canvas->height(); # GraphDataArrayを取得し、格納されているGraphDataの数をとる。 my $pDataArray = $this->DataArray(); return unless($pDataArray); my $nGraphData = $pDataArray->nGraphData(); # Canvas, GraphFrameの初期化 my $GraphFrameArray = $this->SetGraphFrameArray(new GraphFrameArray($this)); $GraphFrameArray->SetCanvasSize($w, $h); # $nGraphDataだけグラフ枠を作る my @GraphFrame; my @FramePosStr; my @XScale; my @YScale; for(my $i = 0 ; $i < $nGraphData ; $i++) { # グラフ枠を追加 $GraphFrameArray->AddGraphFrame(); $GraphFrame[$i] = $GraphFrameArray->GetGraphFrame($i); # グラフ枠の初期サイズを取得、設定 # IniFileの設定で、初期値は$App->{"GraphFrame${i}Position"}に入る $FramePosStr[$i] = $App->{"GraphFrame${i}Position"}; $GraphFrame[$i]->SetPositionByStr($FramePosStr[$i]) if($FramePosStr[$i]); # X,Y目盛りを取得 $XScale[$i] = $GraphFrame[$i]->GetXScale(0); $YScale[$i] = $GraphFrame[$i]->GetYScale(0); # グラフ枠の設定 $GraphFrame[$i]->SetXCaption('X axis'); $GraphFrame[$i]->SetYCaption('Y axis'); $GraphFrame[$i]->SetViewRange(0, 0, 1, 1); } return 1; } sub AssignGraphData() { my ($this) = @_; my $FileType = $this->FileType(); my $GraphFrameArray = $this->GetGraphFrameArray(); my $pDataArray = $this->DataArray(); return unless($pDataArray); my $nGraphData = $pDataArray->nGraphData(); my $Data0 = $pDataArray->GetGraphData(0); if($Data0) { $GraphFrameArray->SetXCaption($Data0->XCaption()); $GraphFrameArray->SetYCaption($Data0->YCaption()); } for(my $i = 0 ; $i < $nGraphData ; $i++) { my $GraphFrame = $GraphFrameArray->GetGraphFrame($i); my $Data = $pDataArray->GetGraphData(0); my $nData = $Data->nData(); my $pX0 = $Data->XDataArray(0); for(my $j = 0 ; $j < $nData ; $j++) { my $pY = $Data->YDataArray($j); last unless($pY); $GraphFrame->AddGraphData($pX0, $pY, 1, "auto", "", 6, "red", 0, "red", "XAutoSkip", $Data->XName(0), $Data->YName($j)); } $GraphFrame->SetXCaption($Data->XCaption()); $GraphFrame->SetYCaption($Data->YCaption()); $GraphFrame->CalMinMax(); $GraphFrame->AdjustViewRange(0.05, 0.05, 0.05, 0.05); } $this->AdjustViewRange(); } sub AdjustViewRange($$) { my ($this) = @_; return 1; } sub UpdateGraphFramePosition { my ($this) = @_; my $App = $this->App(); my $can = $this->Canvas(); my $w = $can->width(); my $h = $can->height(); my $pGraphFrameArray = $App->{DataArray}->GetGraphFrameArray()->GetpGraphFrameArray(); for(my $i = 0 ; $i < @$pGraphFrameArray ; $i++) { my $frame = $pGraphFrameArray->[$i]; my ($x0, $y0, $x1, $y1) = $frame->GetPosition(); my $curpos = $App->{"GraphFrame${i}Position"}; my $str = "$x0,$y0,$x1,$y1"; if($curpos =~ /^r/i) { my $rx0 = sprintf("%5.2f", $x0 / $w); my $rx1 = sprintf("%5.2f", $x1 / $w); my $ry0 = sprintf("%5.2f", $y0 / $h); my $ry1 = sprintf("%5.2f", $y1 / $h); $str = "r$rx0,$ry0,$rx1,$ry1"; $str =~ s/\s//g; } $App->{"GraphFrame${i}Position"} = $str; $frame->SetPositionByStr($str); } } sub RestoreScale { my ($this, $a) = @_; $this->RestoreViewScale($a); } sub RestoreViewScale { my ($this, $a) = @_; my $App = $this->App(); my $f = $this->GetGraphFrameArray(); #print "this=$this f=$f\n"; $this->GetGraphFrameArray()->AdjustViewRange(); $this->AdjustViewRange(); $this->Redraw(); } sub RefleshCanvas { my ($this, $f) = @_; $f = 0 if(!defined $f); $f = 0; my $canvas = $this->Canvas(); my $w = $canvas->width(); my $h = $canvas->height(); unless($f) { $canvas->ClearAll(); # $canvas->InitClass($this); # $canvas->InitObject(); return 1; } else { $this->packPropagate(0); if($canvas) { $canvas->destroy(); $this->SetCanvas(undef); } $canvas = $this->{RightFrame1}->MyCanvas( -background => 'white', -width => $w, -height => $h, -relief => 'groove', -borderwidth => 3, -cursor => 'crosshair', #'cross', 'tcross' )->pack(-expand => 'yes', -fill => 'both'); $this->SetCanvas($canvas); $this->packPropagate(1); return $canvas; } } sub ExecDraw { my ($this, $canvas, $TargetData) = @_; $canvas = $this->Canvas($canvas); return undef unless($canvas); $this->RefleshCanvas(); $canvas = $this->Canvas(); my $App = $this->App(); my $mw = $this; my $GraphFrameArray = $this->GetGraphFrameArray(); return undef unless($GraphFrameArray); my $w = $canvas->width(); my $h = $canvas->height(); #IniFileの設定で、フォントの初期値は$App->{'GraphFrameFont'}に読み込まれている my $font = $App->{'GraphFrameFont'}; my @font = split(/,/, $font) if($font); if($font) { $canvas->SetFont(\@font); $GraphFrameArray->SetFont(\@font); } $GraphFrameArray->SetCanvasSize($w, $h); $this->Balloon()->detach($canvas); $GraphFrameArray->Draw($canvas); } #============================================================ # ファイル読み込み #============================================================ # グラフ表示アプリケーションの場合は、かならず継承クラスで定義しなおすこと sub Read { my ($this, $filename, $TargetData) = @_; return 1; } sub ReadDirectory { my ($this, $dir) = @_; return if(!defined $this->{FileEntry}); chdir($dir); $this->{FileEntry}->SetText($dir); $ENV{'o'} = $dir; $this->App()->{WorkDir} = $dir; my $filelist = $this->{FileListbox}; return if(!defined $filelist); my $FileMask = $this->App()->{FileMask}; $FileMask = ".*" unless($FileMask); $filelist->ReadFileList($dir, $FileMask, 'file', 0, 1, 1); } sub ReadFile { my ($this, $path) = @_; my $App = $this->App(); my ($drive, $dir, $filename, $ext, $lastdir, $filebody) = Deps::SplitFilePath($path); print "\nRead [$path]\n"; $this->SetFilePath($path); $this->SetTitle("$filename:" . $this->AppTitle()); $this->SetApplication($this->App()); # $this->SetCanvas($this->Canvas()); $this->Read($path); my $FileType = $this->FileType(); $FileType = 'unknown' unless($FileType); $this->SetFileType($FileType); $this->WriteStatusBar($FileType, "left"); print " $path is $FileType.\n"; #グラフ設定 $this->CreateGraphFrame($this->Canvas()); $this->AssignGraphData(); #Canvasの再描画 $this->Draw(); } 1;