File Coverage

lib/Kite/PScript/Defs.pm

Criterion	Covered	Total	%
statement	14	18	77.7
branch	1	2	50.0
condition			n/a
subroutine	4	6	66.6
pod	0	2	0.0
total	19	28	67.8

#========================================================================
# Kite::PScript::Defs
#
# DESCRIPTION
#   Perl module defining a number of PostScript definitions useful
#   for generating PostScript documents for kite part layout, etc.
#
# AUTHOR
#   Simon Stapleton  wrote the original xml2ps.pl
#   utility which contained most of the PostScript contained herein.
#
#   Most of that, he freely admits, was gleaned from the Blue Book
#   (PostScript Language Tutorial and Cookbook, Adobe).
#
#   Andy Wardley  re-packaged it into a module for
#   integration into the Kite bundle.
#
# COPYRIGHT
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
# VERSION
#   $Id: Defs.pm,v 1.3 2000/10/18 08:37:49 abw Exp $
#
#========================================================================

package Kite::PScript::Defs;

require 5.004;
use Exporter;

use base qw( Exporter );
use vars qw( $AUTOLOAD @EXPORT_OK %EXPORT_TAGS
             $mm $lines $cross $dot $circle $crop $clip $reg $noreg
             $outline $tiles $tilemap $dotiles $pathtext $box );

@EXPORT_OK   = qw( mm lines cross dot circle crop clip reg noreg
                   outline tiles tilemap dotiles pathtext );
%EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );

sub AUTOLOAD {
    my $item = $AUTOLOAD;
    $item =~ s/.*:://;
    return if $item eq 'DESTROY';
    return ${ __PACKAGE__ . "\::$item" };
}

sub load {
    my $class = shift;
    return $class;
}

sub new {
    my $class = shift;
    bless { }, $class;
}


#------------------------------------------------------------------------
$mm =<
/mm { 72 mul 25.4 div } bind def
EOF

#------------------------------------------------------------------------
$lines =<
/linelight  { 0.25 setlinewidth [] 0 setdash } bind def
/linenormal { 0.5  setlinewidth [] 0 setdash } bind def
/lineheavy  { 0.75 setlinewidth [] 0 setdash } bind def
/linedotted { 0.5  setlinewidth [3 5 1 5] 0 setdash } def
/linedashed { 0.5  setlinewidth [5 3 2 3] 0 setdash } def
EOF

#------------------------------------------------------------------------
$cross =<
/cross {
  linenormal
  newpath moveto
  -5 mm 0 rmoveto
  10 mm 0 mm rlineto
  -5 mm -5 mm rmoveto
  0 mm 10 mm rlineto
  stroke
} def
EOF

#------------------------------------------------------------------------
$dot =<
/dot {
  linenormal
  newpath 0.75 mm 0 360 arc
  fill
  stroke
} def
EOF

#------------------------------------------------------------------------
$circle =<
/circle {
  linenormal
  newpath 2 mm 0 360 arc
  stroke
} def
EOF

#------------------------------------------------------------------------
$crop =<
/crop {
    /y exch def
    /x exch def
    x y circle
    x y cross
} def
EOF

#------------------------------------------------------------------------
$clip =<
% clipping rectangle set to current imageable size minus border
clippath pathbbox
/cliptry exch border sub def
/cliptrx exch border sub def
/clipbly exch border add def
/clipblx exch border add def
/clipysize cliptry clipbly sub def
/clipxsize cliptrx clipblx sub def
/clipbox {
  clipblx clipbly clipxsize clipysize
} def

EOF

#------------------------------------------------------------------------
$reg =<
% registration marks relative to clipping rectangle,
% of course...
/regmarks {
  % draw clipping edge if border > 0
  border 0 gt {
    linedashed
%    .5 setgray
    clipbox rectstroke
  } if

  % draw registration marks at corners
  linenormal
%  0 setgray
  clipblx clipbly crop
  clipblx cliptry crop
  cliptrx cliptry crop
  cliptrx clipbly crop
} def
EOF

#------------------------------------------------------------------------
$noreg =<
% Define a dummy regmarks procedure
/regmarks { } def
EOF

#------------------------------------------------------------------------
$outline =<
% define procedure to draw an outline at a fixed distance from path
/outline {
  gsave
  linedashed
  dup /outwide exch def
  setlinewidth
  gsave stroke grestore
  outwide 2 sub setlinewidth 1 setgray [] 0 setdash
  stroke
  grestore
} def
EOF

#------------------------------------------------------------------------
$tiles =<
% tiles determines number of page tiles required for path on stack
/tiles {
  gsave
  pathbbox
  /try exch def
  /trx exch def
  /bly exch def
  /blx exch def
  /ysize try bly sub abs def
  /xsize trx blx sub abs def
  grestore

  % calculate number of tiles required in X and Y
  /tilesnx { xsize clipxsize div ceiling } def
  /tilesny { ysize clipysize div ceiling } def

  % determine X/Y offset required to centre path in tiles
  /tilesxorg tilesnx clipxsize mul xsize sub 2 div border add def
  /tilesyorg tilesny clipysize mul ysize sub 2 div border add def

  % add border to tilesorgx/y?
} def
EOF


#------------------------------------------------------------------------
$tilemap =<
% prints map of page tiles with current page shaded
/tilemap {
  gsave
%  0.5 setlinewidth
  /mapx clipxsize 15 div def
  /mapy clipysize 15 div def
  /gapx mapx 5 div def
  /gapy gapx def
  /mapxsize mapx gapx add def
  /mapysize mapy gapy add def
  /mapxorg clipblx gapx add def
  /mapyorg cliptry mapysize tilesny mul sub def
  0 1 tilesnx 1 sub {
    /maptx exch def
    0 1 tilesny 1 sub {
      /mapty exch def
      % fill tile if current page
      maptx tilex eq mapty tiley eq and {
        mapxorg maptx mapxsize mul add
        mapyorg mapty mapysize mul add
        mapx mapy .9 setgray rectfill
        0.2 setgray
        0.5 setlinewidth
      } {
        0.5 setgray
        0.5 setlinewidth
      } ifelse
      % outline tile
      mapxorg maptx mapxsize mul add
      mapyorg mapty mapysize mul add
      mapx mapy rectstroke
    } for
  } for
  grestore
} def
EOF

#------------------------------------------------------------------------
# dotiles
$dotiles =<
% we process pages from top left to bottom right, so must negate the order
% of the y pages
tilesny 1 sub -1 0
{
  /tiley exch def
  0 1 tilesnx 1 sub
  {
    /tilex exch def
    tilepage
    gsave
      clipbox rectclip
      % translate origin to the new image rectangle
      tilesxorg tilesyorg translate
      tilex clipxsize mul neg tiley clipysize mul neg translate
      tileimage
      showpage
    grestore
  } for
} for
EOF


#------------------------------------------------------------------------
$pathtext =<
%------------------------------------------------------------------------
% Define /pathtext function to draw text along an arbitrary path (ripped
% off from the Blue Book, of course)
%
/pathtextdict 26 dict def
/pathtext {
  pathtextdict begin
  /offset exch def
  /str exch def
  /pathdist 0 def
  /setdist offset def
  /charcount 0 def
  gsave
    flattenpath
    {movetoproc} {linetoproc} {curvetoproc} {closepathproc}
    pathforall
  grestore
  newpath
  end
} def

pathtextdict begin
/movetoproc {
  /newy exch def /newx exch def
  /firstx newx def /firsty newy def
  /ovr 0 def
  newx newy transform
  /cpy exch def /cpx exch def
} def

/linetoproc {
  /oldx newx def /oldy newy def
  /newy exch def /newx exch def
  /dx newx oldx sub def
  /dy newy oldy sub def
  /dist dx dup mul dy dup mul add sqrt def
  dist 0 ne
    { /dsx dx dist div ovr mul def
      /dsy dy dist div ovr mul def
      oldx dsx add oldy dsy add transform
      /cpy exch def /cpx exch def
      /pathdist pathdist dist add def
      { setdist pathdist le
          { charcount str length lt
              {setchar} {exit} ifelse }
          { /ovr setdist pathdist sub def
            exit }
          ifelse
      } loop
  } if
} def

/curvetoproc {
  (ERROR: No curveto's after flattenpath!) print
} def

/closepathproc {
  firstx firsty linetoproc
  firstx firsty movetoproc
} def

/setchar {
  /char str charcount 1 getinterval def
  /charcount charcount 1 add def
  /charwidth char stringwidth pop def
  gsave
    cpx cpy itransform translate
    dy dx atan rotate
    0 0 moveto char show
    currentpoint transform
    /cpy exch def /cpx exch def
  grestore
  /setdist setdist charwidth add def
} def
end
%------------------------------------------------------------------------

EOF


#------------------------------------------------------------------------
$box =<
% blx bly trx try Box
% create a new Box array
/Box {
    4 array astore
} def

% Box Box_select
% unpacks Box to define various Box_* variables
/Box_select {
    aload pop
    /Box_try exch def
    /Box_trx exch def
    /Box_bly exch def
    /Box_blx exch def
    /Box_width  Box_trx Box_blx sub abs def
    /Box_height Box_try Box_bly sub abs def
} def

% Box Box_rect
% output Box as a rect suitable for rectstoke etc.
/Box_rect {
    Box_select
    Box_blx Box_bly Box_width Box_height
} def

% Box Box_path
% output Box as a path suitable for stroke, clip, etc.
/Box_path {
    Box_select
    newpath
    Box_blx Box_bly moveto
    Box_blx Box_try lineto
    Box_trx Box_try lineto
    Box_trx Box_bly lineto
    closepath
} def

% Box border Box_border
% create a new Box bordered within a Box
/Box_border {
    /border exch def
    Box_select
    Box_blx border add
    Box_bly border add
    Box_trx border sub
    Box_try border sub
    Box
} def

% Box tiles space pad Box_vsplit
% split Box vertically into 'tiles' new Boxes, spaced apart by 'space'
% and padded within the original Box by 'pad'
/Box_vsplit {
    /Box_pad   exch def
    /Box_space exch def
    /Box_tiles exch def
    Box_select
    /Box_height
      Box_try Box_bly sub
      Box_pad 2 mul sub
      Box_space Box_tiles 1 sub mul sub
      Box_tiles div
      def
    /Box_width
      Box_trx Box_blx sub
      Box_pad 2 mul sub
      def
    /Box_blx Box_blx Box_pad add def
    /Box_bly Box_bly Box_pad add def
    1 1 Box_tiles {
      pop
      Box_blx Box_bly Box_blx Box_width add Box_bly Box_height add Box
      /Box_bly Box_bly Box_height add Box_space add def
    } for
} def

% Box tiles space pad Box_hsplit
% as per Box_vsplit, splitting Box horizontally
/Box_hsplit {
    /Box_pad   exch def
    /Box_space exch def
    /Box_tiles exch def
    Box_select
    /Box_height Box_height
      Box_pad 2 mul sub
      def
    /Box_width Box_width
      Box_pad 2 mul sub
      Box_space Box_tiles 1 sub mul sub
      Box_tiles div
      def
    /Box_blx Box_blx Box_pad add def
    /Box_bly Box_bly Box_pad add def
    1 1 Box_tiles {
      pop
      Box_blx Box_bly Box_blx Box_width add Box_bly Box_height add Box
      /Box_blx Box_blx Box_width add Box_space add def
    } for
} def


/Box_focus {
    /Box_box exch def
    gsave
    Box_box Box_select
    Box_box Box_path clip
    Box_blx Box_bly translate
} def

/Box_defocus {
    grestore
} def
EOF


1;

__END__