#!/usr/bin/tclsh8.0

proc header {file {xHeight 2} {units pc} {weight 0.1}} {
puts $file \
"%!PS-Adobe-2.0
/XHeight $xHeight def
/Units {$units} def
/Weight {$weight} def
"
}

set xHeight 1
set units pc
set weight 0.7

foreach arg $argv {
    switch -glob $arg {
	xHeight=* { set xHeight [string range $arg 8 end] }
	units=* { set units [string range $arg 6 end] }
	weight=* { set weight [string range $arg 7 end] }
	default { set filename $arg }}}

if [info exists filename] \
    { set file [open $filename w] } \
    { set file stdout }
    
header $file $xHeight $units $weight
puts $file {
gsave
initclip clippath pathbbox
/PageHeight exch def
/PageWidth exch def
pop pop
grestore

/in { 72 mul } def
/pt { 1 mul } def
/pc { 12 mul } def
/mm { 2.8346 mul } def

/LineHeight XHeight Units 3 mul def
/nLines PageHeight 1 in sub LineHeight div floor cvi def
/useHeight LineHeight nLines mul def
/useWide PageWidth 1 in sub def

/toStart {
  PageWidth useWide sub 2 div
  PageHeight useHeight sub 2 div XHeight Units add
  moveto
  } def

/showCurrent {
  (Currently at: ) print
  8 string currentpoint
    2 index cvs print ( ) print
    exch cvs print
  () =
  } def

/showDash {
  ([ ) print
  { 4 string cvs print ( ) print } forall
  (]) print
  } def

/doLine {
  % (dash is: ) print dup showDash (, ) print showCurrent
  0 setdash useWide 0 rlineto stroke
  } def

Weight setlinewidth
0 1 nLines 1 sub {
  /Line exch def
  /toLine {
    toStart
    0 Line LineHeight mul
    2 index XHeight Units mul add 
    rmoveto pop
    } def
  0 toLine [] doLine
  1 toLine [6 4 2 4] doLine
  2 toLine [] doLine
  } for
stroke

showpage
}