Version 2 of pentcl

Updated 2012-10-01 12:33:15 by RLE

(pentcl.tcl + example.tcl)


# pentcl.tcl (0.07b2)
# pentcl is a PostScript generator by Ben Collver
# based on Perl PostScript-Simple v0.07 by Matthew C. Newton

if {[catch {package present TclOO}] != 0} {
  error "TclOO missing.  Try using Tcl 8.6 or greater"
}
package require TclOO
namespace path oo
namespace eval ::pentcl:: {}

set ::pentcl::pscolours [dict create \
  black        [list 0   0   0  ]    \
  brightred    [list 1   0   0  ]    \
  brightgreen  [list 0   1   0  ]    \
  brightblue   [list 0   0   1  ]    \
  red          [list 0.8 0   0  ]    \
  green        [list 0   0.8 0  ]    \
  blue         [list 0   0   0.8]    \
  darkred      [list 0.5 0   0  ]    \
  darkgreen    [list 0   0.5 0  ]    \
  darkblue     [list 0   0   0.5]    \
  grey10       [list 0.1 0.1 0.1]    \
  grey20       [list 0.2 0.2 0.2]    \
  grey30       [list 0.3 0.3 0.3]    \
  grey40       [list 0.4 0.4 0.4]    \
  grey50       [list 0.5 0.5 0.5]    \
  grey60       [list 0.6 0.6 0.6]    \
  grey70       [list 0.7 0.7 0.7]    \
  grey80       [list 0.8 0.8 0.8]    \
  grey90       [list 0.9 0.9 0.9]    \
  white        [list 1   1   1  ]    \
]

set ::pentcl::fonts [list  \
  Courier                  \
  Courier-Bold             \
  Courier-BoldOblique      \
  Courier-Oblique          \
  Helvetica                \
  Helvetica-Bold           \
  Helvetica-BoldOblique    \
  Helvetica-Oblique        \
  Times-Roman              \
  Times-Bold               \
  Times-BoldItalic         \
  Times-Italic             \
  Symbol                   \
]

set ::pentcl::psdirs [dict create \
  RightUp    [list  1  1]         \
  RightDown  [list  1 -1]         \
  LeftUp     [list -1  1]         \
  LeftDown   [list -1 -1]         \
]

set ::pentcl::psorigin [dict create \
  LeftBottom  [list  0  0]          \
  LeftTop     [list  0 -1]          \
  RightBottom [list -1  0]          \
  RightTop    [list -1 -1]          \
]

set ::pentcl::pspaper [dict create                    \
  A0                  [list 2384       3370      ]    \
  A1                  [list 1684       2384      ]    \
  A2                  [list 1191       1684      ]    \
  A3                  [list  841.88976 1190.5512 ]    \
  A4                  [list  595.27559  841.88976]    \
  A5                  [list  420.94488  595.27559]    \
  A6                  [list  297        420      ]    \
  A7                  [list  210        297      ]    \
  A8                  [list  148        210      ]    \
  A9                  [list  105        148      ]    \
  B0                  [list 2920       4127      ]    \
  B1                  [list 2064       2920      ]    \
  B2                  [list 1460       2064      ]    \
  B3                  [list 1032       1460      ]    \
  B4                  [list  729       1032      ]    \
  B5                  [list  516        729      ]    \
  B6                  [list  363        516      ]    \
  B7                  [list  258        363      ]    \
  B8                  [list  181        258      ]    \
  B9                  [list  127        181      ]    \
  B10                 [list   91        127      ]    \
  Executive           [list  522        756      ]    \
  Folio               [list  595        935      ]    \
  Half-Letter         [list  612        397      ]    \
  Letter              [list  612        792      ]    \
  US-Letter           [list  612        792      ]    \
  Legal               [list  612       1008      ]    \
  US-Legal            [list  612       1008      ]    \
  Tabloid             [list  792       1224      ]    \
  SuperB              [list  843       1227      ]    \
  Ledger              [list 1224        792      ]    \
  "Comm #10 Envelope" [list  297        684      ]    \
  Envelope-Monarch    [list  280        542      ]    \
  Envelope-DL         [list  312        624      ]    \
  Envelope-C5         [list  461        648      ]    \
  EuroPostcard        [list  298        420      ]    \
]

set ::pentcl::psunits [dict create \
  pt [list 72  72.27  ]            \
  pc [list 72   6.0225]            \
  in [list 72   1     ]            \
  bp [list  1   1     ]            \
  cm [list 72   2.54  ]            \
  mm [list 72  25.4   ]            \
  dd [list 72  67.567 ]            \
  cc [list 72 810.804 ]            \
]

set ::pentcl::version 0.07b2

class create ::pentcl::EpsSimpleClass {
  constructor {data} {
    variable key undefined
    variable val undefined
    variable opt_eps [dict create \
      file       undefined        \
      xsize      undefined        \
      ysize      undefined        \
      units      bp               \
      clip       true             \
      bbx1       0                \
      bby1       0                \
      bbx2       0                \
      bby2       0                \
      epsprefix  [list]           \
      epsfile    undefined        \
      epspostfix [list]           \
      source     undefined        \
    ]

    dict for {key val} $data {
      dict set opt_eps $key $val
    }
    if {[dict get $opt_eps file] eq "undefined"} {
      if {[dict get $opt_eps source] eq "undefined"} {
        error "Must provide source."
      }
    } else {
      error "Must not provide file as it is unimplemented."
    }
    my init
  }

  method getfilebbox {} {
    error "getfilebbox method not implemented"
  }

  method getsourcebbx {} {
    variable opt_eps
    variable result
    if {[dict get $opt_eps epsfile] eq "undefined"} {
      return false
    }
    set result [regexp -inline -line                             \
      {^%%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)$} \
      [dict get $opt_eps epsfile]                                \
    ]
    if {[llength $result] == 5} {
      dict set opt_eps bbx1 [lindex $result 1]
      dict set opt_eps bby1 [lindex $result 2]
      dict set opt_eps bbx2 [lindex $result 3]
      dict set opt_eps bby2 [lindex $result 4]
      return true
    }
    return false
  }

  method init {} {
    variable foundbbx
    variable opt_eps
    dict set opt_eps epsfile [dict get $opt_eps source]
    dict unset opt_eps source
    if {![my getsourcebbx]} {
      error "EPS file must contain a BoundingBox"
    }
    if {([dict get $opt_eps bbx2] - [dict get $opt_eps bbx1] == 0) || \
        ([dict get $opt_eps bby2] - [dict get $opt_eps bby1] == 0)}   \
    {
      error "Pentcl Eps Bounding Box has zero dimension"
      return false
    }
    return true
  }

  method get_bbox {} {
    variable opt_eps
    return [list \
      [dict get $opt_eps bbx1] [dict get $opt_eps bby1] \
      [dict get $opt_eps bbx2] [dict get $opt_eps bby2] \
    ]
  }

  method width {} {
    variable opt_eps
    return [expr {[dict get $opt_eps bbx2] - [dict get $opt_eps bbx1]}]
  }

  method height {} {
    variable opt_eps
    return [expr {[dict get $opt_eps bby2] - [dict get $opt_eps bby1]}]
  }

  method scale {x {y undefined}} {
    variable opt_eps
    if {$y eq "undefined"} {
      set y $x
    }
    dict lappend opt_eps epsprefix "$x $y scale"
    return true
  }

  method rotate {d} {
    variable opt_eps
    dict lappend opt_eps epsprefix "$d rotate"
    return true
  }

  method translate {x y} {
    variable opt_eps
    dict lappend opt_eps epsprefix "$x $y translate"
    return true
  }

  method reset {} {
    variable opt_eps
    dict set opt_eps epsprefix [list]
    return true
  }

  method load {} {
    error "load method not implemented"
  }

  method preload {} {
    error "preload method not implemented"
  }

  method get_include_data {x y} {
    variable data ""
    variable opt_eps
    set data [join [dict get $opt_eps epsprefix] "\n"]
    append data "\n"
    if {[dict get $opt_eps clip]} {
      append data "newpath "                                              \
        [dict get $opt_eps bbx1] " " [dict get $opt_eps bby1] " moveto\n" \
        [dict get $opt_eps bbx2] " " [dict get $opt_eps bby1] " lineto "  \
        [dict get $opt_eps bbx2] " " [dict get $opt_eps bby2] " lineto\n" \
        [dict get $opt_eps bbx1] " " [dict get $opt_eps bby2]             \
        " lineto closepath clip newpath\n"
    }
    append data [dict get $opt_eps epsfile] \
      [join [dict get $opt_eps epspostfix] "\n"] "\n"
    return $data
  }
}

class create ::pentcl::PsSimpleClass {
  constructor {data} {
    variable key undefined
    variable opt undefined
    set opt [dict create               \
      xsize          undefined         \
      ysize          undefined         \
      papersize      undefined         \
      units          bp                \
      landscape      0                 \
      copies         1                 \
      colour         false             \
      clip           false             \
      eps            true              \
      page           1                 \
      reencode       ISOLatin1Encoding \
      bbx1           0                 \
      bby1           0                 \
      bbx2           0                 \
      bby2           0                 \
      pscomments     ""                \
      psprolog       ""                \
      psfunctions    ""                \
      pssetup        ""                \
      pspages        ""                \
      pstrailer      ""                \
      lastfontsize   undefined         \
      pspagecount    0                 \
      usedcircle     false             \
      usedcircletext false             \
      usedbox        false             \
      usedrotabout   false             \
      usedimporteps  false             \
      coordorigin    LeftBottom        \
      direction      RightUp           \
      fonts          [list]            \
    ]

    dict for {key val} $data {
      dict set opt $key $val
    }
    my init
  }

  method init {} {
    variable d 1
    variable dx
    variable dy
    variable font
    variable i
    variable m 1
    variable mm
    variable opt
    variable u

    # Units
    if {[dict exists $::pentcl::psunits [dict get $opt units]]} {
      lassign [dict get $::pentcl::psunits [dict get $opt units]] m d
    } else {
      error "unit [dict get $opt units] undefined"
    }
    lassign [dict get $::pentcl::psdirs [dict get $opt direction]] dx dy

    # x direction
    set mm [expr {$m * $dx}]
    set u "{"
    if {$mm != 1} {
      append u "$mm mul "
    }
    if {$d != 1} {
      append u "$d div "
    }
    set u [string trim $u]
    append u "}"
    dict append opt psfunctions "/ux $u def\n"

    # y direction
    set mm [expr {$m * $dy}]
    set u "{"
    if {$mm != 1} {
      append u "$mm mul "
    }
    if {$d != 1} {
      append u "$d div "
    }
    set u [string trim $u]
    append u "}"
    dict append opt psfunctions "/uy $u def\n"

    # general unit scale
    set u "{"
    if {$m != 1} {
      append u "$m mul "
    }
    if {$d != 1} {
      append u "$d div "
    }
    set u [string trim $u]
    append u "}"
    dict append opt psfunctions "/u $u def\n"

    if {[dict get $opt xsize] eq "undefined" || \
      [dict get $opt ysize] eq "undefined"}     \
    {
      if {[dict get $opt papersize] ne "undefined" &&               \
        [dict exists $::pentcl::pspaper [dict get $opt papersize]]} \
      {
        dict set opt xsize [lindex \
          [dict get $::pentcl::pspaper [dict get $opt papersize]] 0]
        dict set opt ysize [lindex \
          [dict get $::pentcl::pspaper [dict get $opt papersize]] 1]
        dict set opt bbx2 [dict get $opt xsize]
        dict set opt bby2 [dict get $opt ysize]
        dict append opt pscomments "%%DocumentMedia: "            \
          [dict get $opt papersize] " " [dict get $opt xsize] " " \
          [dict get $opt ysize] " 0 ( ) ( )\n"
      } else {
        error "page size undefined"
      }
    } else {
      dict set opt bbx2 [expr {int([dict get $opt xsize] * double($m) / $d)}]
      dict set opt bby2 [expr {int([dict get $opt ysize] * double($m) / $d)}]
    }

    if {![dict get $opt eps]} {
      dict append opt pssetup "ll 2 ge \{ << /PageSize \[ " \
        [dict get $opt xsize] " " [dict get $opt ysize]     \
        " \] /ImagingBBox null >> setpagedevice \} if\n"
    }

    if {[dict get $opt landscape]} {
      variable swap
      dict append opt psfunctions "/landscape { " [dict get $opt bbx2] \
        " 0 translate 90 rotate } bind def\n"

      # Portrait probably correct as page is rotated
      dict append opt pscomments "%%Orientation: Portrait\n"

      swap = [dict get $opt bbx2]
      dict set opt bbx2 [dict get $opt bby2]
      dict set opt bby2 $swap

      # for EPS files, change to landscape here, as there are no pages
      if {[dict get $opt eps]} {
        dict append opt pssetup "landscape\n"
      }
    } else {
      dict append opt pscomments "%%Orientation: Portrait\n"
    }

    # Clipping
    if {[dict get $opt clip]} {
      dict append opt psfunctions "/pageclip {newpath "          \
        [dict get $opt bbx1] " " [dict get $opt bby1] " moveto " \
        [dict get $opt bbx1] " " [dict get $opt bby2] " lineto " \
        [dict get $opt bbx2] " " [dict get $opt bby2] " lineto " \
        [dict get $opt bbx2] " " [dict get $opt bby1] " lineto " \
        [dict get $opt bbx1] " " [dict get $opt bby1] " lineto " \
        "closepath clip} bind def\n"
      if {[dict get $opt eps]} {
        dict append opt pssetup "pageclip\n"
      }
    }

    # Font reencoding
    variable encoding ""
    variable ext "-iso"
    if {[dict get $opt reencode] ne "undefined"} {
      set encoding [dict get $opt reencode]
      dict append opt psfunctions {/STARTDIFFENC { mark } bind def
/ENDDIFFENC {

% /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC -
  counttomark 2 add -1 roll 256 array copy
  /TempEncode exch def

  % pointer for sequential encodings
  /EncodePointer 0 def
  {
    % Get the bottom object
    counttomark -1 roll
    % Is it a mark?
    dup type dup /marktype eq {
      % End of encoding
      pop pop exit
    } {
      /nametype eq {
        % Insert the name at EncodePointer
        % and increment the pointer.
        TempEncode EncodePointer 3 -1 roll put
        /EncodePointer EncodePointer 1 add def
      } {
        % Set the EncodePointer to the number
        /EncodePointer exch def
      } ifelse
    } ifelse
  } loop

  TempEncode def
} bind def

% Define ISO Latin1 encoding if it doesnt exist
/ISOLatin1Encoding where {
  % (ISOLatin1 exists!) =
  pop
} {
  (ISOLatin1 does not exist, creating...) =
  /ISOLatin1Encoding StandardEncoding STARTDIFFENC
    144 /dotlessi /grave /acute /circumflex /tilde
    /macron /breve /dotaccent /dieresis /.notdef /ring
    /cedilla /.notdef /hungarumlaut /ogonek /caron /space
    /exclamdown /cent /sterling /currency /yen /brokenbar
    /section /dieresis /copyright /ordfeminine
    /guillemotleft /logicalnot /hyphen /registered
    /macron /degree /plusminus /twosuperior
    /threesuperior /acute /mu /paragraph /periodcentered
    /cedilla /onesuperior /ordmasculine /guillemotright
    /onequarter /onehalf /threequarters /questiondown
    /Agrave /Aacute /Acircumflex /Atilde /Adieresis
    /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex
    /Edieresis /Igrave /Iacute /Icircumflex /Idieresis
    /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde
    /Odieresis /multiply /Oslash /Ugrave /Uacute
    /Ucircumflex /Udieresis /Yacute /Thorn /germandbls
    /agrave /aacute /acircumflex /atilde /adieresis
    /aring /ae /ccedilla /egrave /eacute /ecircumflex
    /edieresis /igrave /iacute /icircumflex /idieresis
    /eth /ntilde /ograve /oacute /ocircumflex /otilde
    /odieresis /divide /oslash /ugrave /uacute
    /ucircumflex /udieresis /yacute /thorn /ydieresis
  ENDDIFFENC
} ifelse

% Name: Re-encode Font
% Description: Creates a new font using the named encoding.

/REENCODEFONT { % /Newfont NewEncoding /Oldfont
  findfont dup length 4 add dict
  begin
    { % forall
      1 index /FID ne
      2 index /UniqueID ne and
      2 index /XUID ne and
      { def } { pop pop } ifelse
    } forall
    /Encoding exch def
    % defs for DPS
    /BitmapWidths false def
    /ExactSize 0 def
    /InBetweenSize 0 def
    /TransformedChar 0 def
    currentdict
  end
  definefont pop
} bind def

% Reencode the std fonts:
}
# end of psfunctions PostScript code block

      foreach font [dict get $opt fonts] {
        dict append opt psfunctions "/$font$ext $encoding /$font REENCODEFONT\n"
      }
    }
  }
  # end of init proc

  method newpage {{nextpage undefined}} {
    variable opt
    variable x undefined
    variable y undefined

    if {$nextpage ne "undefined"} {
      dict set opt page $nextpage
    }

    if {[dict get $opt eps]} {
      # Cannot have multiple pages in an EPS file XXXXX
      error "Do not use newpage for eps files!"
    }

    if {[dict get $opt pspagecount] != 0} {
      dict append opt pspages "%%PageTrailer\n" \
        "pagelevel restore\n"                   \
        "showpage\n"
    }

    dict incr opt pspagecount
    dict append opt pspages "%%Page: " [dict get $opt page] " " \
      [dict get $opt pspagecount] "\n"
    if {[dict get $opt page] >= 0} {
      dict incr opt page
    } else {
      dict incr opt page -1
    }

    dict append opt pspages "%%BeginPageSetup\n" \
      "/pagelevel save def\n"
    if {[dict get $opt landscape]} {
       dict append opt pspages "landscape\n"
    }
    if {[dict get $opt clip]} {
       dict append opt pspages "pageclip\n"
    }
    lassign [dict get $::pentcl::psorigin [dict get $opt coordorigin]] x y
    if {$x < 0} {
      set x [dict get $opt xsize]
    }
    if {$y < 0} {
      set y [dict get $opt ysize]
    }
    if {$x != 0 || $y != 0} {
      dict append opt pspages "$x $y translate\n"
    }
    dict append opt pspages "%%EndPageSetup\n"
    return true
  }

  method _builddocument {title} {
    variable date [clock format [clock seconds] -format "%+"]
    variable opt
    variable page [list]
    variable user "Console"

    # Comments Section
    if {[dict get $opt eps]} {
      lappend page "%!PS-Adobe-3.0 EPSF-1.2"
    } else {
      lappend page "%!PS-Adobe-3.0"
    }
    lappend page "%%Title: ($title)"
    lappend page "%%LanguageLevel: 1"
    lappend page "%%Creator: Pentcl version $::pentcl::version"
    lappend page "%%CreationDate: $date"
    lappend page "%%For: $user"
    lappend page [string trim [dict get $opt pscomments]]
    if {[dict get $opt eps]} {
      lappend page [join [list "%%BoundingBox:"    \
        [dict get $opt bbx1] [dict get $opt bby1]  \
        [dict get $opt bbx2] [dict get $opt bby2]] \
      ]
    } else {
      lappend page "%%Pages: [dict get $opt pspagecount]"
    }
    lappend page "%%EndComments"

    # Prolog Section
    lappend page "%%BeginProlog"
    lappend page "/ll 1 def systemdict /languagelevel known {"
    lappend page "/ll languagelevel def } if"
    lappend page [dict get $opt psprolog]
    lappend page "%%BeginResource: Pentcl"
    lappend page [dict get $opt psfunctions]
    lappend page "%%EndResource"
    lappend page "%%EndProlog"

    # Setup Section
    if {[string length [dict get $opt pssetup]] > 0 || \
      [dict get $opt copies] > 1}                      \
    {
      lappend page "%%BeginSetup"
      if {[dict get $opt copies] > 1} {
        lappend page "/#copies [dict get $opt copies] def"
      }
      lappend page [dict get $opt pssetup]
      lappend page "%%EndSetup"
    }

    # Pages
    lappend page [dict get $opt pspages]
    if {(![dict get $opt eps]) && ([dict get $opt pspagecount] > 0)} {
      lappend page "%%PageTrailer"
      lappend page "pagelevel restore"
      lappend page "showpage"
    }

    # Trailer Section
    if {[string length [dict get $opt pstrailer]] > 0} {
      lappend page "%%Trailer"
      lappend page [dict get $opt pstrailer]
    }
    lappend page "%%EOF"
    return $page
  }

  method output {} {
    error "output method not implemented"
  }

  method get {} {
    variable i undefined
    variable opt
    variable page [my _builddocument "Pentcl generated page"]
    variable retval [join $page "\n"]
    append retval "\n"
    return $retval
  }

  method geteps {} {
    variable opt
    if {![dict get $opt eps]} {
      error "document is not EPS"
    }
    return [::pentcl::EpsSimpleClass new [dict create source [my get]]]
  }

  method setcolour args {
    variable b undefined
    variable g undefined
    variable opt
    variable r undefined

    if {[llength $args] == 1} {
      set args [lassign $args r]
      if {[dict exists $::pentcl::pscolours $r]} {
        lassign [dict get $::pentcl::pscolours $r] r g b
      } else {
        error "bad colour name '$r'"
        return false
      }
    } elseif {[llength $args] == 3} {
      lassign $args r g b
      set r [expr {double($r) / 255}]
      set g [expr {double($g) / 255}]
      set b [expr {double($b) / 255}]
    } else {
      error "setcolour given invalid arguments: $args"
      return false
    }

    if {[dict get $opt colour]} {
      dict append opt pspages "$r $g $b setrgbcolor\n"
    } else {
      # PKENT - colour->grey conversion
      set r [expr {0.3 * $r + 0.59 * $g + 0.11 * $b}]
      dict append opt pspages "$r setgray\n"
    }
    return true
  }

  method setlinewidth {width} {
    variable opt
    # MCN should allow for option units=>"cm" on each
    # setlinewidth / line / polygon etc
    # PKENT - good idea, should we have names for line weights, like we
    # do for colours?
    if {$width eq "thin"} {
      set width "0.4"
    } else {
      append width " u"
    }
    dict append opt pspages "$width setlinewidth\n"
    return true
  }

  method line {x1 y1 x2 y2 args} {
    variable opt
    # dashed lines? XXXXX
    # MCN should allow for option units=>"cm" on each
    # setlinewidth / line / polygon etc
    if {[dict get $opt pspagecount] == 0 && ![dict get $opt eps]} {
      # Cannot draw on to non-page when not an eps file XXXXX
      return false
    }

    if {[llength $args] == 3} {
      lassign $args r g b
      my setcolour $r $g $b
    } elseif {[llength $args] != 0} {
      error "wrong number of args for line"
      return false
    }
    my newpath
    my moveto $x1 $y1
    dict append opt pspages "$x2 ux $y2 uy lineto stroke\n"
    return true
  }

  method linextend {x y} {
    variable opt
    dict set opt pspages [regsub {eto stroke\n$} \
      [dict get $opt pspages] "eto\n$x ux $y uy lineto stroke\n"]

    # PKENT comments: lineto can follow a curveto or a lineto,
    # hence the change in regexp
    # also I thought that it'd be better to change the '.*$' in the
    # regsub with '\n$' - perhaps
    # we need something like _lastcommand to know if operations are valid?

    # dict append opt pspages "$x ux $y uy lineto stroke\n"
    # XXXXX fixme
    return true
  }

  method arc args {
    variable ea undefined
    variable opt
    variable opt_arc [dict create]
    variable opt_discard undefined
    variable r undefined
    variable sa undefined
    variable x undefined
    variable y undefined

    if {[dict get $opt pspagecount] == 0 && ![dict get $opt eps]} {
      # Cannot draw on to non-page when not an eps file XXXXX
      return false
    }

    if {[lindex $args 0] eq "-opt"} {
      set args [lassign $args opt_discard opt_arc]
    }
    if {[llength $args] == 5} {
      lassign $args x y r sa ea
    } else {
      error "arc: wrong number of arguments"
      return false
    }

    my newpath
    dict append opt pspages "$x ux $y uy $r u $sa $ea arc "
    if {[dict get $opt_arc filled]} {
      dict append opt pspages "fill\n"
    } else {
      dict append opt pspages "stroke\n"
    }
    return true
  }

  method polygon args {
    variable opt
    variable opt_discard undefined
    variable opt_polygon [dict create]
    variable rotate 0
    variable rotatex 0
    variable rotatey 0
    variable savestate undefined
    variable x undefined
    variable y undefined
    variable xoffset 0
    variable yoffset 0

    # PKENT comments - the first arg could be an optional hashref of
    # options. See if it's there with ref($_[0]) If it is, then shift
    # it off and use those options.  Could take the form:
    # polygon( { offset => [ 10, 10 ], filled => 0, rotate => 45,
    # rotate => [45, 10, 10] }, $x1, ...  it seems neater to use native
    # structures instead of manipulating strings
    # ... done MCN 2002-10-22

    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_polygon]
    }
    if {[llength $args] < 6} {
      error "bad polygon - not enough points"
      return false
    }
    set args [lassign $args x y]

    if {[dict exists $opt_polygon rotate]} {
      if {[llength [dict get $opt_polygon rotate]] > 1} {
        lassign [dict get $opt_polygon rotate] rotate rotatex rotatey
      } else {
        set rotate [dict get $opt_polygon rotate]
        set rotatex x
        set rotatey y
      }
    }
    if {[dict exists $opt_polygon offset]} {
      if {[llength [dict get $opt_polygon offset]] > 0} {
        lassign [dict get $opt_polygon offset] xoffset yoffset
      } else {
        error "polygon: bad offset option"
        return false
      }
    }

    if {![dict exists $opt_polygon filled]} {
      dict set opt_polygon filled false
    }

    if {$x eq "undefined" || $y eq "undefined"} {
      error "polygon: no start point"
      return false
    }

    if {$xoffset || $yoffset || $rotate} {
      set savestate true
      dict append opt pspages "gsave "
    } else {
      set savestate false
    }

    if {$xoffset || $yoffset} {
      dict append opt pspages "$xoffset ux $yoffset uy translate\n"
      #dict append opt pspages "$xoffset u $yoffset u translate\n"
    }

    if {rotate} {
      if {![dict get $opt usedrotabout]} {
        dict append opt psfunctions "/rotabout {"    \
          "3 copy pop translate rotate exch 0 exch " \
          "sub exch 0 exch sub translate"            \
          "} def\n"
        dict set opt usedrotabout true
      }

      dict append opt pspages "$rotatex ux $rotatey uy rotate rotabout\n"
      # dict append opt pspages "gsave $rotatex ux $rotatey uy translate "
      # dict append opt pspages \
      #   "$rotate rotate -$rotatex ux -$rotatey uy translate\n"
    }

    my newpath
    my moveto $x $y

    while {[llength $args] > 0} {
      set args [lassign $args x y]
      dict append opt pspages "$x ux $y uy lineto "
    }

    if {[dict get $opt_polygon filled]} {
      dict append opt pspages "fill\n"
    } else {
      dict append opt pspages "stroke\n"
    }

    if {savestate} {
      dict append opt pspages "grestore\n"
    }

    return true
  }

  method circle args {
    variable opt
    variable opt_circle [dict create]
    variable opt_discard undefined
    variable x
    variable y
    variable r
   
    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_circle]
    }
    if {[llength $args] != 3} {
      error "circle: wrong number of arguments"
      return false
    }
    lassign $args x y r
    if {![dict get $opt usedcircle]} {
      dict append opt psfunctions "/circle {" \
        "newpath 0 360 arc closepath"         \
        "} bind def\n"
      dict set opt usedcircle true
    }

    dict append opt pspages "$x ux $y uy $r u circle "
    if {[dict get $opt filled]} {
      dict append opt pspages "fill\n"
    } else {
      dict append opt pspages "stroke\n"
    }
    return true
  }

  method circletext args {
    variable a undefined
    variable opt
    variable opt_circletext [dict create]
    variable opt_discard undefined
    variable r undefined
    variable text undefined
    variable x undefined
    variable y undefined

    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_circletext]
    }
    if {[llength $args] != 5} {
      error "circletext: wrong number of arguments"
      return false
    }
    lassign $args x y r a text

    if {[dict get $opt lastfontsize] eq "undefined"} {
      error "circletext: must set font first"
      return false
    }

    if {![dict get $opt usedcircletext]} {
      dict append opt psfunctions {/outsidecircletext {
  $circtextdict begin
    /radius exch def
    /centerangle exch def
    /ptsize exch def
    /str exch def
    /xradius radius ptsize 4 div add def
    gsave
    centerangle str findhalfangle add rotate
    str {
      /charcode exch def ( ) dup 0 charcode put outsideshowcharandrotate
    } forall
    grestore
  end
} def

/insidecircletext {
  $circtextdict begin
    /radius exch def
    /centerangle exch def
    /ptsize exch def
    /str exch def
    /xradius radius ptsize 3 div sub def
    gsave
    centerangle str findhalfangle sub rotate
    str {
      /charcode exch def ( ) dup 0 charcode put insideshowcharandrotate
    } forall
    grestore
  end
} def
/$circtextdict 16 dict def
$circtextdict begin
  /findhalfangle {
    stringwidth pop 2 div 2 xradius mul pi mul div 360 mul
  } def
  /outsideshowcharandrotate {
    /char exch def
    /halfangle char findhalfangle def
    gsave
    halfangle neg rotate radius 0 translate -90 rotate
    char stringwidth pop 2 div neg 0 moveto char show
    grestore
    halfangle 2 mul neg rotate
  } def
  /insideshowcharandrotate {
    /char exch def
    /halfangle char findhalfangle def
    gsave
    halfangle rotate radius 0 translate 90 rotate
    char stringwidth pop 2 div neg 0 moveto char show
    grestore
    halfangle 2 mul rotate
  } def
  /pi 3.1415926 def
end
}
# end of psfunctions PostScript code block

      dict set opt usedcircletext true
    }
    dict append opt pspages "gsave" \
      "  $x ux $y uy translate"     \
      "  ($text) [dict get $opt lastfontsize] $a $r $u "
    if {[dict exists $opt_circletext align] &&       \
      [dict get $opt_circletext align] eq "outside"} \
    {
      dict append opt pspages "outsidecircletext\n"
    } else {
      dict append opt pspages "insidecircletext\n"
    }
    dict append opt pspages "grestore\n"
    return true
  }

  method box args {
    variable opt
    variable opt_box [dict create]
    variable opt_discard undefined
    variable x1 undefined
    variable x2 undefined
    variable y1 undefined
    variable y2 undefined

    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_box]
    }
    if {[llength $args] != 4} {
      error "box: wrong number of arguments"
      return false
    }
    lassign $args x1 y1 x2 y2

    if {![dict exists $opt_box filled]} {
      dict set opt_box filled false
    }

    if {![dict get $opt usedbox]} {
      dict append opt psfunctions {/box {
  newpath 3 copy pop exch 4 copy pop pop
  8 copy pop pop pop pop exch pop exch
  3 copy pop pop exch moveto lineto
  lineto lineto pop pop pop pop closepath
} bind def
}
# end of psfunctions PostScript code block
      dict set opt usedbox true
    }

    dict append opt pspages "$x1 ux $y1 uy $x2 ux $y2 uy box "
    if {[dict get $opt_box filled]} {
      dict append opt pspages "fill\n"
    } else {
      dict append opt pspages "stroke\n"
    }
    return true
  }

  method setfont {name size} {
    variable opt
    dict append opt pspages "/$name findfont $size scalefont setfont\n"
    dict set opt lastfontsize size
    return true
  }

  method text args {
    variable align undefined
    variable match_whole undefined
    variable match_sub undefined
    variable opt
    variable opt_discard undefined
    variable opt_text [dict create]
    variable rot ""
    variable rot_m ""
    variable text undefined

    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_text]
    }
    if {[llength $args] != 3} {
      error "text: wrong number of arguments"
      return false
    }
    lassign $args x y text

    # Escape text to allow parentheses
    set text [regsub -all {([\\\(\)])} $text {\\\1}]
    while {[regexp {([\x00-\x1f\x7f-\xff])} $text match_whole match_sub]} {
      variable oct [format "\\%03o" [scan %c $match_sub]]
      set text [regsub {[\x00-\x1f\x7f-\xff]} $text $oct]
    }

    my newpath
    my moveto $x $y

    # rotation
    if {[dict exists $opt_text rotate]} {
      set rot_a [dict get $opt_text rotate]
      if {$rot_a != 0} {
        set rot "$rot_a rotate "
        set rot_a [expr {0 - $rot_a}]
        set rot_m "$rot_a rotate "
      }
    }

    # alignment, default left
    set align " show stroke"
    if {[dict exists $opt_text align]} {
      if {[dict get $opt_text align] eq "right"} {
        set align " dup stringwidth pop neg 0 rmoveto show"
      }
      if {[dict get $opt_text align] eq "center" || \
        [dict get $opt_text align] eq "centre"}     \
      {
        set align " dup stringwidth pop 2 div neg 0 rmoveto show"
      }
    }

    dict append opt pspages "($text) $rot $align $rot_m\n"
    return true
  }

  method curve {x1 y1 x2 y2 x3 y3 x4 y4} {
    variable opt
    # dashed lines? XXXXX
    if {[dict get $opt pspagecount] == 0 && ![dict get $opt eps]} {
      # Cannot draw on to non-page when not an eps file XXXXX
      return false
    }

    my newpath
    my moveto $x1 $y1
    dict append opt pspages \
      "$x2 ux $y2 uy "      \
      "$x3 ux $y3 uy "      \
      "$x4 ux $y4 uy curveto stroke\n"
    return true
  }

  method curvextend {x1 y1 x2 y2 x3 y3} {
    variable opt
    # curveto may follow a lineto etc...
    dict set opt pspages [regsub {eto stroke\n$} [dict get $opt pspages] \
      "eto\n"                                                            \
      "$x1 ux $y1 uy "                                                   \
      "$x2 ux $y2 uy "                                                   \
      "$x3 ux $y3 uy curveto stroke\n"
    return true
  }

  # internal method, avoid it
  method newpath {} {
    variable opt
    dict append opt pspages "newpath\n"
    return true
  }

  # internal method, avoid it
  method moveto {x y} {
    variable opt
    dict append opt pspages "$x ux $y uy moveto\n"
    return true
  }

  method importepsfile {} {
    error "importepsfile method not implemented, try importepsdata"
  }

  method importepsdata {args} {
    variable bbllx undefined
    variable bblly undefined
    variable bburx undefined
    variable bbury undefined
    variable bbw undefined
    variable bbh undefined
    variable eps undefined
    variable line undefined
    variable opt
    variable opt_discard undefined
    variable opt_epsdata [dict create]
    variable pagew undefined
    variable pageh undefined
    variable result undefined
    variable scalex undefined
    variable scaley undefined

    if {[lindex $args 0] == "-opt"} {
      set args [lassign $args opt_discard opt_epsdata]
    }
    if {[llength $args] != 5} {
      error "importepsdata: wrong number of arguments"
      return false
    }
    lassign $args source x1 y1 x2 y2

    if {![dict exists $opt_epsdata overlap]} {
      dict set opt_epsdata overlap false
    }
    if {![dict exists $opt_epsdata stretch]} {
      dict set opt_epsdata stretch false
    }
    set eps [::pentcl::EpsSimpleClass new [dict create source $source]]
    set result [$eps get_bbox]
    lassign $result bbllx bblly bburx bbury

    set pagew [expr {$x2 - $x1}]
    set pageh [expr {$y2 - $y1}]
    set bbw [expr {$bburx - $bbllx}]
    set bbh [expr {$bbury - $bblly}]

    if {$bbw == 0 || $bbh == 0} {
      error "importepsdata: Bounding Box has zero dimension"
      return false
    }

    set scalex [expr {double($pagew) / $bbw}]
    set scaley [expr {double($pageh) / $bbh}]

    if {![dict get $opt_epsdata stretch]} {
      if {![dict get $opt_epsdata overlap]} {
        if {$scalex > $scaley} {
          set scalex $scaley
        } else {
          set scaley $scalex
        }
      } else {
        if {$scalex > $scaley} {
          set scaley $scalex
        } else {
          set scalex $scaley
        }
      }
    }

    $eps scale $scalex $scaley
    $eps translate [expr {0 - $bbllx}] [expr {0 - $bblly}]
    my add_eps $eps $x1 $y1
    return true
  }

  method importeps {epsobj xpos ypos} {
    my add_eps $epsobj $xpos $ypos
    return true
  }

  method add_eps {epsobj xpos ypos} {
    variable opt
    if {[info object class $epsobj] ne "::pentcl::EpsSimpleClass"} {
      error "internal error: add_eps[0] must be eps object"
    }
    if {[dict get $opt pspagecount] == 0 && ![dict get $opt eps]} {
      # Cannot draw on to non-page when not an eps file
      error "importeps: no current page"
      return false
    }
    if {![dict get $opt usedimporteps]} {
      dict append opt psfunctions {/BeginEPSF {
  /b4_Inc_state save def /dict_count countdictstack def
  /op_count count 1 sub def userdict begin /showpage { } def
  0 setgray 0 setlinecap 1 setlinewidth 0 setlinejoin
  10 setmiterlimit [ ] 0 setdash newpath /languagelevel where {
    pop languagelevel 1 ne {
      false setstrokeadjust false setoverprint
    } if
  } if
} bind def
/EndEPSF {
  count op_count sub {pop} repeat countdictstack dict_count
  sub {end} repeat b4_Inc_state restore
} bind def
}
# end of psfunctions PostScript code block
      dict set opt usedimporteps true
    }

    dict append opt pspages "BeginEPSF\n"    \
      "$xpos ux $ypos uy translate\n"        \
      "1 ux 1 uy scale\n"                    \
      [$epsobj get_include_data $xpos $ypos] \
      "EndEPSF\n"
    return true
  }
}

package provide pentcl $::pentcl::version

# example.tcl (0.07b2)
# } Examples for pentcl.tcl
# based on example by Matthew Newton, 09 November 2003

set auto_path [linsert $auto_path 0 [pwd]]
package require pentcl

proc mynewpage {ps title} {
  $ps newpage
  $ps box 10 10 200 287
  $ps line 10 277 200 277
  $ps setfont Times-Roman 14
  $ps text 15 280 "Pentcl example file: $title"
}

variable ps undefined
variable eps undefined
variable demosquare undefined
variable directeps undefined
variable y undefined

# First, create an EPS file for use later

set ps [::pentcl::PsSimpleClass new [dict create \
  xsize 100 \
  ysize 100 \
  colour true \
  eps true \
  reencode undefined] \
]

$ps setlinewidth 5
$ps box 10 10 90 90
$ps setlinewidth thin
$ps line 0 50 100 50
$ps line 50 0 50 100
$ps line 0 40 0 60
$ps line 100 40 100 60
$ps line 40 0 60 0
$ps line 40 100 60 100
set demosquare [$ps get]

# Let's also create an EPS object directly from it
# set directeps [::pentcl::EpsSimpleClass new [dict create source [$ps get]]]
set directeps [$ps geteps]
unset ps

# Now generate the demo document. Start by creating the A4 document.
set ps [::pentcl::PsSimpleClass new [dict create \
  papersize A4 \
  units mm \
  colour true \
  eps false \
  reencode undefined] \
]

# Create page (EPS import from a file, demo-square.eps)
mynewpage $ps "EPS import functions"
$ps setfont Courier 10

set opt [dict create rotate -90]

$ps setcolour red
$ps box 20 210 45 260
$ps importepsdata $demosquare 20 210 45 260
$ps setcolour darkred
$ps text -opt $opt 14 270 {$ps importepsdata $demosquare 20 210 45 260}

$ps setcolour green
$ps box 80 210 105 260
$ps importepsdata -opt [dict create stretch true] $demosquare 80 210 105 260
$ps setcolour darkgreen
$ps text -opt $opt 74 270 \
  {$ps importepsdata -opt [dict create stretch true] $demosquare 80 210 105 260}

$ps setcolour blue
$ps box 140 210 165 260
$ps importepsdata -opt [dict create overlap true] $demosquare 140 210 165 260
$ps setcolour darkblue
$ps text -opt $opt 134 270 \
  {$ps importepsfile -opt [dict create overlap true] $demosquare 140 210 165 260}

$ps setcolour 200 0 200
$ps box 30 30 90 90

set eps [::pentcl::EpsSimpleClass new \
  [dict create source $demosquare clip true] \
]

$eps scale [expr {double(60) / 100}]
$eps translate 50 50
$eps rotate 20
$eps translate -50 -50
$ps importeps $eps 30 30
$ps setfont Courier 10
set y 90
$ps text 100 [incr y -5] {set eps [::pentcl::EpsSimpleClass new \ }
$ps text 110 [incr y -5] {  [dict create source $demosquare]]}
$ps text 100 [incr y -5] {$eps scale [expr {60.0 / 100}]}
$ps text 100 [incr y -5] {$eps translate 50 50}
$ps text 100 [incr y -5] {$eps rotate 20}
$ps text 100 [incr y -5] {$eps translate -50 -50}
$ps text 100 [incr y -5] {$ps importeps $eps 30 30}

# Create page (using generated EPS object)
mynewpage $ps "EPS import functions (using internal EPS object)"
$ps setfont Courier 10

set opt [dict create rotate -60]

$ps setcolour red
$ps box 20 210 45 260
#$ps importepsdata $demosquare 20 210 45 260
$directeps reset
$directeps scale [expr {25.0 / [$directeps width]}]
$ps importeps $directeps 20 210
$ps setcolour darkred
$ps text -opt $opt 30 205 {$directeps reset}
$ps text -opt $opt 25 205 {$directeps scale [expr {25.0 / [$directeps width]}]}
$ps text -opt $opt 20 205 {$ps importeps $directeps 20 210}

$ps setcolour green
$ps box 80 210 105 260
#$ps importepsdata -opt [dict create stretch true] $demosquare 80 210 105 260
$directeps reset
$directeps scale \
  [expr {25.0 / [$directeps width ]}] \
  [expr {50.0 / [$directeps height]}]
$ps importeps $directeps 80 210
$ps setcolour darkgreen
$ps text -opt $opt 90 205 {$directeps reset}
$ps text -opt $opt 85 205 {$directeps scale \
  [expr {25.0 / [$directeps width ]}] \
  [expr {50.0 / [$directeps height]}]}
$ps text -opt $opt 80 205 {$ps importeps $directeps 80 210}

$ps setcolour blue
$ps box 140 210 165 260
$directeps reset
$directeps scale [expr {50.0 / [$directeps height]}]
$ps importeps $directeps 140 210
$ps setcolour darkblue
$ps text -opt $opt 150 205 {$directeps reset}
$ps text -opt $opt 145 205 \
  {$directeps scale [expr {50.0 / [$directeps height]}]}
$ps text -opt $opt 140 205 {$ps importeps $directeps 140 210}

$ps setcolour 200 0 200
$ps box 30 30 90 90

$directeps reset
$directeps translate 50 50
$directeps rotate 20
$directeps translate -50 -50
set eps [::pentcl::PsSimpleClass new \
  [dict create eps true xsize 100 ysize 100]]
$eps importeps $directeps 0 0
set directeps [$eps geteps]
$directeps scale [expr {60.0 / 100}]
$ps importeps $directeps 30 30
$ps setfont Courier 10
set y 80
$ps text 100 [incr y -5] {$directeps reset}
$ps text 100 [incr y -5] {$directeps translate 50 50}
$ps text 100 [incr y -5] {$directeps rotate 20}
$ps text 100 [incr y -5] {$directeps translate -50 -50}
$ps text 100 [incr y -5] {# round-about way to set clipping path}
$ps text 100 [incr y -5] {set eps [::pentcl::PsSimpleClass new \ }
$ps text 110 [incr y -5] {  [dict create eps true xsize 100 ysize 100]]}
$ps text 100 [incr y -5] {$eps importeps $directeps 0 0}
$ps text 100 [incr y -5] {set directeps [$eps geteps]}
$ps text 100 [incr y -5] {$directeps scale [expr {60.0 / 100}]}
$ps text 100 [incr y -5] {$ps importeps $directeps 30 30}

# Write out the document.
set fh [open "demo.ps" w]
puts -nonewline $fh [$ps get]
close $fh