Thank you everyone for your input about the issue of reading StyledText
data in MacPerl. Thanks to the OSAX "Sigma Coercions" mentioned by Gero
Herrmann, and to the scripts by Alan Fry (who so kindly sent me some of
them off list), I am now able to get StyledText data with an AppleScript
script or a Frontier script, send it to MacPerl, and read the content of
"styl" (and text) data.
Now, what I would like to do is to generate StyledText data in MacPerl,
return it back to the AppleScript or Frontier, and "paste" it to the
original application (for example, Style, Tex-Edit Plus or Nisus
Writer...). [I prefer the method via AppleScript or Frontier, because I am
perhaps a little better at ease in these languages than in Perl, and also
because some editors have macros/scripts menu, from which it is possible to
call directly AppleScript scripts...]
My goal, at least for now, is to be able to do some special conversion of
text, based on the font information. As I explained in my web page:
http://www.bekkoame.ne.jp/~n-iyanag/researchTools/diacriticalfontsandunicode
.html
there are many special diacritical fonts for the transcription of Asian
languages. As there is almost no standard for the code mapping of these
fonts, it is often difficult to convert text written with Font_A to Font_B.
But if we have some conversion table, and if we can read StyledText data in
MacPerl, *and if we can generate StyledText data in it*, it would be easy
to do such conversions.
Here is a rough idea:
my @specialFontNames = ("Appeal", "Times_Norman");
my @conversionTables = ("abcdef", "hijklm");
my @styles = ();
...
if ($currentFont eq "Appeal") {
$currentText = $_;
%currentStylRecord = $styl[$x];
$toFind = $conversionTables[0];
$toReplace = $conversionTables[1];
$currentText =~ tr/$toFind/$toReplace/;
$currentStylRecord{font} = packed value of "Times_Norman"'s fontID;
...
}
...
print "{<<class ktxt>>:\"$text\", <<class ksty>>:<<data styl$stylData>>}";
I would call this Perl script from an AppleScript (or Frontier) script
which would do something like this...:
set stxt to ""
tell application "Style"
set stxt to the selection of the front document as styled text
end tell
set stxtRecord to stxt as record
set txt to <<class ktxt>> of stxtRecord
set styl to <<class ksty>> of stxtRecord
set styl to styl as hex string
set res to ""
tell application "MacJPerl"
set res to Do Script {"readAndGenerateST.pl", txt, styl} mode Batch
end tell
tell application "Style"
make new document
set selection of the front document to res as styled text
end tell
Of course, this is a very rough idea. I don't know if any of this can be
realized... But I hope you will understand what I mean I want to do.
I think other more complicated conversions or find and replace operations
may be done if we know how to read and generate StyledText in MacPerl.
I would appreciate any thoughts on this issue.
Thank you very much in advance!
Best regards,
Nobumi Iyanaga
Tokyo,
Japan
===============
P.S.
Here is what I could get so far for reading StyledText data in MacPerl:
The AppleScript script uses an OSAX named Sigma Coercions
http://members.home.net/eric-allen-grant/Sigmas-Coercions.sit.hqx
(mentioned by Gero Herrmann).
set stxt to the clipboard as styled text
set stxtRecord to stxt as record
set txt to <<class ktxt>> of stxtRecord
set styl to <<class ksty>> of stxtRecord
set styl to styl as hex string
tell application "MacJPerl"
set res to Do Script {"my_read_StyledText.pl", txt, styl} mode Batch
end tell
res
And my Frontier script uses an extension named "bits":
on styleEditor () {
local (data);
with objectModel, verbs.apps.Style {
if isRunning () {
if exists (window [1]) {
with window [1] {
data = get (selection, 'STXT');
return (data);
}};
return ("")};
return ("")}};
on STXTtoTEXTAndStyl (STXTData, returnValue = "styl") {
local (tempRec, tempData);
tempRec = record (STXTData);
if returnValue == "" {
return (tempRec)};
if returnValue == "styl" {
tempData = binary (tempRec ['ksty']);
setBinaryType (@tempData, 'styl');
return (tempData)};
if returnValue == "TEXT" {
tempData = binary (tempRec ['ktxt']);
setBinaryType (@tempData, 'TEXT');
return (tempData)};
};
on getStyleByPerl (STXTdata) {
local (styl, thetext, res);
styl = string (STXTtoTEXTandStyl (STXTdata));
styl = bits.hex (styl);
thetext = string (STXTtoTEXTandStyl (STXTdata, "TEXT"));
res = macJPerl.doScript ({string
(styledTextExtra2.getStylePerlScr2), thetext, styl}, mode:MacJPerl.batch);
return (res);
};
local (data = getSTXT.styleEditor (), res);
res = getStyleByPerl (data)
and my Perl script (it is the script in the Frontier's wp object at
"styledTextExtra2.getStylePerlScr2"), which is largely based on Alan Fry's
scripts, is:
#!perl -w
use Mac::Fonts;
my $text = $ARGV[0];
my $str = $ARGV[1];
$str =~ s/.*styl//;
$str =~ s/"+//;
$str =~ s/ +//g; # because Frontier extention "bits.hex()" returns
# hex data delimited by spaces.
my (@offsets, @record);
my $nsty = hex(substr($str, 0, 4));
print "Number of styles = $nsty\n\n";
$str = substr($str, 4);
for(0..$nsty-1) {
my $buf = substr($str, 40*$_, 40);
my @elem = unpack("a8a4a4a4a2a2a4a4a4a4", $buf);
push(@elem, "a", $buf);
push (@offsets, hex ($elem[0]));
push(@record, make_record(\@elem));
}
for (0 .. ($#offsets - 1)) {
my $s = substr ($text, $offsets[$_], ($offsets[$_ + 1] - $offsets[$_]));
$record[$_]{text} = $s;
}
$record[$#offsets]{text} = substr ($text, $offsets[$#offsets]);
print_record();
print "\nText:\n";
for (0 .. $#record) {
print $record[$_]{text}, "\n";
}
###############
sub get_face {
my($str) = @_;
my $face;
my @faces = qw(B I U O S C E R);
for(0..7) { $face .= $faces[$_] if vec(chr($str), $_, 1) };
$face = $face ? $face : 'Plain';
}
sub make_record {
my ($ref) = @_;
my $elements = {
offset => hex(${$ref}[0]),
height => hex(${$ref}[1]),
ascent => hex(${$ref}[2]),
fontID => hex(${$ref}[3]),
font => GetFontName(hex(${$ref}[3])),
face => get_face(${$ref}[4]),
size => hex(${$ref}[6]),
red => hex(${$ref}[7]),
green => hex(${$ref}[8]),
blue => hex(${$ref}[9]),
text => ${$ref}[10],
style => ${$ref}[11]
};
}
sub print_record {
local $^W = 0;
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(------- ------- ------- -------- ---------
------- ---------- ------ ------ ------);
printf $fmt, @heading;
printf $fmt, @line;
foreach (@record) {
printf $fmt, ${$_}{offset}, ${$_}{height}, ${$_}{ascent},
${$_}{fontID}, ${$_}{font}, ${$_}{face},
${$_}{size}, ${$_}{red}, ${$_}{green}, ${$_}{blue}
}
}
#=========
