#!/usr/NeWS/bin/psh
% 
% Copyright (C) 1988 by Martha Zimet. All rights reserved.
% This program is provided for unrestricted use, provided that this 
% copyright message is preserved. There is no warranty, and no author 
% or distributer accepts responsibility for any damage caused by this 
% program. 
%
% 			NeWS Root Image
% 
% The following can be used as a NeWS root image by adding it as a selection 
% to Root Image => on the DemoMenu.
% 
% It can also be easily used and modified since characters and spacing
% are passed as argumemts to the procedure 'thru_plane.'
% 
% ---------------------------------

% NeWS Root - letters through walls
%
%  Martha Zimet

/NeWS_Root {

% definitions ---------------------------------

/inch { 72 mul } def		
/Times-Roman findfont 200 scalefont setfont

% procedures  ---------------------------------

/get_bounds 	% - => - (get char path)
 { gsave
     newpath
     0 0 moveto
     true charpath flattenpath pathbbox
   grestore
 } def

/center_rotate 	% lx ly ux uy border char angle => - (center and rotate char)

 { /angle exch def
   /chr exch def
   chr get_bounds
   /ur.y exch def
   /ur.x exch def
   /ll.y exch def
   /ll.x exch def
   gsave
     ur.x ll.x sub 2 div ur.y ll.y sub 2 div translate 
     angle rotate
     chr show
   grestore
 } def

/thru_plane		%  offset char => - (print character through plane)
 { /offset exch def
   /char exch def
   gsave
    newpath
     gsave 
        150 425 translate
        plane_angle rotate
        -150 -425 translate
% 				draw trapzoid
        100 350 moveto
        0 150 rlineto
        100 100 rlineto
        0 -350 rlineto
       closepath 
       .1 setlinewidth
       .8 setgray
       gsave fill grestore
       0 setgray
       gsave stroke grestore
     grestore
  grestore
% 				draw character
  150 offset add 300 moveto
  char 20 center_rotate
% 				create path for clipping
  gsave
   gsave
     150 425 translate plane_angle rotate
     -150 -425 translate
     -.1 -2 translate
     newpath
       150 550 moveto
       50 50 rlineto
       0 -350 rlineto
       -50 50 rlineto
     closepath 
     .1 2 translate
     clip
     150 425 translate plane_angle neg rotate -150 -425 translate
     newpath
       150 offset add 300 moveto
       .4 setgray
       char 20 center_rotate
    grestore
   grestore

  gsave
   gsave    
     150 425 translate plane_angle rotate
     -150 -425 translate
     202 600 moveto
     0 -350 rlineto
     -2 0 rlineto
     0 350 rlineto
     closepath
     1 setgray
     gsave fill grestore
     0 setgray
     .2 setlinewidth
     gsave stroke grestore
   grestore
  grestore
  235 0 translate
} def

% go for it ---------------------------------

gsave
    framebuffer setcanvas
    DefaultRootGrayOrColor dup type
	/colortype eq { setcolor } { setgray } ifelse
    clippath fill
    colorcanvas { 0 0 0 sethsbcolor } if


    /plane_angle 0 def
    15 rotate
    3.5  -2 inch translate

    gsave
  	.7 .7 scale
  	(N) -.4 inch thru_plane
  	(e) -.2 inch thru_plane
  	(W) -.6 inch thru_plane
  	(S) -.1 inch thru_plane
    grestore

grestore

} def 			% end of NeWS_Root

NeWS_Root