Thursday, July 25, 2013

skeletons.ps - a PostScript doodle with iteration skeletons 

% Stroked circle
% follows the idiom of builtin arc where X Y are parameters
% (i.e. not the ~moveto~ then ~show~ idiom of text)
%
/SCIRC     % X Y R SCIRC
{
  /R exch def
  /Y  exch def
  /X  exch def
  newpath
  X Y R 0.0 360.0 arc
  closepath
  stroke
} bind def





% Font load
/FL   % SZ NAME FL
{
  findfont exch
  scalefont
  setfont
} bind def


% HREPEAT
/HREPEAT % N X Y DX PROC
{
  /PROC exch def
  /DX exch def
  /Y exch def
  /X exch def
  /N exch def
  N { X Y PROC
      X DX add
      /X exch def } repeat
} bind def

% VREPEAT
/VREPEAT % N X Y DY PROC
{
  /PROC exch def
  /DY exch def
  /Y exch def
  /X exch def
  /N exch def
  N { X Y PROC
      Y DY add
      /Y exch def } repeat
} bind def

% XFORALL
/XFORALL % X Y DX ARR PROC
{
  /PROC exch def
  /ARR exch def
  /DX exch def
  /Y exch def
  /X exch def
  ARR { /A1 exch def
        X Y A1 PROC
        X DX add
        /X exch def } forall
} bind def

% YFORALL
/YFORALL % X Y YX ARR PROC
{
  /PROC exch def
  /ARR exch def
  /DY exch def
  /Y exch def
  /X exch def
  ARR { /A1 exch def
        X Y A1 PROC
        Y DY add
        /Y exch def } forall
} bind def


% XYSHOW
/XYSHOW % X Y STR
{
  /STR exch def
  /Y exch def
  /X exch def
  X Y moveto
  STR show
} bind def


% APPLY2 - apply a procedure taking 2 arguments to an
% array with 2 elems (pair)
/APPLY2     % ARR PROC APPLY2
{
  /PROC exch def
  /ARR exch def
  /S1 ARR 0 get def
  /S2 ARR 1 get def
  S1 S2 PROC
} bind def



gsave

12 /Helvetica FL

gsave

5 100 100 20 { 5 SCIRC } HREPEAT

10 100 200 15 { /Y exch def
                /X exch def
                X Y moveto
                (o) show } HREPEAT

7 300 100 15 { (A) XYSHOW } VREPEAT

300 300 50 [5 10 15 20] { SCIRC } XFORALL


100 300 -15 [(1) (2) (3) (4)] { XYSHOW } YFORALL

grestore
showpage
at