Download raw (4.4 KB)

%%%%%%!PS-Adobe-3.0 EPSF-3.0
%%%%%%%BoundingBox: 0 0 410 330

/curve
{ %def
  save
  4 1 roll
  /y0 exch def
  /layer exch def
  /params exch def

  /width params /width get def
  /angles_b params /angles_b get def
  /angles_m params /angles_m get def
  /dx params /dx get def
  /pe_b params /pe_b get def
  /pe_r params /pe_r get def
  /op_b params /op_b get def
  /op_r params /op_r get def

  /tan
  {	%def
    dup sin exch cos div
  }
  def

  /curr_angle 
	{ %def
    /x exch def
    /angles exch def
    /scale x width div angles length 1 sub mul def
    /angle1 angles scale floor cvi get def
    /angle2 angles scale ceiling cvi get def
    /angle angle1 angle2 angle1 sub scale scale floor sub mul add def
    angle
  } def

  /path { %def
    /y exch def
    0 dx width { %for
      /x exch def
      /angle_b angles_b x curr_angle def

      layer (b) eq { %ifelse
        /angle angle_b def
      }{	%else
        /angle_m angles_m x curr_angle def
        /angle_r pe_r pe_b div angle_b tan mul 1 pe_r pe_b div sub angle_m tan mul add 1 atan def
        /angle angle_r def
      } ifelse
     	
			/y y dx angle tan mul add def
      x y lineto
    } for
  } def

  layer (b) eq { % ifelse
    /h pe_b 1 op_b sub mul def
  }{ %else
    /h pe_r 1 op_r sub mul def
  } ifelse

  newpath
  0 y0 moveto
  y0 path
  reversepath
  y0 h add path
  closepath
  fill

  restore
} def

/curves
{
  save
  3 1 roll
  /layer exch def
  /params exch def

  /height params /height get def
  /pe_b params /pe_b get def
  /pe_r params /pe_r get def
  layer (b) eq
  {
    0 pe_b height
    {
      params layer 3 -1 roll curve
    }
    for
  }
  {
    0 pe_r height
		10 rotate
    {
      params layer 3 -1 roll curve
    }
    for
  }
  ifelse

  restore
}
def

/width 500 def
/overlap 0.9 def


% interesting syntax which i have not seen before.
% seems to be a means of pushing this given set of values onto the stack
/params <<
  /height 260
  /op_b 0.5
  /op_r 0.5
  /pe_b 6
  /pe_r 5.5
  /dx 1
  /angles_b [0]
  /angles_m [30 -30 30 -30 30]
  /width width
>> def

/pb 6 def
/pr 5.5 def
/prb pr pb div def


/headerfont	/UniversElse-Regular findfont 172 scalefont def

/gencurves1 {
  /try exch def
  /trx exch def
  params /angles_b [4 -1 roll dup neg dup neg dup neg dup neg] put
%  50 160 translate
  trx try translate
  {
    gsave
    newpath 0 -500 moveto width overlap mul 0 rlineto 0 1000 rlineto width overlap mul neg 0 rlineto closepath clip
    0 -20 translate
    params (b) curves
    grestore
    gsave
    newpath width 1 overlap sub mul -500 moveto width overlap mul 0 rlineto 0 1000 rlineto width overlap mul neg 0 rlineto closepath clip
    0 20 translate
    params (r) curves
    grestore
  }
  exec

  %showpage
} def

%%%%% end curves1

%%%%% begin blocks

/inch {72 mul} def
/centiinch {0.72 mul} def
0.7 centiinch setlinewidth


/len 170 def		% grating length in centiinches
/wid 120 def		% grating width in centiinches
/len2 len 2 div def
/wid2 wid 2 div def

0.05 inch 1.45 inch translate
gsave


/theta1 0 def		% angle of grating A
/theta2 6 def		% angle of grating B

/rot 0 def		% general rotation to prevent printer artifacts

/p1 3 def		% period of grating A
/p2 3 def		% period of grating B

/xshift1 0.33 p1 mul def	% period-shift of grating A (e.g. 0.5)
/xshift2 0 p2 mul def		% period-shift of grating A (e.g. 0.5)


/genblocks {
% Draw grating A:
gsave
4.0 inch 6 inch translate
theta1 rot add rotate
newpath
0 p1 len		% draw lines
{centiinch len2 p1 div round p1 mul xshift1 sub centiinch sub wid2 centiinch neg moveto
0 centiinch wid centiinch rlineto} for
stroke
-0.95 inch -0.6 inch moveto
grestore

% Draw grating B:
gsave
4.2 inch 5.8 inch translate
theta2 rot add rotate
newpath
0 p2 len		% draw lines
{centiinch len2 p2 div round p2 mul xshift2 sub centiinch sub wid2 centiinch neg moveto
0 centiinch wid centiinch rlineto} for
stroke
-0.95 inch -0.6 inch moveto
grestore
} def

%%%%% end blocks

40 50 160 gencurves1

pstack % maps all objects on stack with == operator, effectively printing all that is on the stack

% /unclipped gstate def

55 11 moveto 
headerfont setfont
(cosic) true charpath clip

30 30 20 gencurves1

showpage

genblocks
showpage

% unclipped setgstate

%180 rotate