#! /usr/NeWS/bin/psh
%
% This file is a product of Sun Microsystems, Inc. and is provided for
% unrestricted use provided that this legend is included on all tape
% media and as a part of the software program in whole or part.  Users
% may copy or modify this file without charge, but are not authorized to
% license or distribute it to anyone else except as part of a product
% or program developed by the user.
% 
% THIS FILE IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE
% WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
% PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE.
% 
% This file is provided with no support and without any obligation on the
% part of Sun Microsystems, Inc. to assist in its use, correction,
% modification or enhancement.
% 
% SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE
% INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS FILE
% OR ANY PART THEREOF.
% 
% In no event will Sun Microsystems, Inc. be liable for any lost revenue
% or profits or other special, indirect and consequential damages, even
% if Sun has been advised of the possibility of such damages.
% 
% Sun Microsystems, Inc.
% 2550 Garcia Avenue
% Mountain View, California  94043
%
%
%	text 9.2 88/01/18
%
%  TextWindow:
%  Drag a window with a bunch of text. The menu changes the font and looks.
%  This illustrates use of pullrights and circular canvases.
%  Note: Please don't be put off due to the size of this demo; it is large
%	 simply because it's menus & parameters take up a lot of space!
%
/FillCanvasWithText { % stringarray => -
10 dict begin
    gsave
    /para	exch def
    /fontht	currentfont fontheight pointsize max 1.5 mul def
    /y		clippath pathbbox 4 1 roll pop pop pop def
    /line	0 def

    {   pause  % Good manners & allows forked paint client to run.
        /y y fontht sub def
        y 0 le {exit} if
        5 y moveto
        para line get show
        /line line 1 add para length mod def
    } loop

    grestore
end
} def
/TextParagraph [
    (Now is the time for all good men)
    (To come to the aid of the party!)
    (The Quick Brown Fox Jumps Over The Lazy Dog.)
    (Its Crackers to Slip a Rozzer the Dropsy in Snide.)
    ()
    (abcdefghijklmnopqrstuvwxyz)
    (ABCDEFGHIJKLMNOPQRSTUVWXYZ)
    (1234567890/=+-_|,.;:?!)
    (<>()[]{}'"@#$%^&*~)
    ()
] def
/AllParagraph [
    [ 0 1 255 {
        dup 32 mod 31 eq { ] cvas [ } if
    } for pop % ..the last [
] def
/main {
    /Paragraph		TextParagraph def
    /family		0 def
    /FontName		(Times-Roman) def
    /bold		0 def
    /italic		0 def
    /pointsize		24 def
    /fillcolor		1 def
    /textcolor		0 def
    /gray		.5 def

    /settextfont {
        FontName findfont
        pointsize scalefont
        setfont
    } def
    /painttext {/paintclient win send} def

    /SetColors {/textcolor exch store /fillcolor exch store} def
    /SetGray&Paint {/gray exch store /fillcolor gray store painttext} def
    /graymenu
	[(Dark) (Medium) (Light)
	 (.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9)]
	[{.25 SetGray&Paint} {.5 SetGray&Paint} {.75 SetGray&Paint}
         {currentkey cvr SetGray&Paint}]
	/new DefaultMenu send def
    /fontmenu
        [
	    FontDirectory {
		% include all fonts except /Cursor
		pop dup /Cursor ne {
		    25 string cvs
		    dup length 3 le { pop } if
		} {
		    pop
		} ifelse
	    } forall
	]
        [{/FontName currentkey store painttext}]
	/new DefaultMenu send def
    /pointsizemenu
        [(  6  ) (8) (10) (12) (14) (16) (18) (24) (32) (64)]
	[{/pointsize currentkey cvi store painttext}]
	/new DefaultMenu send def

    /win framebuffer /new DefaultWindow send def	% Create a window
    {							% Install my stuff.
	/FrameLabel (Text) def
	/PaintIcon {
	    (Times-Bold) findfont 36 scalefont setfont
	    .5 fillcanvas
	    0 setgray 10 0 0 IconWidth IconHeight ovalframe eofill
	    (A) dup stringbbox 4 2 roll pop pop		% (A) dx dy
	        exch IconWidth exch sub 2 div
	        exch IconHeight exch sub 2 div 2 add	% (A) x y
	    1 setgray moveto show
	} def
	/ShapeIconCanvas {
	    ParentCanvas setcanvas
	    0 0 translate 0 0 IconWidth IconHeight ovalpath
	    IconCanvas reshapecanvas
	} def
	/PaintClient {
	    fillcolor fillcanvas
	    textcolor setgray settextfont
	    Paragraph FillCanvasWithText
	} def
	/ClientMenu [
	    (Fonts =>)		fontmenu
	    (12 Points)		{/pointsize 12 store	painttext}
	    (14 Points)		{/pointsize 14 store	painttext}
	    (18 Points)		{/pointsize 18 store	painttext}
	    (24 Points)		{/pointsize 24 store	painttext}
	    (More Points! =>)	pointsizemenu
	    (Black on White)	{1 0 SetColors		painttext}
	    (Black on Gray)	{gray 0 SetColors	painttext}
	    (White on Gray)	{gray 1 SetColors	painttext}
	    (White on Black)	{0 1 SetColors		painttext}
	    (Show Text)		{/Paragraph TextParagraph store	  painttext}
	    (Show All)		{/Paragraph AllParagraph store	  painttext}
	    (Set Gray =>)	graymenu
	] /new DefaultMenu send def
    } win send
    /reshapefromuser win send				% Shape it.
    /map win send  % Map the window. (Damage causes PaintClient to be called)
} def

main