%
% 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 23.4 90/06/19
%
% Text fonts demo:
% Creates a window and paints text in it. The menu changes the font and looks.
%

/TextCanvas ClassCanvas dictbegin
    /Paragraph null def
    /FillColor		1 def
    /TextColor		0 def
    /TextFont		(Times-Roman) def
    /TextSize		24 def
    /Points		(24 Points) def
    /GrayLevel		.5 def
    /Contrast		0 def
dictend
classbegin

% Class Variables:
    /CanvasMenu null def
    /FontMenu null def
    /PointMenu null def
    /GrayMenu null def
    /ContrastMenu null def

    /nFonts		0 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

% Methods:

    % Create a new canvas and add a menu
    %
    /newinit {
	/newinit super send
	/CreateMenu self send
	/Paragraph TextParagraph store
    } def

    % Change the text and fill colors
    %
    /ChangeContrast { % contrast => -
	/Contrast 1 index def {
	    0 { 1 0 }
	    1 { 0 1 }
	    2 { GrayLevel 0 }
	    3 { GrayLevel 1 }
	    4 { 1 GrayLevel }
	    5 { 0 GrayLevel }
	} case
	/TextColor exch def 
	/FillColor exch def
	/paint self send
    } def

    % Return the Text paragraph
    %
    /SetTextParagraph { % - => array
	/Paragraph TextParagraph def
	/paint self send
    } def

    % Return the All paragraph
    %
    /SetAllParagraph { % - => array
	/Paragraph AllParagraph def
	/paint self send
    } def

    % Change the current point size
    %
    /ChangePointSize { % (points) => - 
	dup ( Points) append /Points exch def
	cvi /TextSize exch def
	TextFont Points /setfooter /Parent self send send
	/paint self send
    } def

    % Return the current point size, as a string
    %
    /points { % - => string
	Points
    } def

    % Change the current GrayLevel
    %
    /ChangeGray { % menu => -
	dup
	/value exch send 2 gt {
	    /valuething exch send cvr /GrayLevel exch def
	}{
	    /value exch send 1 add .25 mul /GrayLevel exch def
	} ifelse
	Contrast /ChangeContrast self send
	/paint self send
    } def

    % Change the current TextFont
    %
    /ChangeFont { % (fontname) => -
	/TextFont exch def
	TextFont Points /setfooter /Parent self send send
	/paint self send
    } def

    % Render the text into the canvas
    %
    /FillCanvasWithText { % stringarray => -
	dictbegin
	    /para exch def
	    /fontht currentfont fontheight TextSize max 1.5 mul def
	    /y Height def
	    /line 0 def
	    { /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
	dictend pop
    } def

    % Repaint the canvas
    %
    /PaintCanvas { % - => -
	gsave
	    FillColor fillcanvas
	    TextColor setgray
	    TextFont findfont TextSize scalefont setfont
	    Paragraph /FillCanvasWithText self send
	grestore
    } def

    /CreateMenu { % - => -
	/nFonts 0 store

	/FontMenu [
	     FontDirectory {
		type /nametype eq {
		    pop
		} {
		    255 string cvs
		    % exclude this font if it has OpenLook in the name.
		    (OpenLook) search { pop pop pop } {
			% or if it is the olgx font.
			(olglyph) search { pop pop pop } {
			    % or if it is a bogus Xt+ font.
			    (12) search { pop pop pop } {
			        % or if it has an XLFD long name.
				dup length 30 gt { pop } {
				    /nFonts nFonts 1 add store
				} ifelse
			    } ifelse
			} ifelse
		    } ifelse
		} ifelse
	    } forall
	] /gt quicksort
	null {
	    /valuething 1 index send
	    /ChangeFont /sendtarget 4 -1 roll send
	} framebuffer /newdefault ClassMenu send def
	true nFonts 3 add 4 idiv 4 /setlayoutstyle FontMenu send
	null 8 null /settextparams FontMenu send
	true /setpinnable FontMenu send

	/PointMenu [
	    (6) (8) (10) (12) (14) (16) (18) (24) (32) (64)
	] null {
	    /valuething 1 index send
	    /ChangePointSize /sendtarget 4 -1 roll send
	} framebuffer /newdefault ClassMenu send def
	true /setpinnable PointMenu send

	/GrayMenu [
	    (Dark) (Medium) (Light)
	    (.1) (.2) (.25) (.3) (.4) (.5) (.6) (.7) (.75) (.8) (.9)
	] null {
	    /ChangeGray /sendtarget 2 index send
	} framebuffer /newdefault ClassMenu send def
	true /setpinnable GrayMenu send

	/ContrastMenu [
	    (Black on White) (White on Black)
	    (Black on Gray) (White on Gray)
	    (Gray on White) (Gray on Black)
	] null {
	    /value 1 index send
	    /ChangeContrast /sendtarget 4 -1 roll send
	} framebuffer /newdefault ClassMenu send def
	true /setpinnable ContrastMenu send

	/CanvasMenu [
	    (Fonts) FontMenu null
	    (Points) PointMenu null
	    (Gray Level) GrayMenu null
	    (Contrast) ContrastMenu null
	    (Show Text) null {
		/SetTextParagraph /sendtarget 3 -1 roll send
	    }
	    (Show All) null {
		/SetAllParagraph /sendtarget 3 -1 roll send
	    }
	] framebuffer /newdefault ClassMenu send def
	true /setpinnable CanvasMenu send
	(Text) /setlabel CanvasMenu send
    } def

    /destroy {
	/DestroyMenu self send
	/destroy super send
    } def

    /obsolete {
	/DestroyMenu self send
	/obsolete super send
    } def

    /DestroyMenu {
	CanvasMenu null ne {
	    /destroy CanvasMenu send
	    /destroy FontMenu send
	    /destroy PointMenu send
	    /destroy GrayMenu send
	    /destroy ContrastMenu send
	} if
    } def

    /minsize { % - => w h
	/minsize super send
	64 max exch
	64 max exch
    } def

    /preferredsize { % - => w h
	/preferredsize super send
	350 max exch
	500 max exch
    } def

classend def

/win [TextCanvas] [] framebuffer /newdefault ClassBaseFrame send def

{    gsave
	(Times-Bold) findfont 26 scalefont setfont
	.5 fillcanvas
	0 strokecanvas
	(ABC) dup stringbbox 4 2 roll pop pop		% (ABC) dx dy
	exch Width exch sub 2 div
	exch Height exch sub 2 div 2 add		% (ABC) x y
	3 copy 1 add exch 1 sub exch moveto 1 setgray show
	3 copy 1 sub exch 1 add exch moveto 0 setgray show
	moveto .5 setgray show
    grestore
} /seticon win send
	
(Text) /setlabel win send

% make sure there is no title stripe on the icon.
null /seticonlabel win send

/place win send
/activate win send
/map win send

newprocessgroup
currentfile closefile
