Re: [MacPerl] StyledText data into a record of text and styl

[Alan Fry]

At 3:02 pm +0900 16/03/01, Nobumi Iyanaga wrote:

>If I could write all this in MacJPerl, I would be very glad.  But it 
>seems that the data that I get from (the code by Alan Fry):
>
>       use Mac::LowMem;
>         my $lmh = LMGetScrapHandle;
>         my $str = $lmh->get;
>
>seems not exactly the same thing as the styled text that I get with 
>the AppleScript:
>
>set stxt to the clipboard as styled text

I think in fact the string returned from '$lmh->get' is in fact the 
same as that from your AppleScript with the exception of a 'long' 
number at the beginning which specifies the number of characters in 
the 'styl' string.

Your friend has done all the clever stuff and worked out the 
structure of that string. Appended below is a script which 
incorporates 'readStylTest2.pl'. I hope he will accept my apologies 
for modifying his script somewhat in the process.

I have tried this using 'SimpleText', 'TexEdit', 'BBEdit', 'MacPerl' 
'Acrobat' 'WASTE', and 'MS_Word' (surprisingly) with success. 
'WriteNow' however appears not to save 'styl' information on the 
clipboard.

I hope this is helpful,

Alan Fry

-----------

#!perl

# Based largely on 'readStylTest2.pl'

use Mac::LowMem;
use Mac::Fonts;

my $lmh = LMGetScrapHandle;
my $str = $lmh->get;

my $fmt = "%7s|%7s|%7s|%8s|%9s|%7s|%10s|%6s|%6s|%6s|\n";
my @heading = qw(offset height ascent font_ID font_name
                  style font_size Red Green Blue);
my @line = qw(------- ------- ------- -------- ---------
                ------- ---------- ------ ------ ------);

# a debatable line to keep Microsoft 'Word' happy 
if ($str =~ /stylTEXTPICTNATVOLNK/) {$str = $'};

if ($str =~ /TEXT/) {
     my @l = unpack("La*", $');
     print substr($l[1], 0, $l[0]), "\n\n"
}
else {
     print "No TEXT on clipboard\n";
     exit
}

if ($str =~ /styl\0/) {
     my @l = unpack("LSa*", chr(0).$');
     my $nsty = $l[1];
     print "Number of styles = $nsty\n";
     print "--------------------\n\n";
     printf $fmt, @heading;
     printf $fmt, @line;

     my $all_styles = substr($l[2], 0, $l[0]-2);
     my($offset, $styl);

     for($offset = 0, $styl = 0; $styl < $nsty; ++$styl, $offset += 20) {
         my @elements = unpack("NnnnB8Cnnnn", substr($all_styles, $offset, 20));

         my $face = '';
         foreach(qw{B I U O S C E R}) { $face .= $_ if chop($elements[4]) }
         $face = $face ? $face : 'Plain';

         splice(@elements, 4, 2, GetFontName($elements[3]), $face);
         printf $fmt, @elements;
     }

}
else {
     print "No 'styl' present";
}