[MacPerl] Re: [MacPerl-Toolbox] Using QuickDraw DITHER

[kpreid@attglobal.net (Kevin Reid)]

> I've been messing around with GD.pm, and I got to wondering if there's any
> way to dither the output as it looks very primative. Where and how would I
> start to use the  'ditherPix' QD off screen command to this end

This works on PICTs and not GIFs, but it's the best I could do, and the
system will automatically convert GIF to PICT for you if you use the
program's file dialog.

#!perl -w

# Dither Tool v1.0
# by Kevin Reid
#
# Dithers PICT files down to any bit depth.
# 
# Version History
# 1.0
#   * Initial release

use Mac::Windows;
use Mac::QuickDraw;
use Mac::Events;
use Mac::StandardFile;
use Mac::QDOffscreen;

use strict;
use vars qw(
  $GWorld
  $pdrect
  $phand
  $win
  $sf
  $Click
  $InFile
  $OutFile
  $UsedStdFile
);

use constant WAITTIME => 20; # reduce this if you want it to run faster
use constant DEPTH => 4; # output bit depth
use constant SUFFIX => '.' . DEPTH . 'pic';

######### ######### ######### ######### ######### ######### ######### #########

InitViewWindow();

unless (@ARGV) {
  $sf = StandardGetFile(undef, 'PICT');
  exit unless $sf->sfGood;
  push @ARGV, $sf->sfFile;
  $UsedStdFile = 1;
}

foreach $InFile (grep {MacPerl::GetFileInfo($_) eq 'PICT'} @ARGV) {
  ($OutFile = $InFile) =~ s/\.pict$//;
  $OutFile .= SUFFIX;
  if ($UsedStdFile) {
    my $res = StandardPutFile("Save dithered PICT as:", ($InFile =~ /:([^:]*)$/)[0] . SUFFIX);
    next if !$res->sfGood;
    $OutFile = $res->sfFile;
  }
 
  $phand = ReadPICTFromFile($InFile);
  $pdrect = NormalizePRect($phand);
  $GWorld = MakeGWorldFromPict($phand);

  SetWTitle($win->window, ($InFile =~ /:([^:]*)$/)[0]);
  SizeWindow($win->window, $pdrect->right, $pdrect->bottom);
  SetPort $win->window;
  InvalRect $pdrect;

  Wait();
  exit unless $win->window;

  (undef, $GWorld) = UpdateGWorld(
    $GWorld, DEPTH, $pdrect,
    MakeNil('CTabHandle'), MakeNil('GDHandle'),
    (stretchPix | ditherPix)
  );
  SetPort $win->window;
  InvalRect $pdrect;

  Wait();
  exit unless $win->window;

  SavePictFromWindow($win, $OutFile);

  DestroyGWorld($GWorld); $GWorld = undef;
  KillPicture $phand if $phand; $phand = undef;
}

exit;

END {
  DestroyGWorld($GWorld);
  $win->dispose if $win;
  KillPicture $phand if $phand;
}

######### ######### ######### ######### ######### ######### ######### #########

sub ltwh {new Rect ($_[0], $_[1], $_[0] + $_[2], $_[1] + $_[3])}

sub MakeNil {
  my $v = 0;
  return bless \$v, $_[0];
}

sub NormalizePRect {
  my $prect = $_[0]->picFrame;
  return OffsetRect($prect, -$prect->left, -$prect->top);
}

sub Wait {
  my $t = TickCount();
  WaitNextEvent until TickCount() > $t + WAITTIME;
}

sub InitViewWindow {
  $win = new MacColorWindow (
    new Rect(30, 70, 200, 200),
    "", 1, noGrowDocProc, 1);
  $win->sethook(drawgrowicon => sub {});
  $win->sethook(click => sub {$Click = 1});

  $win->sethook(redraw => sub {
    if ($GWorld) {
      LockPixels(GetGWorldPixMap($GWorld));
      CopyBits($GWorld->portBits, $win->window->portBits,
        $GWorld->portRect, $win->window->portRect, ditherCopy);
      UnlockPixels(GetGWorldPixMap($GWorld));
    }
  });
}

sub MakeGWorldFromPict {
  my ($pict) = @_;

  my $drect = NormalizePRect($pict);
  my ($OrigP, $OrigD) = GetGWorld();
  my $world = NewGWorld(32, $drect) or die $^E;
  SetGWorld($world);
  LockPixels(GetGWorldPixMap($world));
  EraseRect($drect);
  DrawPicture $pict, $drect;
  UnlockPixels(GetGWorldPixMap($world));
  SetGWorld($OrigP, $OrigD);
  return $world;
}

sub ReadPICTFromFile {
  my ($file) = @_;
  my $phand;
  local *PICT;
  open PICT, $file or die "can't open PICT: $!";
  seek PICT, 512, 0;
  local $/; # implicit undef $/
  return new PicHandle <PICT>;
}

sub DestroyGWorld {
  my ($world) = @_;
  if (defined $world) {
    my $pm = GetGWorldPixMap($world);
    UnlockPixels($pm) if $pm;
    DisposeGWorld($world);
  }
}

sub SavePictFromWindow {
  my ($wind, $file) = @_;
  my $pic = OpenCPicture($win->window->portRect, 72, 72);
  $wind->redraw;
  ClosePicture;

  local *PICT;
  open PICT, "> $file" or die "Could not open $file: $!";
  print PICT ("\0" x 512);
  bless $pic, 'Handle';
  print PICT $pic->get;
  bless $pic, 'PicHandle';
  close PICT;
  MacPerl::SetFileInfo('ttxt', 'PICT', $file);
  KillPicture $pic;
}

__END__


-- 
 Kevin Reid: |    Macintosh:      
  "I'm me."  | Think different.

# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org