[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
Re: [MacPerl] YourMines

To: macperl@macperl.org (MacPerl List)
Subject: Re: [MacPerl] YourMines
From: kpreid@ibm.net (Kevin Reid)
Date: Wed, 25 Aug 1999 08:20:15 -0400
In-Reply-To: <199908242028.NAA19166@pacific.telebyte.com>
Organization: Reid & Hoffman
> Kevin Reid, <kpreid@ibm.net> wrote:
> > (I wrote my own text-display engine to support showing pictures in the
> > window. If anyone's interested, I could turn it into a module so it
> > could be used in other programs.)
>
> Yes, yes!  Please do!  I've been admiring this code very much, thank you!

Done. Here is the module, and a example script.

package Mac::TextViewPane;
# by Kevin Reid <kpreid@ibm.net>

use Carp;
use Mac::Pane;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::Fonts;
use Mac::Resources;
use Mac::Memory;

caller or die;
$VERSION = '1.00';
@ISA = qw(Mac::Pane);

%stdparam = map {($_, 1)} qw(
  Bounds Font Size Text Window
  MarginLeft MarginRight MarginTop
  ShowBorder
);

=head1 Methods

=over 4

=cut

## Pane Methods
########################################################################

=item C<$pane = new Mac::TextViewPane PARAMS>

Creates a new text pane and returns it. Parameters are key-value
pairs, keys are:

  Name        Description                                Default
  ----------- ------------------------------------------ -------------
  Bounds      Outer rectangle of text pane.              (-1, -1, 201,
301)
  Font        Name of font to use.                       Geneva
  Size        Text size.                                 10
  Text        Text to display.                           ''
  Window      Window to which the pane is attached.      none
  MarginLeft  Space to leave between left edge and text. 4
  MarginRight                                            2
  MarginTop                                              2
  ShowBorder  Draws a rectangle around the pane.         true

=cut

sub new {
  my ($class, %param) = @_;

  foreach (keys %param) {
    if (!$stdparam{$_}) {
      carp "Unknown parameter: $_" if $^W;
      delete $param{$_};
    }
  }

  my $self = bless {
    Bounds => new Rect (-1, -1, 201, 301),
    Font => GetFontName(geneva), Size => 10,
    Text => '',
    MarginLeft => 4,
    MarginRight => 2,
    MarginTop => 2,
    ShowBorder => 1,
  }, $class;
  @{$self}{keys %param} = values %param;

  $self->SetStyle($self->{Font}, $self->{Size});
  $self->SetText($self->{Text});
  
  $self;
}

=item C<$win-E<gt>add_pane($pane)>

Attaches the pane to the window.

=cut

sub attach {
  my ($self, $window) = @_;
  $self->{window} = $window;
}

=item C<$win-E<gt>remove_pane($pane)>

Detaches the pane from the window.

=cut

sub detach {
  my ($self, $window) = @_;
  $self->{window} = undef;
}

sub redraw {
  my ($self, $win) = @_;

  $self->{picts} or $self->_LoadPicts;
  my $clipr = CopyRgn $win->window->clipRgn;
  ClipRect($self->{Bounds});

  TextSize($self->{Size}); TextFont($self->{Font});
  my $leftpos = $self->{Bounds}->left + $self->{MarginLeft};
  my $v = $self->{Bounds}->top + $self->{voffset} + $self->{MarginTop};
  my $linewid = $self->{Bounds}->right - $self->{Bounds}->left -
$self->{MarginLeft} - $self->{MarginRight};

  for (my $l = 0; $l < @{$self->{text_lines}}; $l++) {
    MoveTo $leftpos, $v;
    my $t = $self->{text_lines}[$l];
    if ($t =~ s/\[PICT (\d+) (?:(\w+)(?:[+\-](\d+))?)?\s*(\sNOGAP)?]//)
{
      my $ps = $self->{picts}{$1};
      my $align = lc $2;
      my $extra = defined $3 ? $3 : 3;
      my $ng = $4;
      my $h;
      if ($align eq 'center') {
        $h = ($linewid - $ps->{rect}->right) / 2;
      } elsif ($align eq 'right') {
        $h = ($linewid - $ps->{rect}->right) - $extra;
      } else {
        $h = $extra;
      }
      DrawPicture $ps->{pict}, OffsetRect($ps->{rect}, $leftpos + $h, $v
- $self->{voffset});
      $v += $ng ? $self->{lineheight} : $ps->{rect}->bottom + 1;
    } else {
      $v += $self->{lineheight};
    }
    TextFace ($t =~ s/^\[BOLD]//) ? bold : normal;
    DrawString $t;
    # Line(0, -3);
    last if $v - $self->{lineheight} > $self->{Bounds}->bottom;
  }
  FrameRect($self->{Bounds}) if $self->{ShowBorder};
  SetClip $clipr;
  DisposeRgn $clipr;
}

sub DESTROY {
  my ($self) = @_;

  $self->ClearPictCache;
}

## Public Methods
########################################################################

=item C<$pane-E<gt>SetBounds(LEFT, TOP, RIGHT, BOTTOM)>

Changes the bounding rectangle of the pane.

=cut

sub SetBounds {
  my ($self, $left, $top, $right, $bot) = @_;

  $right = $left + $self->{minwid} if $right < $left + $self->{minwid};
  $self->{Bounds} = new Rect ($left, $top, $right, $bot);
  $self->_CalcWraps;
}

=item C<$pane-E<gt>SetStyle(FONT, SIZE)>

Changes the font and size used in the pane.

=cut

sub SetStyle {
  my ($self, $font, $size) = @_;

  $self->{Font} = GetFNum $font or croak "Font '$font' does not exist";
  $self->{Size} = $size;

  my $state = GetPenState;
  TextFont($self->{Font}); TextSize($size);
  my ($ascent, $descend, $maxwid) = GetFontInfo();
  SetPenState $state;

  $self->{lineheight} = $ascent + $descend;
  $self->{voffset} = $ascent;
  $self->{minwid} = $maxwid + $self->{MarginLeft} + $self->{MarginRight}
+ 5;
}

=item C<$pane-E<gt>SetText(TEXT)>

Changes the text displayed in the pane.

=cut

sub SetText {
  my ($self, $text) = @_;

  $self->{Text} = $text;
  $self->_LoadPicts;
  $self->_CalcWraps;
}

=item C<$pane-E<gt>ClearPictCache>

Disposes of the cached pictures and frees the memory used.

=cut

sub ClearPictCache {
  my ($self) = @_;

  foreach (values %{$self->{picts}}) {bless $_->{pict}, 'Handle';
DisposeHandle($_->{pict})}
  $self->{picts} = undef;
}

## Internal Methods
########################################################################

sub _LoadPicts {
  my ($self) = @_;

  defined $self->{lineheight} or croak "_LoadPicts called before line
height set.";
  $self->{pict_total} = 0;
  while ($self->{Text} =~ /\[PICT (\d+) [^]]+]/g) {
    unless ($self->{picts}{$1}) {
      my $pict = GetResource 'PICT', $1 or die $^E;
      DetachResource $pict or die $^E;
      bless $pict, 'PicHandle';
      my $p = {pict => $pict};
      my $r = $p->{pict}->picFrame;
      $p->{rect} = OffsetRect($r, -$r->left, -$r->top);
      $self->{picts}{$1} = $p;
    }
    $self->{pict_total} += $self->{picts}{$1}{rect}->bottom + 1 -
$self->{lineheight};
  }
  1;
}

sub _CalcWraps {
  my ($self) = @_;

  local $_;
  $self->{text_lines} = [];
  my $linewid = $self->{Bounds}->right - $self->{Bounds}->left -
$self->{MarginLeft} - $self->{MarginRight};

  my $state = GetPenState;
  TextSize($self->{Size}); TextFont($self->{Font});

  OUTER: foreach (split /\n/, $self->{Text}) {
    if (/\[PICT/) {
      push @{$self->{text_lines}}, $_;
      next;
    }
    my $bold = ($_ =~ s/^\[BOLD]//);
    TextFace $bold ? bold : normal;
    my $t = $_;
    {
      (my $char, $ledge, undef) = PixelToChar($t, 0, $linewid,
smMiddleStyleRun);
      $char-- unless $ledge;
      if ($char < length $t) {
        my $chn = $char;
        my $p;
        $chn-- while $chn > 1 and ($p = substr($t, $chn, 1) !~ /\s/);
        $char = $chn unless $p;
      }
      my $out = substr($t, 0, $char);
      substr($t, $char) =~ /^(\s+)/;
      $char += length $1;
      push @{$self->{text_lines}}, ($bold ? '[BOLD]' : '') . $out; $t =
substr($t, $char);
      last OUTER if @{$self->{text_lines}} > ($self->{Bounds}->bottom -
$self->{Bounds}->top) / $self->{lineheight};
      redo if $t;
    }
  }
  SetPenState $state;

  if ($self->{window}) {
    SetPort my $p = $self->{window}->window;
    InvalRect $p->portRect;
  }
}

=back

=head1 Embedded Formatting Commands

You can place some special commands in the text:

=over 4

=item [BOLD]

Causes the line to be displayed in bold. Must be at the beginning
of the line.

=item [PICT E<lt>idE<gt> E<lt>positionE<gt>]

Inserts a PICT image resource at the line. E<lt>idE<gt> is the ID of the
PICT resource. E<lt>positionE<gt> is one of LEFT, CENTER, or
RIGHT. For LEFT or RIGHT, the amount of indenting may be specified.

Examples:

  [PICT 128 CENTER]
  [PICT 129 LEFT]
  [PICT 130 RIGHT-10]
  [PICT 131 RIGHT+10]      same as previous
  [PICT 132 LEFT+50]
  [PICT 133 RIGHT]

=back

=cut

__END__











Example:

#!perl -w

use Mac::Events;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::TextViewPane;
use Mac::Fonts;

$| = 1;
sub ltwh ($$$$) {
  my ($left, $top, $width, $height) = @_;
  new Rect ($left, $top, $left+$width, $top+$height);
}

$win = new MacColorWindow (
  ltwh(10, 50, 400, 130+13*15),
  'Text Display Demo',
  1,
  zoomDocProc,
  1,
);

my $pane = new Mac::TextViewPane (
  Text => <<'EYUCK',
[BOLD]Writing custom packaging options for MacPerl              Matthias
Neeracher 24Nov94

Often, to be able to conveniently use MacPerl scripts to do a job, it
helps to combine them with some glue code - e.g., for droplets. Starting
with version 4.1.4, it is now possible to add custom packaging options
to MacPerl. This file  describes how to specify them and their effects.

[PICT 129 CENTER]

[BOLD]FORMAT OF MACPERL FILES

Every file saved by MacPerl 4.1.4 contains the following resources (most
of these were also present in earlier versions):

'TEXT' (128, "!")       The script itself, unless the file is a plain
text file, in which  case the script will be saved in the resource fork.
'MrPL' (128)            The package ID. Currently defined package IDs
are:
                'TEXT'          A plain text file.
                'SCPT'          A droplet.
                'MrP7'          A system 7 runtime.
                'MrP6'          A universal runtime.
                'WWW‡'          A MacHTTP CGI file.

'TFSP' (255)            The printing setup for the file.
[PICT 128 RIGHT-20]
[PICT 128 LEFT+20]
EYUCK
);
$win->add_pane($pane);

$win->sethook(layout => sub {
  my $br = $win->window->portRect->botRight;
  $pane->SetBounds(-1, -1, $br->h - 14, $br->v + 1);
});
$win->layout;

# These next two hooks add live dragging and resizing.
# They can be copied into any MacPerl script without changes
#   (except for $win).

$win->sethook(grow => sub {
  my ($w, $pt) = @_;

  my $port = $w->window;
  my $offset = SubPt LocalToGlobal($port->portRect->botRight), $pt;
  my ($spt, $opt) = new Point (0, 0);
  while (StillDown()) {
    $opt = $spt;
    $spt = SubPt $offset, GetMouse;
    unless (EqualPt $opt, $spt) {
      SizeWindow $port, $spt->h < 80 ? 80 : $spt->h, $spt->v < 80 ? 80 :
$spt->v;
      $w->layout;
      EraseRect($port->portRect);
      $w->redraw;
    }
  }
  1;
});

$win->sethook(drag => sub {
  my ($w, $pt) = @_;

  my $port = $w->window;
  my $offset = GlobalToLocal($pt);
  my ($spt, $opt) = new Point (0, 0);
  while (StillDown()) {
    $opt = $spt;
    $spt = SubPt $offset, LocalToGlobal(GetMouse);
    unless (EqualPt $opt, $spt) {
      MoveWindow $port, $spt->h, $spt->v, 0;
      $w->update;
    }
  }
  1;
});

while ($win->window) {
  WaitNextEvent;
}


END {$win->dispose if $win}

__END__

===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org
References:
- Re: [MacPerl] YourMines
  - From: Brian McNett <webmaster@mycoinfo.com>
Prev by Date: [MacPerl] Mac::Controls - Oops!
Next by Date: RE: [MacPerl] MLDB question
Prev by thread: Re: [MacPerl] YourMines
Next by thread: RE: [MacPerl] YourMines
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net