b.ps

%!PS-Adobe-2.0 EPSF-2.0
%%Title: Three shades of fish - a postscript on functional geometry
%%Creator: Einar W. Høst 
%%Pages: 1
%%EndComments
%%BeginProlog
%%EndProlog

%%Page: 1 1

%%% DRAWING PROCEDURES

/draw-point {   % x y 
  2 copy        % x y x y 
  exch          % x y y x 
  0.01 sub      % x y y x-1
  exch          % x y x-1 y 
  0.01 sub      % x y x-1 y-1
  4 2 roll      % x-1 y-1 x y 
  exch          % x-1 y-1 y x 
  0.01 add      % x-1 y-1 y x+1
  exch          % x-1 y-1 x+1 y
  0.01 add      % x-1 y-1 x+1 y+1
  4 copy        % x-1 y-1 x+1 y+1 x-1 y-1 x+1 y+1
  3 1 roll      % x-1 y-1 x+1 y+1 x-1 y+1 y-1 x+1
  exch          % x-1 y-1 x+1 y+1 x-1 y+1 x+1 y-1 
  moveto lineto 
  moveto lineto
} def 

% Consumes: [ r g b ] color
% Produces: 
% Side-effect: drawing.
/draw-birb {                 % color
  newpath

%  (draw-birb begin) ==
%  (color) ==
%  dup == 

   0.000  0.000 moveto 

   % South side
   
   0.134  0.093
   0.237  0.128
   0.396  0.137 curveto 

   0.420  0.013
   0.447 -0.069
   0.526 -0.168 curveto

   0.630 -0.092 
   0.681 -0.021
   0.679  0.132 curveto 

   0.818  0.128
   0.901  0.086
   1.000  0.000 curveto 

   % East side 

   1.072 0.224 
   1.015 0.374
   0.877 0.476 curveto 

   0.801 0.481
   0.699 0.385
   0.623 0.390 curveto

   0.485 0.492 
   0.428 0.642
   0.500 0.866 curveto

   % West side

   0.376 0.823
   0.298 0.772
   0.225 0.654 curveto 

   0.359 0.579
   0.395 0.500
   0.408 0.372 curveto
   
   0.283 0.353
   0.199 0.370
   0.079 0.411 curveto

   0.008 0.269
  -0.014 0.163
   0.000 0.000 curveto 

  closepath

   

  aload pop                  % r g b

  gsave
  setrgbcolor % oc          % ic oc 
  fill 
  grestore 

  0 0 0 setrgbcolor 

  0.004 setlinewidth

  stroke

  % Lines

  newpath

  % BEAK

  0.405 0.823 moveto 

  0.413 0.795 
  0.435 0.772
  0.475 0.770 curveto

  0.446 0.778 moveto

  0.460 0.825
  0.480 0.840 
  0.500 0.866 curveto 

  % WING LINES

% Line 1

  0.098 0.316 moveto 
  0.072 0.220 
  0.060 0.150 
  0.068 0.047 curveto 
  
% Line 2

  0.155 0.300 moveto
  0.140 0.228 
  0.132 0.160 
  0.137 0.080 curveto

% Line 3

  0.215 0.289 moveto
  0.205 0.228 
  0.198 0.170 
  0.203 0.105 curveto

% Line 4

  0.276 0.282 moveto
  0.270 0.230 
  0.262 0.170 
  0.268 0.123 curveto

% Line 5  

  0.337 0.276 moveto
  0.330 0.230 
  0.328 0.175 
  0.332 0.132 curveto 

% Line 6

  0.400 0.279 moveto
  0.392 0.230 
  0.392 0.180 
  0.396 0.137 curveto

%%%%%%

% Line 7

  0.652 0.290 moveto
  0.669 0.232 
  0.682 0.182 
  0.679 0.132 curveto 

% Line 8

  0.699 0.298 moveto
  0.722 0.238 
  0.729 0.180  
  0.727 0.127 curveto
  
% Line 9 

  0.748 0.310 moveto
  0.772 0.241 
  0.782 0.178 
  0.779 0.121 curveto

% Line 10
  
  0.798 0.325 moveto
  0.830 0.244 
  0.838 0.170 
  0.832 0.105 curveto
  
% Line 11

  0.848 0.340 moveto
  0.882 0.252  
  0.898 0.160 
  0.883 0.083 curveto

% Line 12
  
  0.898 0.360 moveto
  0.950 0.260 
  0.964 0.154 
  0.942 0.045 curveto

% HEAD
  0.253 0.637 moveto 
  0.262 0.654 
  0.274 0.669 
  0.282 0.679 curveto
      
  0.282 0.617 moveto 
  0.288 0.628 
  0.293 0.636 
  0.299 0.644 curveto

  stroke

  % Eye

  newpath
   0.367 0.753 0.01 0 360 arc 
  closepath

  fill 

  0.004 setlinewidth

  newpath
   0.367 0.753 0.02 0 360 arc 
  closepath

  stroke 


%  (end draw-birb) ==

} def

/step-point {           % pos theta side   
  exch                  % pos side theta
  3 -1 roll             % side theta pos 
  aload pop             % side theta x y
  4 1 roll              % y side theta x 
  2 index               % y side theta x side 
  2 index               % y side theta x side theta
  cos mul add           % y side theta x'
  4 1 roll              % x' y side theta
  sin mul add           % x' y' 
  2 array astore        % pos'
} def 

/cross-point {          % pos theta side
  dup                   % pos theta side side 
  4 1 roll              % side pos theta side

  1 index               % side pos theta side theta 
  4 1 roll              % side theta pos theta side
  
  step-point            % side theta pos'

  exch                  % side pos' theta

  60 add                % side pos' theta'

  3 -1 roll             % pos' theta' side 

  step-point 
} def

% Consumes: tx
% Produces: txw txe txn txm
/create-toxes {         % tx
%  (create-toxes begin) ==
%  (original-tox) ==  
%  dup == 

  aload pop             % pos ang len
  2 div                 % pos ang len' 
  3 array astore        % txw

%  (west-tox) == 
%  dup == 

  aload                 % pos ang len' txw
  4 1 roll              % txw pos ang len'
  
  cross-point           % txw ^pos

%  (x-point) ==
%  dup == 

  % east 
  1 index               % txw ^pos txw
  aload pop             % txw ^pos pos ang len'
  3 -1 roll             % txw ^pos ang len' pos 
  pop                   % txw ^pos ang len' 
  exch                  % txw ^pos len' ang 
  240 add 360 mod       % txw ^pos len' ange
  exch                  % txw ^pos ange len' 
  2 index               % txw ^pos ange len' ^pos
  3 1 roll              % txw ^pos ^pos ange len'
  3 array astore        % txw ^pos txe

%  (east-tox) ==
%  dup == 

  exch                  % txw txe ^pos

  % north 
  2 index               % txw txe ^pos txw
  aload pop             % txw txe ^pos pos ang len'
  3 -1 roll             % txw txe ^pos ang len' pos 
  pop                   % txw txe ^pos ang len' 
  exch                  % txw txe ^pos len' ang 
  120 add 360 mod       % txw txe ^pos len' angn
  exch                  % txw txe ^pos angn len' 
  2 index               % txw txe ^pos angn len' ^pos
  3 1 roll              % txw txe ^pos ^pos angn len'
  3 array astore        % txw txe ^pos txn
  exch                  % txw txe txn ^pos

%  (north-tox) ==
%  dup ==

  % middle 
  3 index               % txw txe txn ^pos txw
  aload pop             % txw txe txn ^pos pos ang len'
  3 -1 roll             % txw txe txn ^pos ang len' pos 
  pop                   % txw txe txn ^pos ang len' 
  exch                  % txw txe txn ^pos len' ang 
  180 add 360 mod       % txw txe txn ^pos len' angm
  exch                  % txw txe txn ^pos angm len' 
  2 index               % txw txe txn ^pos angm len' ^pos
  3 1 roll              % txw txe txn ^pos ^pos angm len'
  3 array astore        % txw txe txn ^pos txm
  exch                  % txw txe txn txm ^pos

  pop                   % txw txe txn txm 

%  (middle-tox) ==
%  dup ==

%  (end create-toxes) == 
} def 

%%% PICTURE PROCEDURES 

% Consumes: a procedure that draws lines for a picture.
% Produces: a picture-procedure that consumes a lens [colors tox] and draws a picture.
/create-picture {    % ls * dp
%  (create-picture begin) ==
  [ exch             % ls * [ dp 
    {                % ls dp
      gsave          % ls dp
      exch           % dp ls
      
      
      aload pop      % dp cs tx
      
%      (create-picture picture execution begin) == 
%      (tox) ==
%      dup == 

      
      aload pop      % dp cs pos ang len
      3 -1 roll      % dp cs ang len pos 
      aload pop      % dp cs ang len x y 
      translate      % dp cs ang len 
      dup            % dp cs ang len len 
      scale          % dp cs ang 
      rotate         % dp cs
      0 get          % dp c
      exch           % c dp
      exec           % 
      grestore       %
      
%      (end create-picture picture execution) ==
    
    } /exec cvx 
  ] cvx 
%  (end create-picture) ==
} def 

% Consumes: 4 pictures
% Produces: a single picture (lens -> drawing)
/quad-tri {                  % ls * pw pe pn pm 
%  (quad-tri begin) ==
  [                          % ls * pw pe pn pm [
    5 1 roll                 % ls * [ pw pe pn pm 
    {                        % ls pw pe pn pm
      5 -1 roll              % pw pe pn pm ls 

      aload pop              % pw pe pn pm cs tx
 
%      (quad-tri picture execution begin) ==        
%      (tox) ==
%      dup == 

      create-toxes           % pw pe pn pm cs txw txe txn txm
      4 index                % pw pe pn pm cs txw txe txn txm cs
      4 1 roll               % pw pe pn pm cs txw cs txe txn txm 
      3 index                % pw pe pn pm cs txw cs txe txn txm cs
      3 1 roll               % pw pe pn pm cs txw cs txe cs txn txm 
      2 index                % pw pe pn pm cs txw cs txe cs txn txm cs 
      exch                   % pw pe pn pm cs txw cs txe cs txn cs txm
      2 array astore         % pw pe pn pm cs txw cs txe cs txn lsm 
      8 1 roll               % pw pe pn lsm pm cs txw cs txe cs txn
      2 array astore         % pw pe pn lsm pm cs txw cs txe lsn 
      8 1 roll               % pw pe lsn pn lsm pm cs txw cs txe 
      2 array astore         % pw pe lsn pn lsm pm cs txw lse 
      8 1 roll               % pw lse pe lsn pn lsm pm cs txw
      2 array astore         % pw lse pe lsn pn lsm pm lsw
      8 1 roll               % lsw pw lse pe lsn pn lsm pm
      exec                   % lsw pw lse pe lsn pn 
      exec                   % lsw pw lse pe 
      exec                   % lsw ps 
      exec                   %

%      (end quad-tri picture execution) ==        

    } /exec cvx 
  ] cvx
%  (end quad-tri) == 
} def

/inv-color {                 % ls * p 
  [ exch                     % ls * [ p 
    {                        % ls p 
      exch                   % p ls 
      aload pop              % p cs tx
      exch                   % p tx cs
      aload pop              % p tx c1 c2 
      exch                   % p tx c2 c1
      2 array astore         % p tx cs'
      exch                   % p cs' tx 
      2 array astore         % p ls' 
      exch                   % ls' p
      exec
    } /exec cvx 
  ] cvx
} def

% Consumes: a picture 
% Produces: a picture
/self-tri { 
%  (self-tri begin) == 
  dup 
  dup 
  dup 
  inv-color 
  quad-tri 
%  (end self-tri) ==
} def

% Consumes: a picture 
% Produces: a picture 
/diamond {                   % ls * p
  [ exch                     % ls * [ p 
    {                        % ls p 
      exch                   % p ls 
      dup                    % p ls ls
      aload pop              % p ls cs tx 
      aload pop              % p ls cs pos ang len 
      2 copy                 % p ls cs pos ang len ang len
      5 2 roll               % p ls cs ang len pos ang len 
      step-point             % p ls cs ang len pos'
      3 1 roll               % p ls cs pos' ang len 
      exch                   % p ls cs pos' len ang 
      180 add 360 mod        % p ls cs pos' len ang'
      exch                   % p ls cs pos' ang' len 
      3 array astore         % p ls cs tx'
      2 array astore         % p ls ls'
      2 index                % p ls ls' p 
      exec                   % p ls
      exch                   % ls p 
      exec 
    } /exec cvx
  ] cvx 
} def

/diamant {                   % ls * pn ps
  [ 3 1 roll                 % ls * [ pn ps 
    {                        % ls pn ps
      3 -1 roll              % pn ps ls 
      dup                    % pn ps ls ls
      aload pop              % pn ps ls cs tx 
      aload pop              % pn ps ls cs pos ang len 
      exch                   % pn ps ls cs pos len ang 
      300 add 360 mod        % pn ps ls cs pos len ang'
      exch                   % pn ps ls cs pos ang' len 
      3 array astore         % pn ps ls cs tx'
      2 array astore         % pn ps ls ls'
      3 -1 roll              % pn ls ls' ps
      inv-color              % pn ls ls' ps'
      exec                   % pn ls
      exch                   % ls pn 
      exec 
    } /exec cvx
  ] cvx 
} def

% Consumes: a picture 
% Produces: a picture
/skip-top {               % p
  dup dup                 % p p p
  /blank load             % p p p _
  exch                    % p p _ p 
  inv-color
  quad-tri                % p' 
} def 

% Consumes: a picture 
% Produces: a picture
/skip-2 {                 % p
  dup dup                 % p p p
  /blank load             % p p p _
  3 1 roll                % p _ p p 
  inv-color
  quad-tri                % p' 
} def 

% Consumes: a picture 
% Produces: a picture
/skip-tri {               % p
  /blank load             % p _
  
  % west                  
  dup                     % p _ _ 

  2 index                 % p _ _ p
  dup dup                 % p _ _ p p p 
  inv-color               % p _ _ p p p'
  quad-tri                % p _ w

  stack

  3 1 roll                % w p _ 

  % east (skip what, north?)
  1 index                 % w p _ p 
  dup dup                 % w p _ p p p
  3 index                 % w p _ p p p _
  exch                    % w p _ p p _ p 
  inv-color               % w p _ p p _ p'
  quad-tri                % w p _ e

  3 1 roll                % w e p _ 

  % north 
  1 index                 % w e p _ p 
  dup dup                 % w e p _ p p p
  3 index                 % w e p _ p p p _
  3 1 roll                % w e p _ p _ p p 
  inv-color               % w e p _ p _ p p'
  quad-tri                % w e p _ n

  3 1 roll                % w e n p _
  
  % middle 
  pop                     % w e n p
  dup dup dup             % w e n p p p p
  inv-color               % w e n p p p p'
  quad-tri                % w e n m

  quad-tri
  
} def

%%% PICTURES

/blank { pop } def 

/birb-picture { draw-birb } create-picture def 

/some-tox [ [100 300] 0 400 ] def

/other-tox [ [250 186.602539] 240 100 ] def

/some-colors [ 
    [ 1 1 1 ]          % white
    [ 0.4 0.4 0.4 ]    % dark grey 
]
def

/some-lens [ some-colors some-tox ] def

%some-lens /birb-picture load self-tri dup skip-top exch skip-2 diamant exec

some-lens /birb-picture load exec 

% gswin64 -sDEVICE=pdfwrite -o limit-4.pdf 3-color-fish.ps

%%Trailer
%%Pages:      1
%%EOF