postscript gore

cmb.ps

% basic combinators
/dip { 2 dict begin
       /___f exch def /___a exch def
       ___f /___a load end } def
/2dip { 3 dict begin
	/___f exch def /___a exch def /___b exch def
	___f /___b load /___a load end } def
/3dip { 4 dict begin
	/___f exch def /___a exch def /___b exch def /___c exch def
	___f /___c load /___b load /___a load end } def
/4dip { 5 dict begin
	/___f exch def /___a exch def /___b exch def /___c exch def /___d exch def
	___f /___d load /___c load /___b load /___a load end } def
/5dip { 6 dict begin
	/___f exch def /___a exch def /___b exch def /___c exch def /___d exch def /___e exch def
	___f /___e load /___d load /___c load /___b load /___a load end } def
/6dip { 7 dict begin
	/___f exch def /___a exch def /___b exch def /___c exch def /___d exch def /___e exch def /___g exch def
	___f /___g load  /___e load /___d load /___c load /___b load /___a load end } def
/keep { 2 dict begin
	/___f exch def /___a exch def
	/___a load ___f /___a load end } def
/2keep { 3 dict begin
	/___f exch def /___a exch def /___b exch def
	/___b load /___a load ___f /___b load /___a load end } def
/3keep { 4 dict begin
	/___f exch def /___a exch def /___b exch def /___c exch def
	/___c load /___b load /___a load ___f /___c load /___b load /___a load end } def

lib.ps

(cmb.ps) run
%% flags
/debug false def

%% debugging functions
/stack?? {
    (--- stack: \n) print
    stack
    (---\n) print
} def
/curdictdump { currentdict dictdump } def
/alldictdump { (dumping:\n) print
               20 array dictstack
	       dup length 3 exch 3 sub getinterval
	       { dictdump (\n--------\n) print } forall } def
/dictcountdump { length 20 string cvs print ( ) print } def
/thisdictdump { { == == } forall } def
/dictdump { { countdictstack == exch ==only ( ) print == } forall } def

%% stack operations
% (a b c -- b c a)
/rot { 3 2 roll } def

% (a b c -- b c a)
/-rot { 3 1 roll } def
/shove /-rot load def % i find this a more mnemonic name

% (a b -- a b a)
/over { 1 index } def

% (a b -- a b a b)
/2dup { over over } def

%% array functions
% get last element of an array (array -- elem)
/last { dup length 1 sub get } def

% get everything but the last element of an array (array -- elems)
/abl { dup 0 exch length 1 sub getinterval } def

% concatenate all elements of an array of arrays (arrays -- array)
/acat { [ exch { aload pop } forall ] } def

/is-space? { % (char -- bool)
    32 eq
} def

% break a string into words
/words { % (string -- words)
    /instring exch def
    /prev 0 def
    /i 0 def
    [
    0 1 instring length 1 sub {
	/i exch store
	instring i get is-space?
	{ instring prev i prev sub getinterval
	  /prev i 1+ store } if
    } for
    instring prev i prev sub 1+ getinterval
    ]
} def

% checks if this word indicates the end of a sentence
/ends-sentence? { % (word -- bool)
    dup length 1 sub get 46 eq
} def

% swap two elements of an array
/swap { % (arr i1 i2 -- arr)
    /i2 exch def
    /i1 exch def
    /arrr exch def
    arrr i1 get
    arrr i2 get
    arrr exch i1 exch put
    arrr exch i2 exch put
    arrr
} def

% shuffle an array
/shuffle { % (arr -- arr)
    /arr exch def
    1000 {
	arr
	rand arr length 1 sub mod
	rand arr length 1 sub mod
	swap pop
    } repeat
    arr
} def

%% dictionary functions
% use function to update symbol in current dictionary (symbol f --)
/update { over load exch exec store } def
% increment val in current dict (amt symbol --)
/inc { dup load rot add store } def
% increment val in current dict by 1 (symbol --)
/inc1 { 1 exch inc} def
% decrement val in current dict (amt symbol --)
/dec { dup load rot sub store } def
% decrement val in current dict by 1 (symbol --)
/dec1 { 1 exch dec } def

%% path operations
% run a function, extract the generated path without changing the graphics state (f -- upath)
/extracting-path  { gsave exec false upath grestore } def

% extract the charpath without changing the graphics state (string -- upath)
/extract-charpath { { false charpath } extracting-path } def

%% page geometry functions
/pdims { currentpagedevice /PageSize get } def
% (-- page_width)
/pwidth { currentpagedevice /PageSize get 0 get } def
% (-- page_height)
/pheight { currentpagedevice /PageSize get 1 get } def

%% math functions
% (x -- x^2)
/sq { dup mul } def

% (x -- x+1)
/1+ { 1 add } def

/point-mul { % (x y n -- x*n y*n)
    rot over mul
    shove mul
} def

/point-add { % (x0 y0 x1 y1 -- (x0+x1) (y0+y1))
    rot
    { add } 2dip
    add
} def
/squared { dup mul } def
/cubed { dup dup mul mul } def

%% rendering fun functions
% converting a curveto to a series of lineto instructions
/curve-to-lines { % (x0 y0 x1 y2 x2 y2 x3 y3 x4 y4 -- instructions)
    /t 0 def
    /y3 exch def /x3 exch def
    /y2 exch def /x2 exch def
    /y1 exch def /x1 exch def
    /y0 exch def /x0 exch def
    0 0.1 1 {
	/t exch store
	1 t sub cubed x0 exch y0 exch point-mul
	1 t sub squared 3 mul t mul x1 exch y1 exch point-mul point-add
	1 t sub 3 mul t squared mul x2 exch y2 exch point-mul point-add
	t cubed x3 exch y3 exch point-mul point-add
	[ shove /lineto ]
    } for
} def
% convert upath into an instructions format we use internally (upath -- insts)
/to-instructions {
  2 dict
  dup /realtype { } put
  dup /nametype { ] [ } put
  /_fd exch def
  /f { dup type _fd exch get exec } def
  [ exch [ exch /f load forall ] pop ]
  /instruction-filter hook-func-exec
} def

% reposition printing on next line
/carriage-return { % (height --)
    stringwidth exch pop line-height add    % get height of string, w/ padding
    currentpoint exch pop exch sub % add to current y position
    lm exch moveto                 % return to left margin with calculated y position
    /line-width lm store
} def

/paragraph-return { % (--)
    currentpoint exch pop lm exch moveto
    0 -20 rmoveto
    /line-width lm store
} def

% indenting for paragraphs
/paragraph-indent { % (--)
    currentpoint exch pop lm exch moveto
    paragraph-indent-width 0 rmoveto
    /line-width line-width paragraph-indent-width add store
} def

% will printing word in current position take us past right margin?
/word-beyond-margin? { % (word -- bool)
    stringwidth pop line-width add rm gt
} def

% determins proper positioning for word
/place-word { % (word --)
    dup word-beyond-margin?
    { carriage-return } { pop } ifelse
} def

% keep track of current word with
/update-width { % (word --)
    debug { (update-width ) print } if
    dup stringwidth pop line-width add
    /line-width exch store
    stringwidth pop word-width add
    /word-width exch store
} def

% clear tracking of current word with
/reset-word-width { /word-width 0 store } def % (--)

% given an array of instructions, perform all the rendering actions
/upathforall { % (instructions --)
    debug { (upathforall ) print } if
    { aload pop path-func exch get exec } forall
    debug { (upathforall (done) ) print } if
} def

% places and renders a list of words
/typeout { % (words -- instructions)
    debug { (typeout ) print } if
    /es false def
    [ exch {
	  dup ==
	  /before-word hook-func-exec
	  reset-word-width
	  dup place-word
	  dup ends-sentence? { /es true store } if
	  dup update-width
	  { false charpath
	    /es load
	    { /after-sentence hook-func-exec
	      /before-sentence hook-func-exec }
	    { ( ) dup update-width
	      false charpath }
	    /es false store
	    ifelse } extracting-path
	  word-width 0 rmoveto
	  /after-word hook-func-exec
      } forall ]
    acat
    to-instructions
} def

% call a hook function
/hook-func-exec { % (symbol --)
    debug { (h-f-e ) print dup == } if
    % (??0 ) print
    /hook-func load
    % (??1 ) print
    exch
    % stack??
    get exec
    % (??2 ) print
    debug { (h-f-e (done) ) print } if
    % (??3 ) print
} def

% takes a string renders it on the page
/out { % (string --)
    debug { (out ) print } if
    /before-paragraph hook-func-exec
    /before-sentence hook-func-exec
    words typeout upathforall
    0.2 setlinewidth
    currentpoint % for the later 'moveto'
    stroke
    newpath
    moveto
    /after-paragraph hook-func-exec
} def

% (--)
/font-setup { font findfont font-size scalefont setfont } def

% break a new page. make sure to do this after drawing has been committed
% (after-paragraph should be ok)
/page-break {
    debug { (pb ) print } if
    /after-page hook-func-exec
    showpage
    /before-page hook-func-exec
    debug { (pb (done) ) print } if
} def

% common setup for rendering functions
/render-setup { % (customization-block --)
    100 dict begin
    % config parameters
    % margins
    /lm 50 def              % left
    /rm pwidth 100 sub def  % right
    /tm pheight 100 sub def % top
    /bm 100 def             % bottom

    /paragraph-indent-width 100 def
    /font /Times def
    /font-size 12 def
    /line-height 20 def

    % rendering functions
    /path-func 5 dict def
    path-func /setbbox { pop pop pop pop } put
    path-func /moveto { moveto } put
    path-func /lineto { lineto } put
    path-func /curveto { curveto } put
    path-func /closepath { closepath } put

    % hook functions
    /hook-func 20 dict def
    hook-func /before-paragraph { paragraph-indent } put
    hook-func /after-paragraph { paragraph-return } put
    hook-func /before-sentence { } put
    hook-func /after-sentence { (  ) dup update-width false charpath } put
    hook-func /before-page { lm tm moveto } put
    hook-func /after-page { } put
    hook-func /before-word { } put
    hook-func /after-word  { } put
    hook-func /before-file { } put
    hook-func /after-file { } put
    hook-func /between-file { } put
    hook-func /after-all { } put
    hook-func /instruction-filter { } put

    exec

    font-setup

    % local variables used
    /scr 30000 string def
    /line-width lm def
    /word-width 0 def
} def

% execute a function for each line in a file
/forall-lines { % (file block --)
    /blk exch def
    /infile exch def
    { infile bytesavailable 0 gt not { exit } if % are we at end of file?
      infile scr readline pop                    % read line into string
      /blk load exec                                 % run block
    } loop
} def

% render file, takes block for setup
/render-file { % (filename block --)
    render-setup
    render-file-helper
} def

/render-file-helper { % (filename --)
    /before-page hook-func-exec
    (r) file
    { dup == out } forall-lines
} def

% is the current page blank?
/is-blank-page? { % (-- bool)
    false upath length 0 gt
} def

% get the instructions for the drawn thing in the block
/instructions-for { % (block -- instructions)
    extracting-path
    to-instructions
} def

% allows you to draw figures subject to the same upathforall hooks
/draw { % (block --)
    debug { (draw ) print } if
    extracting-path
    to-instructions
    upathforall
    stroke
} def

% draw, but put point where it was when finished drawing
/draw-keep-point { % (block --)
    debug { (draw ) print } if
    extracting-path
    to-instructions
    upathforall
    currentpoint
    stroke
    moveto
} def

% draw, but put point back to starting point after
/draw-restore-point { % (block --)
    currentpoint /oy exch def /ox exch def
    debug { (draw ) print } if
    extracting-path
    to-instructions
    upathforall
    stroke
    ox oy moveto
} def

% like render, but accepts a list of text files to render,
/render-files { % (filenames block --)
    render-setup
    /ii 0 def
    dup /len exch length def
    { render-files-helper } forall
    /after-all hook-func-exec
} def
/render-files-helper {
    /before-file hook-func-exec
    render-file-helper
    ii len 1 sub lt { /between-file hook-func-exec } if
    /ii { 1 add } update
    /after-file hook-func-exec
} def

% renders a random number of files from a directory
/render-directory-randomly { % (directory count config-block --)
    render-setup
    /count exch def
    /path exch def
    /ii 0 def
    /len count def
    [ path {100 string copy} 100 string filenameforall ]
    shuffle 0 count getinterval
    { dup == render-files-helper } forall
    /after-all hook-func-exec
} def

% renders the contents of a block, as opposed to file or whatever
/render-free { % (config-block block --)
    exch
    render-setup
    exec
} def