Re: [MacPerl] accessing an image file from MacPerl?

[Chris Nandor <pudge@pobox.com>]

At 09.31 -0500 1999.01.13, Adam Witney wrote:
>I have an image file and i want to allow users to access it through a web
>page, but i want the user to be able to select a region of the image from a
>text link....ie click on a text link and only show a small section of the
>image bounded by specific coordinates (depending on which link is clicked).
>My question is would i be able to use Macperl to read an image file and and
>only select and return a small portion of the image? Also, if this is not
>possible with perl....could anybody point me in the direction of way in
>which this may be done?

I did a demo for WWDC last year that did something similar.  You would
click on a small portion of an image, and it would zoom in on the image.
It had to be a GIF, as I did it with GD.

This version here actually acted as its own webserver on port 9000,
accepting hits directly.  I forget why.  :)  But we had a separate server
running to serve the images themselves.  Anyway, here's the code, have fun.

Note that this image was huge, 1MB or something, so you could get great
resolution when zooming.  As a consequence, MacPerl needs to have enough
RAM to keep the image in memory, so it only needs to read it once.

Oh, that's why it is its own webserver.  So it only launches once.  There
is a compiled AppleScript, it is compiled only once.  There is a huge image
to read into memory, and it is read only once.

This program also shows the resulting image on the host machine, in JPEG View.

#!perl -wl
#
# demo_gd.cgi - demonstrate CGI script that uses Apple Events
#
# Written by Chris Nandor, 9805.
# Tweaked by Rich Morin,   9805.

use strict;
use GD;
use Mac::AppleEvents;
use Mac::Apps::Launch;
use Mac::Files;
use Mac::MoreFiles;
use Mac::OSA;
use Mac::Components;
use CGI qw(:standard);
use IO::Socket;

my(
    $infile, $outfile, $tmpfile, $script,
    $app, $cgi, $h, $w, @files, @pts,
    $img1, $img2, $img3, $folder, $UserTalk,
    $crlf, $cr, $lf, $serv, $client, $host
);

$UserTalk = OpenDefaultComponent(kOSAComponentType(), 'ascr');
END {CloseComponent($UserTalk)}
chomp($host = `hostname`);
$crlf = "\015\012";
$cr = "\015";
$lf = "\012";

$w = 300;
$h = 224;

$img1    = "http://$host:8080/Escape-1.gif";
$img3    = "http://$host:8080/blank.gif";
$folder  = "PowerPudge:Desktop Folder:demo";

#  @files = glob("$folder:EscapeTmp-*.gif");
#  pop(@files);
#  foreach $tmpfile (@files) { unlink($tmpfile); }

$infile  = "$folder:Escape-6.gif";
$app     = 'JVWR';

LaunchApps([$app], 1) or die $^E;

$serv = IO::Socket::INET->new(
    Listen=>2,
    LocalAddr=>'192.168.0.3',
    LocalPort=>9000,
    Proto=> 'tcp'
);
die $@ if ! $serv;

$cgi    = CGI->new();
$script = compile_script();

{
    local($\) = $crlf;
    while ($client = $serv->accept()) {
        my $x = <$client>;
        select($client);
        $x =~ s/\s//g;
        $x =~ /submit.x=(\d+)&submit.y=(\d+)/; #==
        if (!$1 || !$2) {
            print_form();
            close($client);
        } else {
            $img2    = 'EscapeTmp-' . time() . '.gif';
            $outfile = "$folder:$img2";
            $img2    = "http://$host:8080/$img2";
            @pts = ($1, $2);
            make_picture(@pts);
            print_form(@pts);
            close($client);
            open_picture();
        }
    }
}

sub print_form {
    my(@pts) = @_;
    print "HTTP/1.0 200 OK";
    print $cgi->header();
    print $cgi->start_html(   -'title' => 'MacPerl Demo' );
    print $cgi->start_form(   -method  => 'GET',
                              -action  => '/' );
    print $cgi->image_button( -name    => 'submit',
                              -src     => $img1 );
    print $cgi->img(        { src      => (@pts ? $img2 : $img3),
                              border   => 2,
                              width    => $w,
                              height   => $h } );
    print $cgi->end_form();
    print $cgi->end_html();
}

sub open_picture () {
    my($evt, $rep, $obj, @params);

    # close documents in viewing app.
    OSADispose($UserTalk, OSAExecute($UserTalk, $script, 0, 0));

    # open document with viewing app.
    $obj = 'obj{want:type(cobj), from:null(), ' .
        'form:enum(name), seld:TEXT(@)}';
    @params = ("'----':$obj, usin:$obj", $outfile,
        $Application{$app});

    $evt = AEBuildAppleEvent(qw/aevt odoc sign MACS/, 0, 0, @params)
        or die $^E;
    $rep = AESend($evt, kAEWaitReply()) or die $^E;

    AEDisposeDesc($evt);
    AEDisposeDesc($rep);
}

sub compile_script () {
    my($script, $id);
    $script = AECreateDesc('TEXT', <<EOS);
tell application "JPEGView"
    close windows
end tell
EOS

    $id = OSACompile($UserTalk, $script, 0) or die $^E;
    AEDisposeDesc($script);
    $id;
}


sub limit ($$$) {
    my($x, $lo, $hi) = @_;
    $x = $lo if ($x < $lo);
    $x = $hi if ($x > $hi);
    return($x);
}

sub make_picture ($$) {
    my($x, $y, $w2, $h2, $inimg, $outimg) = @_;
    $w2 = $w/2;
    $h2 = $h/2;

    open(IN, "<$infile") or die $!;
    $inimg  = GD::Image->newFromGif(\*IN) or die $!;
    $outimg = GD::Image->new($w, $h);

    $x *= 6;  $x = limit($x, $w2, 1800 - $w2);  $x -= $w2;
    $y *= 6;  $y = limit($y, $h2, 1341 - $h2);  $y -= $h2;

    $outimg->copy($inimg, 0, 0, $x, $y, $w, $h);

    open(OUT, ">$outfile") or die $!;
    print OUT $outimg->gif();
    close(OUT);
    close(IN);

    MacPerl::SetFileInfo($app, 'GIFf', $outfile);
}

__END__


--
Chris Nandor          mailto:pudge@pobox.com         http://pudge.net/
%PGPKey = ('B76E72AD', [1024, '0824090B CE73CA10  1FF77F13 8180B6B6'])

***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch