%
% 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
%
%
% @(#)scaledtext 23.2 90/06/19
%
% Copyright (c) 1989 by Sun Microsystems, Inc.
%

/ScaledTextDemoCanvas ClassCanvas dictbegin
    /repaintproc null def
    /Font /Times-Roman findfont def
    /LabelFont /Times-Roman findfont 12 scalefont def
    /y 0 def
    /pts 0 def
dictend
classbegin

    /TextString (The time has come, the Walrus said...) def

    /PaintCanvas {
	gsave
	FillColor FillCanvas
	/repaintproc {
	    /y Height def		% start at the top of the canvas
	    TextColor setcolor
	    6 2 72 {
		% all even point sizes from 6 to 72.
		/pts exch def

		% move the baseline down by the fontsize
		% plus 2 points of leading.

		/y y pts sub 2 sub def
		y 0 lt { exit } if

		% print the point size right justified at x = 40
		% and y = 40% above the baseline in 12 point Times-Roman.

		LabelFont setfont
		pts 2 string cvs
		40 1 index stringwidth pop sub
		pts 12 sub .4 mul y add moveto show
		pause

		% print the text 10 more to the right at the baseline.
		% in the currentfont at the current size.

		Font pts scalefont setfont
		50 y moveto TextString show
		pause
	    } for
	} refork
	grestore
    } def

    /ChangeFont { % font => -
	dup null exch /setfooter /parent self send send
	findfont /Font exch def
	/paint self send
    } def

    /testfont { dup FontDirectory exch known not { pop } if } def

    /addfoundry { % (foundry) [fonts] => -
	dup null {
	    /valuething 1 index send
	    /ChangeFont /sendtarget 4 -1 roll send
	} framebuffer /newdefault ClassMenu send
	exch length 1 add 2 idiv false exch 2 /setlayoutstyle 4 index send
	true /setpinnable 2 index send
	99 3 1 roll null /insert CanvasMenu send
    } def

    /newinit {
	/newinit super send

	/CanvasMenu [] null null framebuffer /newdefault ClassMenu send def
	(Fonts) /setlabel CanvasMenu send

	(ITC) [
	    (AvantGarde-Book) testfont
	    (AvantGarde-BookOblique) testfont
	    (AvantGarde-Demi) testfont
	    (AvantGarde-DemiOblique) testfont
	    (Bookman-Demi) testfont
	    (Bookman-DemiItalic) testfont
	    (Bookman-Light) testfont
	    (Bookman-LightItalic) testfont
	    (ZapfChancery-MediumItalic) testfont
	] addfoundry

	(Linotype) [
	    (Helvetica) testfont
	    (Helvetica-Bold) testfont
	    (Helvetica-BoldOblique) testfont
	    (Helvetica-Oblique) testfont
	    (NewCenturySchlbk) testfont
	    (NewCenturySchlbk-Bold) testfont
	    (NewCenturySchlbk-BoldItalic) testfont
	    (NewCenturySchlbk-Italic) testfont
	    (NewCenturySchlbk-Roman) testfont
	    (Palatino) testfont
	    (Palatino-Bold) testfont
	    (Palatino-BoldItalic) testfont
	    (Palatino-Italic) testfont
	    (Palatino-Roman) testfont
	    (Times-Bold) testfont
	    (Times-BoldItalic) testfont
	    (Times-Italic) testfont
	    (Times-Roman) testfont
	] addfoundry

	(Monotype) [
	    (Bembo) testfont
	    (Bembo-Bold) testfont
	    (Bembo-BoldItalic) testfont
	    (Bembo-Italic) testfont
	    (Bembo-Roman) testfont
	    (GillSans) testfont
	    (GillSans-Bold) testfont
	    (GillSans-BoldItalic) testfont
	    (GillSans-Italic) testfont
	    (GillSans-Roman) testfont
	    (Rockwell) testfont
	    (Rockwell-Bold) testfont
	    (Rockwell-BoldItalic) testfont
	    (Rockwell-Italic) testfont
	    (Rockwell-Roman) testfont
	] addfoundry

	(Bigelow & Holmes) [
	    (Lucida-Bright) testfont
	    (Lucida-BrightDemiBold) testfont
	    (Lucida-BrightDemiBoldItalic) testfont
	    (Lucida-BrightItalic) testfont
	    (LucidaSans) testfont
	    (LucidaSans-Bold) testfont
	    (LucidaSans-BoldItalic) testfont
	    (LucidaSans-Italic) testfont
	    (LucidaSansTypewriter) testfont
	    (LucidaSansTypewriter-Bold) testfont
	] addfoundry

    } def

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

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

classend def

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

{   gsave
	/client /sendsuperframe /parent self send send
	{ /Font load } exch send
	48 scalefont setfont
	FillColor fillcanvas
	TextColor strokecanvas
	(St)
	dup stringbbox exch 64 exch sub 2 div exch 64 exch sub 2 div moveto
	pop pop
	show
    grestore
} /seticon win send

null /seticonlabel win send
(Scaled Text) /setlabel win send
(Font:) (Times-Roman) /setfooter win send

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

newprocessgroup
currentfile closefile
