[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[MacPerl] Switch Desktop Pictures



This goes through the pictures in your Appearance folder and picks a random
JPEG file.

I create a compiled AppleScript like so:

  tell application "Finder"
    open alias "HD:path:to:my:script.plx"
  end tell

And place it in my OSA Menu.

This script will pick an image at random, set it as your desktop, and then
ask if it is OK ... clicking No makes the script pick another one.  Need
Appearance Control Panel and tested only with Mac OS 8.5.

#!perl -wl
# switch_desktop_pic.plx
# pudge@pobox.com
use strict;
use Mac::AppleEvents::Simple;
use Mac::Files;
use Mac::Processes;
use File::Find;

set_it(get_it());
until (MacPerl::Answer('Is It Good?', 'Yes', 'No')) {
    set_it(get_it());
}
quit_it();

sub get_it {
    my $dir = FindFolder(kOnSystemDisk(), kSystemFolderType()) .
        ':Appearance:';
    my @pics;
    find(sub {
        my $name = $File::Find::name;
        push @pics, $name if MacPerl::GetFileInfo($name) &&
            MacPerl::GetFileInfo($name) eq 'JPEG';
    }, $dir);
    return $pics[rand(@pics)];
}


sub set_it {
    my($file) = @_;
    do_event(qw/aevt odoc MACS/, "'----':alis(\@\@)",
        NewAliasMinimal(FindFolder(kOnSystemDisk(), kControlPanelFolderType())
        . ':Appearance')  # launch control panel
    );
    die "No file $file\n" if ! -e $file;

    do_event(qw/core setd apcp/,  # set picture
        q"'----':obj {want:type(prop), from:obj {want:type(cmon), " .
        q"from:null(), form:indx, seld:1}, form:prop, seld:type(dpic)}, " .
        q"data:alis(@@)", NewAliasMinimal($file)
    );

    SetFrontProcess(GetCurrentProcess()); # so we can ask the question
}

sub quit_it {
    do_event(qw/aevt quit apcp/);  # quit control panel
}

--
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