#=============================================== # TkPlotModule #=============================================== package TkPlotModule; use MyTk::TkCommon; @ISA = qw(TkCommon); #公開したいサブルーチン #@EXPORT = qw(DelSpace Reduce01 MakePath RegExpQuote); use strict; #============================================================ # 変数等取得、再定義関数 #============================================================ sub Canvas { my ($this, $canvas) = @_; if($canvas) { return $canvas; } return $this->mw()->Canvas(); } sub GetGraphFrameArray { return shift->{'GraphFrameArray'}; } sub SetGraphFrameArray { my($this,$pga)=@_; return $this->{'GraphFrameArray'} = $pga; } sub ClearAll { my $this=shift; undef $this->{'FileType'}; } sub FileType { return shift->{'FileType'}; } sub SetFileType { my ($this,$t)=@_; return shift->{'FileType'} = $t; } sub FileName { return shift->{'FileName'}; } sub SetFileName { my ($this,$f)=@_; return $this->{'FileName'} = $f; } sub DataArray { return shift->{'DataArray'}; } sub SetDataArray { my ($this,$da)=@_; return $this->{'DataArray'} = $da; } sub SetSampleName { my ($this,$s)=@_; return $this->{'SampleName'} = $s; } sub SampleName { return shift->{'SampleName'}; } #============================================================ # コンストラクタ、デストラクタ #============================================================ sub new { my ($module, $app) = @_; my $this = {}; bless $this; $this->SetApplication($app); return $this; } sub DESTROY { my $this = shift; $this->SUPER::DESTROY(@_); } #============================================================ # 継承クラスで定義しなおす静的メンバー関数 #============================================================ # グラフ表示アプリケーションの場合は、かならず継承クラスで定義しなおすこと sub CheckFileType { my ($path) = @_; return VASP::CheckFileType($path); } #============================================================ # 継承クラスで定義しなおすグラフ関係メンバー関数 #============================================================ # グラフ表示アプリケーションの場合は、かならず継承クラスで定義しなおすこと sub Read { my ($this, $filename, $TargetData) = @_; return 1; } # 単純なグラフの場合、定義しなおす必要はない 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->mw())); $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 Draw { my ($this, $canvas, $TargetData) = @_; $canvas = $this->Canvas($canvas); return undef unless($canvas); $this->mw()->RefleshCanvas(); my $App = $this->App(); my $mw = $this->mw(); 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->mw()->Balloon()->detach($canvas); $GraphFrameArray->Draw($canvas); } # 定義しなおす必要はない sub DeleteWidget($) { my ($this, $Frame) = @_; return undef unless($Frame); return 1; } # 定義しなおす必要はない sub AddWidget($) { my ($this, $Frame) = @_; return undef unless($Frame); return 1; } # 定義しなおす必要はない sub SetFileInfo($$) { my ($this, $ListBox, $TextBox) = @_; return undef unless($ListBox); return undef unless($TextBox); $ListBox->ClearAll(); $TextBox->ClearText(); return 1; } #============================================================ # 継承クラスで定義しなおすウィンドウ関係メンバー関数 #============================================================ # 以下、標準の動作をしたい場合は、mw()の標準関数を呼び出す # 何もせずにundefを返すと、それぞれのウジェットを作成しない # モジュールの読み込み sub LoadModules { my ($this) = @_; $this->App()->LoadModules(); return 1; } # 起動時引数の設定、読み込み 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); # 必要に応じてIniFileの設定を変え、読み込む # 以前の読み込みの後で変数が変更されている可能性がある場合は、 # SaveSetting()を呼び出す # $App->SaveSetting(); # $App->AddIniFileVariable("\\$Style\\WorkDir", "WorkDir"); # $App->ReadSetting(); return 1; } # Document, MainWindowの作成と設定 sub ConnectDocument { my ($this, $doc) = @_; return $this->App()->ConnectDocument($doc); } sub CreateWindow { my ($this, $mw) = @_; return $this->App()->CreateWindow($mw); } # メインループ (Perl/Tkのメッセージループ) sub MainLoop { my ($this) = @_; $this->App()->MainLoop(); } # メニューを作成する sub CreateMenu { my ($this) = @_; return $this->mw()->InitCreateMenu(); } # ウジェット全体の作成 # ここで何もしないと、本当に何のウジェットも作られない # 通常は、mw()->InitCreateWidgets()を呼び出した後、 # 処理をしたい場合にオーバーロードする sub CreateWidgets { my ($this) = @_; return $this->mw()->InitCreateWidgets(); } # ステータスバーを作成する sub CreateStatusBar { my ($this, $position) = @_; return $this->mw()->InitCreateStatusBar($position); } # ツールボックスを作成する sub CreateToolBar { my ($this, $position) = @_; return $this->mw()->InitCreateToolBar($position); } # ファイル選択ペインを作成する sub CreateSelectFilePane { my ($this) = @_; return $this->mw()->InitCreateSelectFilePane(); } # ファイル内容リストボックス、テキストボックスを作成する sub CreateFileContentPane { my ($this) = @_; return $this->mw()->InitCreateFileContentPane(); } # キャンバスを作成する sub CreateCanvasPane { my ($this) = @_; my $ret = $this->mw()->InitCreateCanvasPane(); # $this->SetCanvas($this->mw()->Canvas()); return $ret; } # 初期のウィンドウサイズを設定する sub InitWindowPosition { my ($this) = @_; return $this->mw()->InitWindowPosition(); } # 初期のグラフ枠を作成する # グラフ表示をしないアプリケーションでは、 # 何もせずにundefを返す sub InitCreateGraphFrameArray { my ($this, $canvas) = @_; # return $this->CreateGraphFrame($canvas); return undef; } # mw()->CreateWidgets()の最後で、bindを設定する際に # 呼び出される # デフォルトでは、にInitWindow()をbindする # 何も処理しないと、InitWindow()も呼び出されない sub ConfigureInitialBind { my ($this) = @_; return $this->mw()->InitConfigureInitialBind(); } 1;