#!/usr/bin/perl # gpp - a Gnuplot Post Processor # Copyright (C) 2005 Laurent Mazet # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software Foundation, # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ # Changelog: # - 0.8.1 # * set last radio name for font selection # - 0.8 # * most wanted functionality have been implented and tested # - 0.0.1 # * initial release # Potential bugs: # - none # gobal variables my $version = "0.8.1"; # library use strict; use Tk; use Tk::Button; use Tk::Checkbutton; use Tk::Frame; use Tk::FBox; use Tk::FileSelect; use Tk::LabEntry; use Tk::Label; use Tk::NoteBook; use Tk::Radiobutton; my $mw=MainWindow->new(-title=>'Gppp'); use vars qw/$fullfile $filename $outputname $format $solid $color $rounded $ss_h $ss_v $line_width $font $fontname @red @green @blue @dash $status/; my $notebook = $mw -> NoteBook ( ) -> pack(-ipady=>2, -ipadx=>2); my $file_name = $notebook -> add ( 'file_name', -label=>'file name' ); my $fname = $file_name -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $fname0b = $fname -> Button ( -text=>'Browse', -relief=>'raised', -command=>\&fileopen, -state=>'normal' ) -> pack(-anchor=>'n',-side=>'right', -pady=>2, -padx=>2); my $fname0 = $fname -> LabEntry ( -label=>'File name:', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$filename, -state=>'normal' ) -> pack(-pady=>5, -fill=>'x'); my $oname = $file_name -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $oname0b = $oname -> Button ( -text=>'Browse', -relief=>'raised', -command=>\&filesave, -state=>'normal' ) -> pack(-anchor=>'n',-side=>'right', -pady=>2, -padx=>2); my $oname0 = $oname -> LabEntry ( -label=>'Output name:', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$outputname, -state=>'normal' ) -> pack(-pady=>5, -fill=>'x'); my $f_rescan = $file_name -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $but_rescan = $f_rescan -> Button ( -text=>'Rescan', -relief=>'raised', -command=>\&rescan, -state=>'normal' ) -> pack(-pady=>10, -padx=>10); my $parameters = $notebook -> add ( 'parameters', -label=>'Parameters', -justify=>'left', -state=>'normal' ); my $fformat = $parameters -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $lformat = $fformat -> Label ( -justify=>'left', -relief=>'flat', -text=>'Format:' ) -> pack(-side=>'left'); my $postscript = $fformat -> Radiobutton ( -justify=>'left', -value=>1, -relief=>'flat', -indicatoron=>1, -text=>'Postscript', -variable=>\$format, -state=>'normal' ) -> pack(-side=>'left'); my $eps = $fformat -> Radiobutton ( -justify=>'left', -value=>0, -relief=>'flat', -indicatoron=>1, -text=>'EPS', -variable=>\$format, -state=>'normal' ) -> pack(-side=>'left'); my $pstyles = $parameters -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $lpstyles = $pstyles -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style options:' ) -> pack(-side=>'left'); my $psolid = $pstyles -> Checkbutton ( -justify=>'left', -relief=>'flat', -indicatoron=>1, -text=>'Solid/Dashed', -variable=>\$solid, -state=>'normal' ) -> pack(-side=>'left'); my $pcolor = $pstyles -> Checkbutton ( -justify=>'left', -relief=>'flat', -indicatoron=>1, -text=>'Colored', -variable=>\$color, -state=>'normal' ) -> pack(-side=>'left'); my $pround = $pstyles -> Checkbutton ( -justify=>'left', -relief=>'flat', -indicatoron=>1, -text=>'Rounded', -variable=>\$rounded, -state=>'normal' ) -> pack(-side=>'left'); my $l_width = $parameters -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $symbol_size = $parameters -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $symbol_size0 = $symbol_size -> Label ( -justify=>'left', -relief=>'flat', -text=>'Symbol size:' ) -> pack(-side=>'left'); my $ss_height = $symbol_size -> LabEntry ( -label=>'Height', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$ss_h, -width=>6, -state=>'normal' ) -> pack(-side=>'left'); my $ss_width = $symbol_size -> LabEntry ( -label=>'Width', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$ss_v, -width=>6, -state=>'normal' ) -> pack(-side=>'left'); my $l_width0 = $l_width -> LabEntry ( -label=>'Global line width:', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$line_width, -width=>6, -state=>'normal' ) -> pack(-side=>'left'); my $pfont = $parameters -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $lfont = $pfont -> Label ( -text=>'Font :', -justify=>'left', -relief=>'flat' ) -> pack(-side=>'left'); my $helvetica = $pfont -> Radiobutton ( -justify=>'left', -value=>1, -relief=>'flat', -indicatoron=>1, -text=>'Helvetica', -variable=>\$font, -state=>'normal', -command=> sub{$fontname="Helvetica";} ) -> pack(-side=>'left'); my $timesroman = $pfont -> Radiobutton ( -justify=>'left', -value=>0, -relief=>'flat', -indicatoron=>1, -text=>'Times-Roman', -variable=>\$font, -state=>'normal', -command=> sub{$fontname="Times-Roman";} ) -> pack(-side=>'left'); my $fontother = $pfont -> Radiobutton ( -justify=>'left', -value=>-1, -relief=>'flat', -indicatoron=>1, -text=>'Other', -variable=>\$font, -state=>'normal' ) -> pack(-side=>'left'); my $fontothername = $pfont-> LabEntry ( -label=>'', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$fontname, -width=>12, -state=>'normal' ) -> pack(-side=>'left'); my $nstyles = $notebook -> add ( 'nstyles', -label=>'Color and line styles', -justify=>'left', -state=>'normal' ); my $style_0 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_0 = $style_0 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 0:', -background=>'white') -> pack(-side=>'left', -padx=>2); my $red_0 = $style_0 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[0], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_0 = $style_0 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[0], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_0 = $style_0 -> LabEntry ( -label=>'Blue', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$blue[0], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_0 = $style_0 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[0], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_1 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_1 = $style_1 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 1:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_1 = $style_1 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[1], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_1 = $style_1 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[1], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_1 = $style_1 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[1], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_1 = $style_1 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[1], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_2 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_2 = $style_2 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 2:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_2 = $style_2 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[2], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_2 = $style_2 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[2], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_2 = $style_2 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[2], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_2 = $style_2 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[2], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_3 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_3 = $style_3 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 3:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_3 = $style_3 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[3], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_3 = $style_3 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[3], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_3 = $style_3 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[3], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_3 = $style_3 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[3], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_4 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_4 = $style_4 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 4:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_4 = $style_4 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[4], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_4 = $style_4 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[4], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_4 = $style_4 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[4], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_4 = $style_4 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[4], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_5 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_5 = $style_5 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 5:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_5 = $style_5 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[5], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_5 = $style_5 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[5], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_5 = $style_5 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[5], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_5 = $style_5 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[5], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_6 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_6 = $style_6 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 6:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_6 = $style_6 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[6], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_6 = $style_6 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[6], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_6 = $style_6 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[6], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_6 = $style_6 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[6], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_7 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_7 = $style_7 -> Label ( -justify=>'left', -relief=>'flat', -text=>'Style 7:', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_7 = $style_7 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[7], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_7 = $style_7 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[7], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_7 = $style_7 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[7], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_7 = $style_7 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[7], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $style_8 = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-fill=>'x'); my $label_8 = $style_8 -> Label ( -justify=>'left', -text=>'Style 8:', -relief=>'flat', -background=>'white' ) -> pack(-side=>'left', -padx=>2); my $red_8 = $style_8 -> LabEntry ( -label=>'Red', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$red[8], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $green_8 = $style_8 -> LabEntry ( -label=>'Green', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$green[8], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $blue_8 = $style_8 -> LabEntry ( -label=>'Blue', -justify=>'left', -relief=>'sunken', -labelPack=>[-anchor=>'n',-side=>'left'], -textvariable=>\$blue[8], -width=>5, -state=>'normal' ) -> pack(-side=>'left'); my $dash_8 = $style_8 -> LabEntry ( -label=>'Dash', -justify=>'left', -labelPack=>[-side=>'left',-anchor=>'n'], -relief=>'sunken', -textvariable=>\$dash[8], -width=>15, -state=>'normal' ) -> pack(-side=>'right'); my $preset = $nstyles -> Frame ( -relief=>'raised' ) -> pack(-pady=>2, -fill=>'x', -padx=>2); my $preset1 = $preset -> Button ( -relief=>'raised', -text=>'Default', -command=>\&preset_default, -state=>'normal' ) -> pack(-side=>'left'); my $preset2 = $preset -> Button ( -relief=>'raised', -text=>'Rainbow', -command=>\&preset_rainbow, -state=>'normal' ) -> pack(-side=>'left'); my $preset3 = $preset -> Button ( -relief=>'raised', -text=>'InvRain', -command=>\&preset_invrain, -state=>'normal' ) -> pack(-side=>'left'); my $preset4 = $preset -> Button ( -text=>'Dash 2', -relief=>'raised', -command=>\&preset_dash2, -state=>'normal' ) -> pack(-side=>'right'); my $preset5 = $preset -> Button ( -text=>'Dash 1', -relief=>'raised', -command=>\&preset_dash1, -state=>'normal' ) -> pack(-side=>'right'); my $buttons = $mw -> Frame ( -relief=>'raised' ) -> pack(-ipady=>5, -ipadx=>5); my $but_process = $buttons -> Button ( -relief=>'raised', -text=>'Process', -command=>\&process, -state=>'normal' ) -> pack(-side=>'left', -padx=>5); my $but_quit = $buttons -> Button ( -relief=>'raised', -text=>'Quit', -command=>sub{exit}, -state=>'normal' ) -> pack(-side=>'left', -padx=>5); my $fstatus = $mw -> Frame ( -borderwidth=>3, -relief=>'ridge' ) -> pack(-ipady=>2, -ipadx=>2, -fill=>'x'); my $lstatus = $fstatus -> Label ( -justify=>'left', -relief=>'flat', -foreground=>'Brown', -textvariable=>\$status ) -> pack(-fill=>'x'); &initialize(@ARGV); MainLoop; #===vptk end===< DO NOT CODE ABOVE THIS LINE >=== # functions sub desactivate_tabs { $notebook->pageconfigure('parameters', -state, 'disabled'); $notebook->pageconfigure('nstyles', -state, 'disabled'); $oname0b->configure(-state, 'disabled'); $oname0->configure(-state, 'disabled'); $but_process->configure(-state, 'disabled'); } sub activate_tabs { $notebook->pageconfigure('parameters', -state, 'normal'); $notebook->pageconfigure('nstyles', -state, 'normal'); $oname0b->configure(-state, 'normal'); $oname0->configure(-state, 'normal'); $but_process->configure(-state, 'normal'); } sub check_color { my ($c) = @_; $red[$c] = 1 if ($red[$c] > 1); $red[$c] = 0 if ($red[$c] < 0); $green[$c] = 1 if ($green[$c] > 1); $green[$c] = 0 if ($green[$c] < 0); $blue[$c] = 1 if ($blue[$c] > 1); $blue[$c] = 0 if ($blue[$c] < 0); my $tc = sprintf("#%02x%02x%02x", $red[$c]*255, $green[$c]*255, $blue[$c]*255); eval "\$label_$c->configure(-foreground, \"$tc\")"; } sub rescan { ## start processing ($status) = ($filename=~/.*[\/\\]([^\/\\]+)/); $status = "scanning file '$status'" if ($status); ## check if the file exists if (!open (IN, "<", $filename)) { $status = "can't find file '$filename'"; desactivate_tabs; return; } ## read all the file my @f; my $k = 0; foreach my $line () { $f[$k++] = $line; } $fullfile = join("", @f); close (IN); ## check if the file is produced by gnuplot if ($fullfile !~ /\n%%Creator: gnuplot/) { $status = "'$filename' isn't a Gnuplot file"; desactivate_tabs; return; } ## get format ($format) = ($fullfile =~ /%!PS-Adobe-2\.0 *(.*)\n/); $format = ($format =~ "EPSF-2.0") ? 0 : 1; ## get solid state ($solid) = ($fullfile =~ /\/Solid ([a-z]+) def\n/); $solid = ($solid =~ "true") ? 1 : 0; ## get color state ($color) = ($fullfile =~ /\/Color ([a-z]+) def\n/); $color = ($color =~ "true") ? 1 : 0; ## get rounded state ($rounded) = ($fullfile =~ /\/Rounded ([a-z]+) def\n/); $rounded = ($rounded =~ "true") ? 1 : 0; ## get global line width ($line_width) = ($fullfile =~ /\/gnulinewidth ([.0-9]+) def\n/); ## get symbol height ($ss_h) = ($fullfile =~ /\/hpt_ ([.0-9]+) def\n/); ## get symbol width ($ss_v) = ($fullfile =~ /\/vpt_ ([.0-9]+) def\n/); ## get font ($fontname) = ($fullfile =~ /\((.+)\) findfont [.0-9]+ scalefont setfont\n/); if ($fontname =~ "Helvetica") { $font = 1; } elsif ($font =~ "Times-Roman") { $font = 0; } else { $font = -1; } ## get color and dash styles for (my $c=0; $c<9; $c++) { ($dash[$c], $red[$c], $green[$c], $blue[$c]) = ($fullfile =~ /\/LT$c { PL \[(.*)\] ([.0-9]+) ([.0-9]+) ([.0-9]+) DL } def\n/); $dash[$c] =~ s/ dl//g; check_color $c; } ## activate other tabs activate_tabs; ## create output filename ($outputname = $filename) =~ s/(\.[^.]*)$/-n$1/; } sub fileopen { # open file save dialog box $mw->Busy; my @types = (["EPS",'.eps'], ["Postscript",'.ps'], ["All files", '*']); my $file = $mw->getOpenFile(-filetypes => \@types, -defaultextension => '.eps', -title=>'file to read'); ##$file = $mw->FileSelect(-directory => '.', -title=>'file to read')->Show; $mw->Unbusy; ## set filename and rescan it return if (!$file); $filename = $file; rescan; } sub filesave { (my $file) = ($outputname =~ /.*[\/\\]([^\/\\]+)$/); # open file save dialog box $mw->Busy; my @types = (["EPS",'.eps'], ["Postscript",'.ps'], ["All files", '*']); $file = $mw->tk_getSaveFile(-filetypes => \@types, -defaultextension => '.eps', -initialfile => $file, -title=>'file to save'); ##$file = $mw->FileSelect(-directory => '.', -initialfile => $file, -title=>'file to save')->Show; $mw->Unbusy; ## set outputname $outputname = $file if ($file); } sub process { my $req; my $f = $fullfile; $status = "writing file '$outputname'"; ## change format if ($format != ($f !~ /^%!PS-Adobe-2\.0 EPSF-2\.0\n/)) { if ($format == 1) { ## Postscript $f =~ s/(%!PS-Adobe-2.0)[^\n]*(\n)/$1$2/; $f =~ s/(%%BoundingBox:)[ 0-9]*(\n)/$1 50 50 554 770$2/; $f =~ s/(%%Orientation:) Portrait(\n)/$1 Landscape\n%%Pages: (atend)$2/; $f =~ s/(%%EndProlog\n)/$1%%Page: 1 1\n/; $f =~ s/0\.050 0\.050 scale\n/0\.100 0\.100 scale\n90 rotate\n0 -5040 translate\n/; $f =~ s/$/\n%%Pages: 1/; } else { ## EPS $f =~ s/(%!PS-Adobe-2.0)(\n)/$1 EPSF-2.0$2/; $f =~ s/(%%BoundingBox:)[ 0-9]*(\n)/$1 50 50 410 302$2/; $f =~ s/(%%Orientation:) Landscape\n%%Pages: \(atend\)(\n)/$1 Portrait$2/; $f =~ s/(%%EndProlog\n)(%%Page: 1 1\n)/$1/; $f =~ s/0\.100 0\.100 scale\n90 rotate\n0 -5040 translate\n/0\.050 0\.050 scale\n/; $f =~ s/\n%%Pages: 1$//; } } ## change solid state $req = ($solid == 1) ? "true" : "false"; $f =~ s/(\/Solid )[a-z]*( def\n)/$1$req$2/; ## change color state $req = ($color == 1) ? "true" : "false"; $f =~ s/(\/Color )[a-z]*( def\n)/$1$req$2/; ## change rounded state $req = ($rounded == 1) ? "true" : "false"; $f =~ s/(\/Rounded )[a-z]*( def\n)/$1$req$2/; ## change global line width $f =~ s/(\/gnulinewidth )[0-9.]*( def\n)/$1$line_width$2/; ## change symbol height $f =~ s/(\/hpt_ )[0-9.]*( def\n)/$1$ss_h$2/; ## change symbol width $f =~ s/(\/vpt_ )[0-9.]*( def\n)/$1$ss_v$2/; ## get font (my $oldfontname) = ($f =~ /\((.+)\) findfont [.0-9]+ scalefont setfont\n/); $f =~ s/$oldfontname/$fontname/g if ($fontname !~ $oldfontname); ## change color and dash styles for (my $c=0; $c<9; $c++) { (my $st = "$dash[$c]") =~ s/ +/ dl /g; $st =~ s/$/ dl/ if ($st); $req = "[$st] $red[$c] $green[$c] $blue[$c]"; $f =~ s/(\/LT$c { PL ).*( DL } def\n)/$1$req$2/; } ## open file for writing if (!open (OUT, ">", "$outputname")) { $status = "can't open file '$outputname' for writing"; return; } ## save file print OUT $f; close (OUT); } sub preset_default { my $i = 0; foreach my $c (1, 0, 0, 1, 0, 1, 0, 1, 0.5) { $red[$i++] = $c; } $i = 0; foreach my $c (0, 1, 0, 0, 1, 1, 0, 0.3, 0.5) { $green[$i++] = $c; } $i = 0; foreach my $c (0, 0, 1, 1, 1, 0, 0, 0, 0.5) { $blue [$i++] = $c; } for (my $c=0; $c<9; $c++) { check_color $c; } } sub preset_rainbow { my $i = 0; foreach my $c (0.9, 1, 0.9, 0.1, 0.1, 0.1, 0.9, 0.5, 0.5) { $red[$i++] = $c; } $i = 0; foreach my $c (0.1, 0.4, 0.8, 0.75, 0.8, 0.1, 0, 0.3, 0.5) { $green[$i++] = $c; } $i = 0; foreach my $c (0.1, 0, 0.2, 0.1, 0.8, 0.9, 0.8, 0.1, 0.5) { $blue [$i++] = $c; } for (my $c=0; $c<9; $c++) { check_color $c; } } sub preset_invrain { my $i = 0; foreach my $c (0.9, 0.1, 0.1, 0.1, 0.9, 1, 0.9, 0.5, 0.5) { $red[$i++] = $c; } $i = 0; foreach my $c (0, 0.1, 0.8, 0.75, 0.8, 0.4, 0.1, 0.3, 0.5) { $green[$i++] = $c; } $i = 0; foreach my $c (0.8, 0.9, 0.8, 0.1, 0.2, 0, 0.1, 0.1, 0.5) { $blue [$i++] = $c; } for (my $c=0; $c<9; $c++) { check_color $c; } } sub preset_dash1 { my $i = 0; foreach my $c ("", "4 2", "2 3", "1 1.5", "5 2 1 2", "4 3 1 3", "2 2 2 4", "2 2 2 2 2 4", "2 2 2 2 2 2 2 4") { $dash [$i++] = $c; } } sub preset_dash2 { my $i = 0; foreach my $c ("", "4 1 1 1", "4 2 2 2", "4 3 3 3", "4 4", "4 4 1 1", "4 4 2 2", "4 4 3 3" , "2 2") { $dash [$i++] = $c; } } sub initialize { ## desactivate tabs desactivate_tabs; ## add binding $fname0->bind("", \&rescan); $ss_height->bind("", sub{$ss_h += 0.5;}); $ss_height->bind("", sub{$ss_h -= 0.5; $ss_h = 0 if ($ss_h<0);}); $ss_width->bind("", sub{$ss_v += 0.5;}); $ss_width->bind("", sub{$ss_v -= 0.5; $ss_v = 0 if ($ss_v<0);}); $l_width0->bind("", sub{$line_width += 1;}); $l_width0->bind("", sub{$line_width -= 1; $line_width = 0 if ($line_width<0);}); $fontothername->bind("", sub{$font=-1}); for (my $c=0; $c<9; $c++) { eval "\$red_$c->bind(\"\", sub{\$red[$c]+=0.004; check_color $c;})"; eval "; \$red_$c->bind(\"\", sub{\$red[$c]-=0.004; check_color $c;})"; eval "\$red_$c->bind(\"\", sub{check_color $c;})"; eval "\$red_$c->bind(\"\", sub{check_color $c;});"; eval "\$green_$c->bind(\"\", sub{\$green[$c]+=0.004; check_color $c;})"; eval "\$green_$c->bind(\"\", sub{\$green[$c]-=0.004; check_color $c;})"; eval "\$green_$c->bind(\"\", sub{check_color $c;}))"; eval "\$green_$c->bind(\"\", sub{check_color $c;});"; eval "\$blue_$c->bind(\"\", sub{\$blue[$c]+=0.004; check_color $c;})"; eval "\$blue_$c->bind(\"\", sub{\$blue[$c]-=0.004; check_color $c;})"; eval "\$blue_$c->bind(\"\", sub{check_color $c;}))"; eval "\$blue_$c->bind(\"\", sub{check_color $c;});"; } ## proceed comand line argument $filename = $outputname = ""; foreach my $arg (@_) { if ($arg =~ "-v") { print "gppp version $version\n"; exit; } if ($arg =~ "-h") { print "usage: gpp \n"; exit; } $filename = $arg; } rescan if ($filename); }