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

/WideCanvas ClassCanvas dictbegin

% Instance variables:

    /linejoin 0 def
    /linecap 0 def
    /linetype 0 def
    /linestyle 0 def
    /mylinewidth 20 def
    /miterlimit 10 def
    /arcradius 100 def
    /dashpattern [] def
    /dl [ /newpath cvx 10 10 /moveto cvx ] def

dictend classbegin

% Class variables:

    /JoinMenu null def
    /CapMenu null def
    /StyleMenu null def
    /TypeMenu null def
    /WidthMenu null def
    /MiterMenu null def
    /RadiusMenu null def
    /DashMenu null def

% Methods:
    
    % difference from the superclass: canvas has menu
    %
    /newinit { % parent => instance
	/newinit super send
	/CreateMenu self send
	/Times-Roman findfont 8 scalefont setfont
    } def
     
    /Newpath {	% - => -
	/dl [ /newpath cvx 10 10 /moveto cvx ] store
	/paint self send
    } def

    /Closepath {	% - => -
	/dl dl [ /closepath cvx ] append store
	/paint self send
    } def

    /Showpath {		% - => -
    gsave
	dl cvx exec
	emptypath not {
	    [
		{ exch (% % moveto\n) printf }
		{ exch (% % lineto\n) printf }
		{ 6 1 roll 5 1 roll 4 1 roll 3 1 roll exch
			(% % % % % % curveto\n) printf }
		{ (closepath\n) printf }
		{ 3 1 roll exch (% % conic (%)\n) printf }
	    ] pathforallvec
	}
	{
	    (Empty path\n) print
	} ifelse
    grestore
    } def

    /SetJoin {	% linejoin => -
	/linejoin exch store
	/paint self send
    } def

    /SetCap {	% linecap => -
	/linecap exch store
	/paint self send
    } def

    /SetType {	% linetype => -
	/linetype exch store
	/paint self send
    } def

    /SetStyle {		% linestyle => -
	/linestyle exch store
	/paint self send
    } def

    /SetWidth {		% linewidth => -
	/mylinewidth exch store
	/paint self send
    } def

    /SetMiter {		% miterlimit => -
	/miterlimit exch store
	/paint self send
    } def

    /SetRadius {	% arcradius => -
	/arcradius exch store
	/paint self send
    } def

    /SetDash {	% 0..3 => -
	{
		0 { [] }
		1 { [10 15] }
		2 { [20 15] }
		3 { [10 15 20 15] }
	} case
	/dashpattern exch store
	/paint self send
    } def

    /Moveto {		% ev => -
	dup /EatUpEvent self send
	gsave
	/canvas self send setcanvas
	begin
	    /dl dl [ XLocation YLocation /moveto cvx ] append store
	end
	grestore
    } def

    /Lineto {		% ev => -
	begin
	    /dl dl [ XLocation YLocation /lineto cvx ] append store
	end
	/addpaint self send
    } def

    /Arcto {	% ev => -
	begin
	    StrokeColor setcolor
	    dl dup length 1 sub get
		   dup type /integertype ne { pop 0 } if
	    {
		0 {
			/dl dl [ XLocation YLocation 1 ] append store
			XLocation YLocation moveto (. arc point) show
		}
		1 {
			dl dup length 1 sub XLocation put
			/dl dl [
				YLocation arcradius /arcto cvx
				/pop cvx /pop cvx /pop cvx /pop cvx
			] append store
			/paint self send
		}
	    } case
	end
    } def

    /Curveto {	% ev => -
	begin
	    StrokeColor setcolor
	    dl dup length 1 sub get
		   dup type /integertype ne { pop 0 } if
	    {
		0 {
			/dl dl [ XLocation YLocation 1 ] append store
			XLocation YLocation moveto (. curve point 1) show
		}
		1 {
			dl dup length 1 sub XLocation put
			/dl dl [ YLocation 2 ] append store
			XLocation YLocation moveto (. curve point 2) show
		}
		2 {
			dl dup length 1 sub XLocation put
			/dl dl [ YLocation /curveto cvx ] append store
			/paint self send
		}
	    } case
	end
    } def

    /Middle {		% ev => -
	dup /EatUpEvent self send
	gsave
	/canvas self send setcanvas
	linetype {
	    0 { /Lineto self send }
	    1 { /Arcto self send }
	    2 { /Curveto self send }
	} case
	grestore
    } def

    /Stroke {
	linestyle {
	    0 { 0 setgray stroke }
	    1 { strokepath [] 0 setdash 0 setgray 0 setlinewidth stroke }
	    2 { 0 setgray gsave stroke grestore
		strokepath [] 0 setdash 0 setlinewidth stroke }
	    3 { gsave .7 setgray stroke grestore
		strokepath [] 0 setdash 0 setgray 0 setlinewidth stroke }
	} case
    } def

    /paint {
	gsave
	    /canvas self send setcanvas
	    dashpattern 0 setdash
	    mylinewidth setlinewidth
	    linecap setlinecap
	    linejoin setlinejoin
	    miterlimit setmiterlimit
	    erasepage
	    dl cvx exec
	    Stroke
	grestore
    } def

    /addpaint {
	gsave
	    /canvas self send setcanvas
	    dashpattern 0 setdash
	    mylinewidth setlinewidth
	    linecap setlinecap
	    linejoin setlinejoin
	    miterlimit setmiterlimit

	    dl cvx exec
	    Stroke
	grestore
    } def

    /PaintCanvas {
	clippath emptypath not { /paint self send } if
    } def

    /CreateMenu { % - => -
	/JoinMenu
		[ (Miter) (Round) (Bevel) ]
		null {
			/value self send
			/SetJoin /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable JoinMenu send

	/CapMenu
		[ (Butt) (Round) (Square) ]
		null {
			/value self send
			/SetCap /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable CapMenu send

	/StyleMenu
		[ (Filled) (Outline) (Both) (Two Tone) ]
		null {
			/value self send
			/SetStyle /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable StyleMenu send

	/TypeMenu
		[ (Line) (Arc) (Curve)]
		null {
			/value self send
			/SetType /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable TypeMenu send

	/WidthMenu
		[ (0) (1) (2) (3) (4) (5) (10) (15) (20) (25) (50) (100) ]
		null {
			/valuething self send cvi
			/SetWidth /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable WidthMenu send
	8 /setdefault WidthMenu send		% 20

	/MiterMenu
		[ (1) (2) (3) (4) (5) (10) (15) (20) (25) (50) (100) ]
		null {
			/valuething self send cvi
			/SetMiter /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable MiterMenu send
	5 /setdefault MiterMenu send		% 10

	/RadiusMenu
		[ (1) (5) (10) (15) (20) (25) (50) (100) (200) (500) ]
		null {
			/valuething self send cvi
			/SetRadius /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable RadiusMenu send
	7 /setdefault RadiusMenu send		 % 100

	/DashMenu
		[ (Solid) (Dots) (Dashes) (Dot-Dash) ]
		null {
			/value self send
			/SetDash /sendtarget 4 -1 roll send
		}
	framebuffer /newdefault ClassMenu send store
	true /setpinnable DashMenu send

	/CanvasMenu [] null { pop } framebuffer /newdefault ClassMenu send def
	true /setpinnable CanvasMenu send
	(Wide Paths) /setlabel CanvasMenu send

	99 (Newpath)		null
		{ /Newpath /sendtarget 3 -1 roll send }
						     /insert CanvasMenu send
	99 (Closepath)		null
		{ /Closepath /sendtarget 3 -1 roll send }
						     /insert CanvasMenu send
%	99 (Showpath)		null
%		{ /Showpath /sendtarget 3 -1 roll send }
%						     /insert CanvasMenu send
	99 (StrokeStyle)	StyleMenu	null /insert CanvasMenu send
	99 (PathType)		TypeMenu	null /insert CanvasMenu send
	99 (JoinStyle)		JoinMenu	null /insert CanvasMenu send
	99 (CapStyle)		CapMenu		null /insert CanvasMenu send
	99 (LineWidth)		WidthMenu	null /insert CanvasMenu send
	99 (Miterlimit)		MiterMenu	null /insert CanvasMenu send
	99 (DashPatterns)	DashMenu	null /insert CanvasMenu send
	99 (ArcRadius)		RadiusMenu	null /insert CanvasMenu send
    } def


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

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

    % express additional interests for mouse buttons
    %
    /MakeInterests { % - => -
	/MakeInterests super send

	PointButton /Moveto BuildCanvasSend
	/DownTransition Canvas syncheventmgrinterest
	AdjustButton /Middle BuildCanvasSend
	/DownTransition Canvas syncheventmgrinterest
    } def

    % make sure motion and up events are not lost
    %
    /EatUpEvent { % ev => -
    	[
	    exch /Name get {pop exit} null null excleventmgrinterest
	    /MouseDragged {pop} null null excleventmgrinterest
	] forkeventmgr pause pop
	unblockinputqueue
    } def


%%----------------------------------------------------------------------

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

    /DestroyMenu {
	/destroy JoinMenu	send
	/destroy CapMenu	send
	/destroy StyleMenu	send
	/destroy TypeMenu	send
	/destroy WidthMenu	send
	/destroy MiterMenu	send
	/destroy RadiusMenu	send
	/destroy DashMenu	send
    } def

classend def

/win
    [WideCanvas] [/Footer false] framebuffer /newdefault ClassBaseFrame send
def

{   gsave
    .5 fillcanvas
    1 setlinejoin
    10 setlinewidth
    .7 strokecanvas
    /Times-Roman findfont 50 scalefont setfont
    0 setgray
    8 16 moveto
    (W) show
    1 setgray
    6 18 moveto
    (W) show
    /Helvetica findfont 11 scalefont setfont
    0 setgray
    31 4 moveto
    (Wide Demo) cshow
    1 setgray
    30 5 moveto
    (Wide Demo) cshow
    grestore
} /seticon win send

(Wide Path Demo) /setlabel win send
null /seticonlabel win send

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

newprocessgroup
currentfile closefile
