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


/RoundFrame ClassFrame []
classbegin

    /FillColor 1 1 1 rgbcolor def
    /SelFillColor .33 dup dup rgbcolor def
    /UnSelFillColor .75 dup dup rgbcolor def

    /path { % x y w h => -
	matrix currentmatrix 5 1 roll
	    4 2 roll translate scale
	    1 .5 moveto
	    .5 .5 .5 0 360 arc
	setmatrix
    } def

    /Label        false        def
    /Pin          false        def
    /Footer       false        def
    /Close        false        def

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

    /IconFrameClass {RoundIconFrame} def
    /BaseFrameClass {RoundBaseFrame} def
classend def

/RoundBaseFrame [RoundFrame /defaultclass ClassBaseFrame send] []
classbegin
    /StrokeCanvas { % color inset => -
	pop pop
    } 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
	    } {
		null /setclient self send
		dup /setclient /Icon /sendsubframe self send pop
	    } ifelse		    % open? open? client
	    /open exch send
	} if
	/open super send
	/validate self send
    } def

classend def

/RoundIconFrame [RoundFrame /defaultclass ClassIconFrame send] []
classbegin
    /StrokeCanvas { % color inset => -
	pop pop
	gsave
	    Selected? {
		SelFillColor
	    }{
		UnSelFillColor
	    } ifelse setcolor
	    /size self send scale
	    .5 .5 .6 0 360 arc
	    .5 .5 .45 360 0 arcn
	    closepath
	    fill
	grestore
    } def
classend def

/RoundCorners [OpenLookFrameCorners] []
classbegin

    /SelFillColor .33 dup dup rgbcolor def
    /UnSelFillColor .75 dup dup rgbcolor def

    /FillColor {
	/Selected? /parent self send send {
	    SelFillColor
	} {
	    UnSelFillColor
	} ifelse
    } def

    /path { % x y w h => -
	matrix currentmatrix 5 1 roll   % matrix x y w h
	    4 2 roll                    % matrix w h x y
	    translate                   % w h
	    scale                       % matrix
	    1.1 .5 moveto
	    .5 .5 .6 0 360 arc
	    .5 .5 .4 360 0 arcn
	    closepath
	setmatrix                       % -
    } def

    /PaintCanvas { % - => -
	FillColor fillcanvas
    } def

classend def



/ClockCanvas ClassCanvas
dictbegin
    /TickEvent null def
    /Hour 0 def
    /Min 0 def
    /Sec 0 def
    /LastHour 0 def
    /LastMin 0 def
    /LastSec 0 def
    /SecondHand? false def
dictend
classbegin

    /FillColor 1 1 1 rgbcolor def
    /MinuteTime 1000 minim mul 60 mul def       % ~ 1 minute
    /SecondTime 1000 minim mul def              % ~ 1 second
    /FontFamily /AvantGarde-Demi def

    monochromecanvas {
	/HourColor   .333 dup dup rgbcolor def
	/MinuteColor .666 dup dup rgbcolor def
	/SecondColor 0 dup dup rgbcolor def
	/DotColor .5 dup dup rgbcolor def
    } {
	/HourColor   .4 .4 1 hsbcolor def       % green
	/MinuteColor .8 .4 1 hsbcolor def       % pink
	/SecondColor .6 .4 1 hsbcolor def       % skyblue
	/DotColor .05 .4 1 hsbcolor def         % orange
    } ifelse

    /path {
	2 copy .1 mul exch .1 mul exch translate
	.8 mul exch .8 mul exch
	/path parent send
    } def

    /Hand { % length width degrees => -
	matrix currentmatrix 4 1 roll
	    0 0 moveto
	    neg 90 add rotate           % length width
	    dup 0 exch moveto exch      % width length
	    0 lineto                    % width
	    0 exch neg lineto           % -
	    closepath
	setmatrix
    } def

    /PaintBackground {
	gsave
	    FillColor fillcanvas

	    FontFamily findfont .1 scalefont setfont
	    (NeWSwatch) dup stringwidth pop 2 div neg -.3 moveto
	    TextColor setcolor
	    show

	    % dot at 12:00
	    0 .4 .1 0 360 arc
	    DotColor setcolor fill
	grestore
    } def

    /LastHourPath {
	.33 .1 LastHour 12 mod LastMin 60 div add 360 mul 12 div Hand
    } def

    /LastMinPath {
	.50 .075 LastMin 60 mod
	SecondHand? { LastSec 60 div add } if 360 mul 60 div Hand
    } def

    /LastSecPath {
	.50 .025 LastSec 60 mod 360 mul 60 div Hand
    } def


    /HourPath {
	.33 .1 Hour 12 mod Min 60 div add 360 mul 12 div Hand
    } def

    /MinPath {
	.50 .075 Min 60 mod
	SecondHand? { Sec 60 div add } if 360 mul 60 div Hand
    } def

    /SecPath {
	.50 .025 Sec 60 mod 360 mul 60 div Hand
    } def


    /PaintHands {

% erase old Hour slice
	0 0 .5 0 360 arc
	HourPath
	eoclip
	newpath
	LastHourPath
	clipcanvas
	/PaintBackground self send
	newpath clipcanvas
	initclip

% erase old Minute slice
	0 0 .5 0 360 arc
	MinPath
	eoclip
	newpath
	LastMinPath
	clipcanvas
	/PaintBackground self send
	newpath clipcanvas
	initclip

	SecondHand? {
	    0 0 .5 0 360 arc
	    SecPath
	    eoclip
	    newpath
	    LastSecPath
	    clipcanvas
	    /PaintBackground self send
	    newpath clipcanvas
	    initclip
	} if

% Don't paint Hour Hand where the minute hand will be.
	0 0 .5 0 360 arc
	MinPath
	eoclip
	newpath
	HourPath
	HourColor setcolor fill
	initclip

	MinPath
	MinuteColor setcolor fill

	SecondHand? {
	    SecPath
	    SecondColor setcolor fill
	} if
    } def

    /PaintCanvas {
	gsave
	    /size self send scale
	    .5 .5 translate
	    /PaintBackground self send
	    /PaintHands self send
	grestore
    } def

    /PaintUpdate {
	gsave
	    /canvas self send setcanvas
	    /size self send scale
	    .5 .5 translate
	    /PaintHands self send
	grestore
    } def

    /UpdateTime { % ev => -
	pop
	/LastHour Hour def
	/LastMin Min def
	SecondHand? {
	    /LastSec Sec def
	    /Sec Sec 1 add def
	    Sec 60 eq {
		/Sec 0 def
		/Min Min 1 add def
		Min 60 eq {
		    /Min 0 def
		    /Hour Hour 1 add def
		} if
	    } if
	} {
	    /Min Min 1 add def
	    Min 60 eq {
		/Min 0 def
		/Hour Hour 1 add def
	    } if
	} ifelse
	/PaintUpdate self send
	TickEvent dup begin
	    /TimeStamp
		SecondHand? {
		    SecondTime
		} {
		    MinuteTime
		} ifelse
	    TimeStamp add def
	end sendevent
    } def

    /SetTime {
	(date '+/Hour %H def /Min %M def /Sec %S def') pipe pop
	100 string readline pop cvx exec
	TickEvent dup begin
	    /TimeStamp
		SecondHand? {
		    SecondTime
		} {
		    60 Sec sub 60 div MinuteTime mul
		} ifelse
	    currenttime add def
	end sendevent
    } def

    /MenuToggleSeconds { % ev => -
	pop
	TickEvent recallevent
	/SecondHand? SecondHand? not def
	/SetTime self send
	/paint self send
    } def

    /MenuSynchTime { % ev => -
	pop
	TickEvent recallevent
	/SetTime self send
	/paint self send
    } def

    /newinit {
	/newinit super send
	/TickEvent createevent dup begin
	    /Name /Tick def
	    /Canvas /canvas self send soften def
	end def
	/CreateMenu self send
	/SetTime self send
    } def

    /open { % bool => -
    	{
	    CreateMenu self send
	} {
	    null /setmenu self send
	} ifelse
	gsave
	    /parent self send setcanvas
	    clippath extenddamage
	grestore
    } def

    /CreateMenu { % - => -
	[
	    (Toggle Second Hand) null /MenuToggleSeconds self soften buildsend
	    (Synchronize Time) null /MenuSynchTime self soften buildsend
	] framebuffer /newdefault ClassMenu send
	false /setpinnable 2 index send
	(NeWSwatch) /setlabel 2 index send
	/setmenu self send
    } def

    /MakeInterests {
	/MakeInterests super send

	/canvas self send soften
	null
	1 dict dup begin
	    /Tick /UpdateTime self soften buildsend def
	end /new ClassInterest send
    } def

    /destroy { % - => -
	/destroy super send
	TickEvent dup null ne { recallevent } { pop } ifelse
	/TickEvent null def
    } 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

classend def

/clock [ClockCanvas] []
framebuffer /newdefault RoundBaseFrame send def

/place clock send
/activate clock send
/map clock send

newprocessgroup
currentfile closefile
