%
% 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
%
%
%	@(#)calcul 23.2 90/06/19
%
% A pretty calculator by David Lavallee & James Gosling
% Hacked over by Owen Densmore.
%

/CalcFrame /defaultclass OpenLookFrame send []
classbegin
    /Label false def
    /Footer false def
    /Close false def

    /BaseFrameClass { CalcBaseFrame } def
    /IconFrameClass { CalcIconFrame } def


    /MaxRadius { SubClassResponsibility } def
    /MaximumShadow { SubClassResponsibility } def

    /BorderWidths { BorderLeft BorderRight add } def
    /BorderHeights { BorderBottom BorderTop add } def


    /reshape {
	2 copy 2 array astore cvx /size exch def
	/reshape super send
    } def

    /path { % x y w h => -
	10 dict begin
	    matrix currentmatrix 5 1 roll
	    4 2 roll translate
	    2 copy .1 mul exch .1 mul max MaxRadius min
	    /radius exch def
	    2 copy .02 mul exch .02 mul max 1 max MaximumShadow min
	    /shadow exch def

	    shadow sub exch shadow sub exch
	    2 copy
	    radius 0 shadow  5 -2 roll
	    rrectpath
	    radius shadow 0  5 -2 roll rrectpath
	    setmatrix
	end
    } def

    /validate {
	/Shadow
	    /size self send
	    .02 mul exch .02 mul max 1 max MaximumShadow min
	def
	/Radius
	    /size self send
	    .1 mul exch .1 mul max MaxRadius min
	def
	/validate super send
    } def

    /BorderLeft 0 def
    /BorderTop 0 def
    /BorderBottom {
	Shadow
    } def
    /BorderRight {
	Shadow
    } def

    /PaintCanvas {
	  Selected? /reflectselected self send
    } def

    % Override
    %
    /ReshapeCreate { % - => -
	/Reshape
	[{/ReshapeNotify /parent self send send} RFrameCorners]
	/addclient self send
    } def

    /ReshapeLayout { % - => -
	/Reshape /getbyname super send {
	    /totop 1 index send
	    BorderLeft BorderBottom 1 sub
	    Width BorderWidths sub 1 add
	    Height BorderHeights sub 1 add
	    /reshape 6 -1 roll send
	} if
    } def



    /reflectselected { % bool => -
	/?validate self send
	gsave
	    Canvas setcanvas
	    { 0 }{ .40 } ifelse
	    setshade

	    matrix currentmatrix
		/size self send translate
		-1 -1 scale
		0 0 /size self send rectpath
	    setmatrix

	    Radius 0 Shadow
		   /size self send
		   BorderHeights sub exch
		   BorderWidths sub exch
	    rrectpath
	    eofill
	grestore
    } def

    /reflectfocus { % bool => -
	pop
    } def
    /reflectbusy { % bool => -
	pop
    } def
classend def

/CalcBaseFrame [CalcFrame /defaultclass ClassBaseFrame send] []
classbegin
    /Label false def
    /Footer false def
    /Close false def
    /Reshape true def

    /MaxRadius 8 def
    /MaximumShadow 5 def

    /open { % bool => -
	% only flip the parent of the client if the open state
	% is really changing.
	dup /opened? self send ne {
	    dup dup {
		null /setclient /Icon /sendsubframe self send
		dup /setclient self send pop
		/validate self send
	    } {
		null /setclient self send
		dup /setclient /Icon /sendsubframe self send pop
		/validate /Icon /sendsubframe self send
	    } ifelse			% open? open? client
	    /open exch send
	} if				% open?
	/open super send
    } def

    /validate { % - => -
	/validate super send
	/client self send dup null eq {pop} {
	    /validate exch send
	} ifelse
    } def

classend def

/CalcIconFrame [CalcFrame /defaultclass ClassIconFrame send] []
classbegin
    /Reshape false def

    /MaxRadius 5 def
    /MaximumShadow 4 def
classend def

/RFrameCorners OpenLookFrameCorners []
classbegin
    /Radius {/Radius /parent self send send } def
    /FillColor .4 dup dup rgbcolor def

    /Corners { % x y w h delta inset => -
	20 dict begin
	    /Inset exch def
	    /d exch def
	    /h exch def
	    /w exch def /y exch def /x exch def
	    /X x w 1 sub add def /Y y h add def

	    /r Radius Inset sub def
	    /r- Radius d sub Inset add def

	    % upper left
	    x r add Y moveto
	    x r add Y r sub r 90 180 arc
	    x r add Y r sub r- 180 90 arcn
	    closepath

	    % upper right
	    X Y r sub moveto
	    X r sub Y r sub r 0 90 arc
	    X r sub Y r sub r- 90 0 arcn
	    closepath

	    % lower left
	    x 1 add y 1 add r add 1 add moveto
	    x r add y 1 add r add r 180 270 arc
	    x r add y 1 add r add r- 270 180 arcn
	    closepath

	    % lower right
	    X r sub y 1 add moveto
	    X r sub y 1 add r add r -90 0 arc
	    X r sub y 1 add r add r- 0 -90 arcn
	    closepath
	end
    } def

    /PaintCanvas {
	StrokeColor BorderStroke FillColor /StrokeAndFillCanvas self send
    } def

    /StrokeCanvas { % color inset => -; paint the edge with the color
	exch setshade
	newpath
	/bbox self send /path self send
	/bbox self send /insetpath self send
	eofill
    } def

    /path { % x y w h => -
	Delta 2 add 0 Corners
    } def

    /insetpath { % inset x y w h => -
	4 index 6 1 roll        % save the inset on the stack
	insetrect
	Delta 2 add
	6 -1 roll Corners
    } def

classend def

/CalcButtonGraphic [ClassGraphic] []
classbegin

    /newinit { % (string) => -
	/newinit super send
	/Thing exch def
	/State [/Normal] def
    } def

    /setcolors { % fill text => -
    	/FillColor exch promote
	/TextColor exch promote
    } def

    /paint { % - => -
    	TextColor FillColor
	State 0 get /Normal eq { exch } if
	fillcanvas
	setcolor
	TextFont setfont
	Width 2 div Height currentfont fontascent sub 2 div moveto
	Thing cshow
    } def

    /Fix { % bool => -
    	pop
	/paint self send
    } def

classend def

/CalcButton [ClassButton] dictbegin

    /GraphicX			0	def
    /GraphicY			0	def
    /GraphicWidth		0	def
    /GraphicHeight		0	def
    /GraphicRadius		1	def
    /SavedTrackInterests	null	def

dictend classbegin

    /CreateGraphic { % string => graphic
	/new CalcButtonGraphic send
    } def

    /setcolors { % fill text => -
    	/setcolors Graphic send
    } def

    /setshape { % x y w h r => -
    	/GraphicRadius exch def
	.1 5 1 roll insetrect
    	/GraphicHeight exch def
    	/GraphicWidth exch def
    	/GraphicY exch def
    	/GraphicX exch def
    } def

    /trackon { % - => -
    	/SavedTrackInterests /trackinterests self send def
	Canvas SavedTrackInterests /addcanvasclients EventMgr send
    } def

    /trackoff { % - => -
	SavedTrackInterests null ne {
	    Canvas SavedTrackInterests /removecanvasclients EventMgr send
	    /SavedTrackInterests null def
	} if
    } def

    /destroy { % - => -
	/trackoff self send
	/destroy super send
    } def

    /callnotify {
	NotifyUser
    } def

    /path { % r x y w h => -
    	rrectpath
    } def

    /shape { % - => r x y w h
    	GraphicRadius GraphicX GraphicY GraphicWidth GraphicHeight
	/reshape self send
    } def

classend def

/CalcDisplay ClassCanvas dictbegin

    /Display		null	def
    /CanvasShape	null	def

dictend classbegin

    /TextSize	.7	def

    /newinit { % => -
	/newinit super send
	/TextColor exch promote
	/FillColor exch promote
	/CanvasShape exch def
	/Display exch def
    } def

    /PaintCanvas {
	FillColor fillcanvas
	TextColor setcolor
	TextFont setfont
	Display stringwidth pop 1			% strw nstrsize
	{						% sw nss
	    2 copy mul 4.8 exch sub			% sw nss nsx
	    dup .1 gt { exit } if			% sw nss nsx
	    1 index .1 lt { exit } if			% sw nss nsx
	    pop .8 mul					% sw nss'
	} loop						% sw strscale strx
	Height currentfont fontascent sub moveto	% sw strscale
	1 scale						% sw
	pop						% -
	Display show
    } def

    /setdisplay { % (string) => -
    	/Display exch def
	/paint self send
    } def

    /shape { % - => -
    	CanvasShape aload pop
	/reshape self send
    } def

    /path { % - => -
	.1 5 1 roll insetrect
	rrectpath
    } def

classend def

/CalcClient ClassBag dictbegin

    /PendingDelete?	false	def

dictend classbegin

    /Radius {/Radius /parent self send send } def
    /TextSize		.5			def

    monochromecanvas {
    	/DigitFillColor		1   1   1	rgbcolor	def
	/DigitTextColor		0   0   0	rgbcolor	def
	/FuncFillColor		0   0   0	rgbcolor	def
	/FuncTextColor		1   1   1	rgbcolor	def
	/DisplayFillColor	1   1   1	rgbcolor	def
	/DisplayTextColor	0   0   0	rgbcolor	def
	/FillColor		.7  .7  .7	rgbcolor	def
	/SunLogoColor		0   0   0	rgbcolor	def
    } {
	/DigitFillColor		.55 .55 .55	rgbcolor	def
	/DigitTextColor		1   0   0	rgbcolor	def
	/FuncFillColor		.45 .45 .45	rgbcolor	def
	/FuncTextColor		1   0   0	rgbcolor	def
	/DisplayFillColor	.9  .9  .9	rgbcolor	def
	/DisplayTextColor	0   0   1	rgbcolor	def
	/FillColor		.65 .65 .65	rgbcolor	def
	/SunLogoColor		0   0   .75	rgbcolor	def
    } ifelse

    /path { % x y w h => -
    	4 2 roll translate
	Radius 0 0 4 index 4 index rrectpath
	5 div exch 5 div exch scale
    } def

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

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

    /newinit { % - => -
    	/newinit super send

	% make the digit buttons
	null 1 0 (0) /MakeDigitButton self send
	null 2 0 (.) /MakeDigitButton self send
	null 0 1 (1) /MakeDigitButton self send
	null 1 1 (2) /MakeDigitButton self send
	null 2 1 (3) /MakeDigitButton self send
	null 0 2 (4) /MakeDigitButton self send
	null 1 2 (5) /MakeDigitButton self send
	null 2 2 (6) /MakeDigitButton self send
	null 0 3 (7) /MakeDigitButton self send
	null 1 3 (8) /MakeDigitButton self send
	null 2 3 (9) /MakeDigitButton self send

	% make the Enter button
	null
	    (Enter) {/Enter /parent self send send}
	    Canvas soften /new CalcButton send
	    3 0 2 1 .05 /setshape 6 index send
	    FuncFillColor FuncTextColor /setcolors 3 index send
	/addclient self send

	% make the numeric function buttons
	null 3 1 (+) /add /MakeFuncButton self send
	null 4 1 (-) /sub /MakeFuncButton self send
	null 3 2 (*) /mul /MakeFuncButton self send
	null 4 2 (/) /div /MakeFuncButton self send
	null 3 3 (C) /clear /MakeFuncButton self send

	% make the BackSpace keys
	null
	    (<) {/Bsp /parent self send send}
	    Canvas soften /new CalcButton send
	    4 3 1 1 .05 /setshape 6 index send
	    FuncFillColor FuncTextColor /setcolors 3 index send
	/addclient self send
	/Display
	    [(0) [.1 0 4 5 1] DisplayFillColor DisplayTextColor CalcDisplay]
	/addclient self send
    } def

    /open { % bool => -
	not {
	    /deactivate self send
	} if
	/paint /Display /sendclient self send
    } def

    /MakeDigitButton { % x y (digit) => graphic
	{/thing Graphic send /AddDigit /parent self send send}
	Canvas soften /new CalcButton send			% x y graphic
	3 1 roll 1 1 .05 /setshape 6 index send			% graphic
	DigitFillColor DigitTextColor /setcolors 3 index send
	/addclient self send
    } def

    /MakeFuncButton { % x y (func) operator => graphic
    	{/Doop /parent self send send} aload length 1 add packedarray cvx
	Canvas soften /new CalcButton send			% x y graphic
	3 1 roll 1 1 .05 /setshape 6 index send			% graphic
	FuncFillColor FuncTextColor /setcolors 3 index send
	/addclient self send
    } def

    /Layout { % - => -
	BagBegin
	Contents {
	    /shape exch send
	} forall
	BagEnd
    } def

    /PaintCanvas {
	FillColor fillcanvas
	.5 .2 .075 SunLogoColor setcolor Sunlogo
    } def

    /CheckStack { % ? => 0 0
	count 0 eq {
	    0
	} if
	count 1 eq {
	    0 exch
	} if
    } def

    /UpdateDisplay { % num|str => num|str
	/CheckStack self send
	dup dup type /stringtype ne {
	    100 string cvs
	} if
	/setdisplay /Display /sendclient self send
    } def

    /AddDigit { % digit => -
	/CheckStack self send
	PendingDelete? { exch pop } if
	/PendingDelete? false def
	1 index type /stringtype eq {
	    1 index exch append
	    dup (.) search {			% (fractional) (.) (whole)
		exch pop			% (fractional) (whole)
		exch (.) search {		% (whole) (post) (.) (pre)
		    pop pop true		% (whole) (post) true
		} {
		    false			% (whole) (fractional) false
		} ifelse			% (whole) (fractional) bad?
		exch length 10 gt or		% (whole) bad?
	    } {
		false
	    } ifelse				% (whole) bad?
	    exch length 38 gt or		% bad?
	    {
		beep
	    } {
		exch
	    } ifelse
	    pop
	} if
	/UpdateDisplay self send
    } def

    /Dot { % - => -
	(.) /AddDigit self send
    } def

    /Bsp { % num|str => -|str'
	/CheckStack self send
	/PendingDelete? false def
	dup type /stringtype eq {
	    dup length 1 gt {
		0 1 index length 1 sub getinterval
	    } {
		/PendingDelete? true def
		pop (0)
	    } ifelse
	} {
	    pop
	} ifelse
	/UpdateDisplay self send
    } def

    /Enter { % num|str => num num
	/CheckStack self send
	cvx exec
	dup
	/PendingDelete? true def
	/UpdateDisplay self send
    } def

    /Doop { % num num|str /op => num
	/CheckStack self send
	count 2 eq {
	    0 3 1 roll
	} if
	exch cvx exec exch
	{ cvx exec } stopped {
	    pop pop $error /errorname get
	} if
	/PendingDelete? false def
	/UpdateDisplay self send
	dup type /nametype eq {
	    pop
	    count 1 eq {
		0 exch
	    } if
	} if
    } def

    /ShiftDict		nulldict	def

    /DigitMap [ dictbegin
	{
	    (0) 0 get 1 (9) 0 get {
		1 string dup 0 4 -1 roll put dup toChar keyforsymbol exch
	    } for
	    /NumPad0 keyforsymbol (0)
	    /NumPad1 keyforsymbol (1)
	    /NumPad2 keyforsymbol (2)
	    /NumPad3 keyforsymbol (3)
	    /NumPad4 keyforsymbol (4)
	    /NumPad5 keyforsymbol (5)
	    /NumPad6 keyforsymbol (6)
	    /NumPad7 keyforsymbol (7)
	    /NumPad8 keyforsymbol (8)
	    /NumPad9 keyforsymbol (9)
	    (.) toChar keyforsymbol (.)
	    /NumPadDot keyforsymbol (.)
	} ClassKeyboard send
	counttomark 2 idiv {
	    1 index null ne {def} {pop pop} ifelse
	} repeat
	dictend
    ] def

    /FuncMap [ dictbegin
	{
	    (+) toChar keyforsymbol /add
	    /NumPadPlus keyforsymbol /add
	    (-) toChar keyforsymbol /sub
	    /NumPadMinus keyforsymbol /sub
	    (x) toChar keyforsymbol /mul
	    /NumPadStar keyforsymbol /mul
	    (/) toChar keyforsymbol /div
	    /NumPadSlash keyforsymbol /div
	    (C) toChar keyforsymbol /clear
	    /NumPadEqual keyforsymbol /clear
	} ClassKeyboard send
	counttomark 2 idiv {
	    1 index null ne {def} {pop pop} ifelse
	} repeat
	dictend
    ] def

    /MiscMap [ dictbegin
	{
	    /BSkey keyforsymbol /Bsp
	    /DELkey keyforsymbol /Bsp
	    (E) toChar keyforsymbol /Enter
	    /CRkey keyforsymbol /Enter
	    /NumPadEnter keyforsymbol /Enter
	} ClassKeyboard send
	counttomark 2 idiv {
	    1 index null ne {def} {pop pop} ifelse
	} repeat
	dictend
    ] def

    /MakeInterests { % - => events
	/MakeInterests super send

	Canvas soften /new ClassFocusSelfInterest send
	dup /addsuite
	    {/Name get /Doop} self soften buildsend
		null FuncMap ShiftDict
		/new ClassKeysInterest send
	send
	dup /addsuite
	    {/Name get /AddDigit} self soften buildsend
		null DigitMap ShiftDict
		/new ClassKeysInterest send
	send
	dup /addsuite
	    {/Name get} self soften buildsend
		null MiscMap ShiftDict
		/new ClassKeysInterest send
	send

	Canvas soften null 1 dict dup begin
	    PointButton {redistributeevent} def
	end /new ClassInterest send
    } def

classend def
    
/win [CalcClient] nullarray framebuffer /new CalcBaseFrame send def
/place win send
/activate win send
/map win send

newprocessgroup
currentfile closefile
