home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Ghostscript.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  4.9 KB  |  227 lines
  1. =head1 NAME
  2.  
  3. Ghostscript - Beginings of a lowlevel PostScript viewing widget
  4.  
  5. =head1 SYNOPSIS
  6.  
  7.     my $gs= $parent->Ghostscript(
  8.                     'x_pixels_per_inch' => $scale,
  9.                     'y_pixels_per_inch' => $scale,
  10.                     'BoundingBox' => [ 0,0, $width, $height]
  11.                     );
  12.     $gs->Postscript("....");
  13.  
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. Tested with gs3 via F<pgs> and F<Ghostview.pm>.
  18.  
  19. Aim is to have both GS and "Display Postscript" widgets
  20. which present same interface to higher level document viewers.
  21.  
  22. =cut
  23. package Tk::Ghostscript;
  24. use AutoLoader;
  25.  
  26. use strict qw(subs);
  27. use POSIX qw(F_GETFL F_SETFL O_NONBLOCK fcntl);
  28.  
  29. # use Tk::Xlib;
  30.  
  31. use Carp;
  32. use Tk::Pretty;
  33.  
  34. @ISA = qw(Tk::Frame);
  35. Construct Tk::Widget 'Ghostscript';
  36.  
  37. sub Portrait   {  0}   # Normal portrait orientation 
  38. sub Landscape  { 90}   # Normal landscape orientation 
  39. sub Upsidedown {180}   # Don't think this will be used much 
  40. sub Seascape   {270}   # Landscape rotated the wrong way 
  41.  
  42. sub Populate
  43. {
  44.  my ($w,$args) = @_;
  45.  my %hash = ( 
  46.               'bpixmap'           => 0,
  47.               'page_orientation'  => &Portrait(),
  48.               'BoundingBox'       => [0,0,int(210*72/25.4),int(297*72/25.4)], 
  49.               'x_pixels_per_inch' => 72.0,
  50.               'y_pixels_per_inch' => 72.0,
  51.               'Margins'           => [0,0,0,0]
  52.             );
  53.  %hash = (%hash,@_);
  54.  while (($key,$value) = each %hash)
  55.   {
  56.    $w->{$key} = $value;
  57.   }
  58.  
  59.  $w->{'FH'} = \*{"GS" . $w->PathName};
  60.  
  61.  $w->BindClientMessage('DONE','StopInterp');
  62.  $w->BindClientMessage('PAGE','PAGE');
  63.  $w->ConfigSpecs('-orientation' => ['METHOD','orientation','Orientation','Portrait']
  64.                 );
  65. } 
  66.  
  67.  
  68. 1;
  69.  
  70. __END__
  71.  
  72. sub StartInterp
  73. {
  74.  my $w = shift;
  75.  $w->StopInterp;
  76.  $w->idletasks;
  77.  $w->MakeWindowExist;
  78.  my $win  = ${$w->WindowId};  # Window for properties/events
  79.  my $dest = ${$w->WindowId};  # Xid of drawable to draw on (gs3 and later)
  80.  $ENV{'GHOSTVIEW'} = sprintf("%d %d",$win,$dest);
  81.  $w->property('set','GHOSTVIEW','STRING',8,
  82.               sprintf("%d %d %d %d %d %d %g %g %d %d %d %d",
  83.                $w->{'bpixmap'},
  84.                $w->{'page_orientation'},
  85.                @{$w->{'BoundingBox'}},
  86.                $w->{'x_pixels_per_inch'}, $w->{'y_pixels_per_inch'},
  87.                @{$w->{'Margins'}}));
  88.  my $screen = $w->Screen;
  89. # my $bg = $screen->WhitePixelOfScreen;
  90. # my $fg = $screen->BlackPixelOfScreen;
  91. # $w->property('set','GHOSTVIEW_COLORS','STRING',8,sprintf("Monochrome %d %d",$fg,$bg));
  92.  $w->{'Pending'} = [];
  93.  $w->XSync(0);
  94.  my $fh = $w->{'FH'};
  95.  $w->{'pid'} = open($fh,"| gs -sDEVICE=x11 -dQUIET -dNOPAUSE -");
  96.  my $fl = fcntl($fh,F_GETFL,0);
  97.  die "Cannot F_GETFL:$!" unless (defined $fl);
  98.  fcntl($fh,F_SETFL,$fl | O_NONBLOCK) || die "Cannot F_SETFL:$!";
  99. }
  100.  
  101. sub PAGE
  102. {
  103.  my $w = shift;
  104.  my $e = $w->XEvent;
  105.  my ($m,$d) = unpack('LL',$e->A);
  106.  $w->{'mwin'} = $m;
  107. }
  108.  
  109. sub Postscript
  110. {
  111.  my $w  = shift;
  112.  $w->StartInterp unless(exists $w->{'pid'});
  113.  if (exists $w->{'mwin'})
  114.   {
  115.    $w->SendClientMessage('NEXT',$w->{'mwin'},8,"");
  116.    delete $w->{'mwin'};
  117.   }
  118.  my $fh = $w->{'FH'};
  119.  my $pend = $w->{'Pending'};
  120.  unless (@$pend)
  121.   {
  122.    $w->fileevent($fh,'writable',['SendIt',$w]);
  123.   }
  124.  push(@$pend,@_);
  125. }
  126.  
  127. sub printf
  128. {my $w = shift;
  129.  my $fmt = shift;
  130.  $w->Postscript(sprintf($fmt,@_));
  131. }
  132.  
  133. sub SendIt
  134. {
  135.  my $w  = shift;
  136.  my $fh = $w->{'FH'};
  137.  my $pend = $w->{'Pending'};
  138.  while (@$pend)
  139.   {
  140.    my $line = shift(@$pend);           
  141.    my $len  = length($line);           
  142.    my $done = syswrite($fh,$line,$len);
  143.    $done = 0 unless (defined $done);
  144.    if ($done < $len)
  145.     {
  146.      unshift(@{$pend},substr($line,$done));
  147.      last;
  148.     }
  149.   }
  150.  if (exists $w->{'mwin'})
  151.   {
  152.    $w->SendClientMessage('NEXT',$w->{'mwin'},8,"");
  153.    delete $w->{'mwin'};
  154.   }
  155.  $w->fileevent($fh,'writable',"") unless (@$pend);
  156. }
  157.  
  158. sub StopInterp
  159. {
  160.  my $w = shift;
  161.  if (exists $w->{'pid'})
  162.   {
  163.    my $fh = $w->{'FH'};
  164.    kill('TERM',$w->{'pid'});
  165.    delete $w->{'pid'};
  166.    $w->fileevent($fh,'writable',"");
  167.    close($fh);
  168.    delete $w->{'Pending'};
  169.   }
  170.  delete $w->{'mwin'};
  171. }
  172.  
  173. sub NoteSize
  174. {
  175. }
  176.  
  177. sub ChangeView
  178. {
  179.  my $w = shift;
  180.  my ($llx,$lly,$urx,$ury) = @{$w->{'BoundingBox'}};
  181.  my $x = int(($urx - $llx)*$w->{'x_pixels_per_inch'}/72.0);
  182.  my $y = int(($ury - $lly)*$w->{'y_pixels_per_inch'}/72.0);
  183.  $w->StopInterp;
  184.  if ($w->{'page_orientation'} % 180 == 0)
  185.   {
  186.    $w->configure('-width' => $x,'-height' => $y);
  187.   }
  188.  else
  189.   {
  190.    $w->configure('-width' => $y,'-height' => $x);
  191.   }
  192. }
  193.  
  194. sub BoundingBox
  195. {
  196.  my $w = shift;
  197.  return @{$w->{'BoundingBox'}} unless (@_);
  198.  croak "Invalid bounding box" . Pretty(\@_) unless (@_ == 4); 
  199.  my @bb = @_;
  200.  $w->{'BoundingBox'} = \@bb;
  201.  $w->ChangeView;
  202. }
  203.  
  204. sub orientation
  205. {
  206.  my $w = shift;
  207.  if (@_)
  208.   {
  209.    my $view = shift;
  210.    $w->{'page_orientation'} = $w->$view();
  211.    $w->ChangeView;
  212.   }
  213.  my @names = ('Portrait','Landscape','Upsidedown','Seascape');
  214.  return $names[$w->{'page_orientation'}/90];
  215. }
  216.  
  217. sub ClassInit
  218. {
  219.  my ($class,$mw) = @_;
  220.  $mw->bind($class,'<Configure>','NoteSize');
  221.  $mw->bind($class,'<Destroy>','StopInterp');
  222.  return $class;
  223. }
  224.  
  225. 1;
  226.  
  227.