filemorph

Check-in [138725ee06]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix cross-platform Windows call
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 138725ee06eda2227f65724e9c234c2a64ddac3c
User & Date: kevin 2015-10-11 15:36:54
Context
2015-10-11
15:41
Updated build check-in: 82b813cad8 user: kevin tags: trunk
15:36
Fix cross-platform Windows call check-in: 138725ee06 user: kevin tags: trunk
05:23
Cleanup of Windows calls check-in: 1109d376bd user: kevin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to filemorph.pl.

9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24




25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
use FindBin qw($Bin);
use Config;
use File::Spec::Functions;
use File::Copy::Recursive qw(dircopy );
use Env qw(HOME);
use File::Path qw(remove_tree);
use File::Copy::Recursive qw (rmove);


BEGIN {

    if ( $Config{osname} eq "darwin" ) {
        my $frameworkpath = "$Bin/Contents/Frameworks/Tcl.framework/Tcl";
        $ENV{'PERL_TCL_DL_PATH'} = $frameworkpath;
        return;
    }
    if ( $Config{osname} eq "MSWin32" ) {




        if ( exists $ENV{PAR_PROGNAME} ) {
            my $libtarget = "$ENV{TMP}/lib";
            my $libsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/lib";
            rmove( $libsrc, $libtarget );
            my $bintarget = "$ENV{TMP}/bin";
            my $binsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/bin";
            rmove( $binsrc, $bintarget );
        }
    }

}

use strict;
use warnings;

use Tkx;

our $IS_AQUA    = &Tkx::tk_windowingsystem eq "aqua";
our $IS_WINDOWS = &Tkx::tk_windowingsystem eq "win32";








>






<


>
>
>
>












|







9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
use FindBin qw($Bin);
use Config;
use File::Spec::Functions;
use File::Copy::Recursive qw(dircopy );
use Env qw(HOME);
use File::Path qw(remove_tree);
use File::Copy::Recursive qw (rmove);
our $DOS;

BEGIN {

    if ( $Config{osname} eq "darwin" ) {
        my $frameworkpath = "$Bin/Contents/Frameworks/Tcl.framework/Tcl";
        $ENV{'PERL_TCL_DL_PATH'} = $frameworkpath;

    }
    if ( $Config{osname} eq "MSWin32" ) {
        require Win32::GUI;
        Win32::GUI->import();
        $DOS = Win32::GUI::GetPerlWindow();
        Win32::GUI::Hide($DOS);
        if ( exists $ENV{PAR_PROGNAME} ) {
            my $libtarget = "$ENV{TMP}/lib";
            my $libsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/lib";
            rmove( $libsrc, $libtarget );
            my $bintarget = "$ENV{TMP}/bin";
            my $binsrc    = "$ENV{PAR_TEMP}/inc/script/Tcl/bin";
            rmove( $binsrc, $bintarget );
        }
    }

}

#use strict;
use warnings;

use Tkx;

our $IS_AQUA    = &Tkx::tk_windowingsystem eq "aqua";
our $IS_WINDOWS = &Tkx::tk_windowingsystem eq "win32";

535
536
537
538
539
540
541




542
543
544
545
546
547
548

Tkx::MainLoop();
exit;

###----subroutines

sub shutdown {




    &Tkx::exit;
}

sub makeImage {

    my $data = "iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABGdBTUEAALGPC/xh
BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA







>
>
>
>







539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556

Tkx::MainLoop();
exit;

###----subroutines

sub shutdown {

    if (IS_WINDOWS) {
        Win32::GUI::Show($DOS);
    }
    &Tkx::exit;
}

sub makeImage {

    my $data = "iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABGdBTUEAALGPC/xh
BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA