#! /usr/NeWS/bin/psh
%
% 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 9.2 88/01/18
%
% A pretty calculator by David Lavallee & James Gosling
% Hacked over by Owen Densmore.
%

/instring (Calculator) def
/notestring () def
/all-damage {
    clippath pathbbox exch 3.7 div exch 3.8 div  scale pop pop

    /Times-Roman findfont .6 scalefont setfont
    calcpath fill
    forepath  gsave .5 setgray fill grestore
    resultpath
    
    gsave .4 .3 translate .05 dup scale .6 setgray Sunlogo grestore
    % 0 button
    gsave .8 .2 translate .55 setgray (0) buttonpath grestore
    % . button
    gsave 1.5 .2 translate .55 setgray (.) buttonpath grestore
    % 7 button
    gsave .1 .9 translate .55 setgray (7) buttonpath grestore
    % 8 button
    gsave .8 .9 translate .55 setgray (8) buttonpath grestore
    % 9 button
    gsave 1.5 .9 translate .55 setgray (9) buttonpath grestore
    % 4 button
    gsave .1 1.6 translate .55 setgray (4) buttonpath grestore
    % 5 button
    gsave .8 1.6 translate .55 setgray (5) buttonpath grestore
    % 6 button
    gsave 1.5 1.6 translate .55 setgray (6) buttonpath grestore
    % 1 button
    gsave .1 2.3 translate .55 setgray (1) buttonpath grestore
    % 2 button
    gsave .8 2.3 translate .55 setgray (2) buttonpath grestore
    % 3 button
    gsave 1.5 2.3 translate .55 setgray (3) buttonpath grestore
    % enter button
    gsave 2.2 0.2 translate .45 setgray (=) buttonpath grestore
    % sub button
    gsave 2.2 0.9 translate .45 setgray (-) buttonpath grestore
    % div button
    gsave 2.9 0.9 translate .45 setgray (/) buttonpath grestore
    % add button
    gsave 2.2 1.6 translate .45 setgray (+) buttonpath grestore
    % mul button
    gsave 2.9 1.6 translate .45 setgray (*) buttonpath grestore
    % inverse button
    gsave 2.2 2.3 translate .45 setgray (C) buttonpath grestore
    % percent button
    gsave 2.9 2.3 translate .45 setgray (%) buttonpath grestore
}def

/calcpath {
    newpath
    0 .2 moveto
    .1 .2 .1 180 270 arc
    .2 .1 .1 180 270 arc
    3.5  0 lineto
    3.6 .1 .1 270 0 arc
    3.7 3.6 lineto
    3.6 3.6 .1 0 90 arc
    3.5 3.7 .1 0 90 arc
    .1 3.7 .1 90 180 arc
    closepath
    pause
} def
/forepath {
    newpath
    .05 .2 moveto
    .1 .2 .05 180 270 arc
    3.5 .15 lineto
    3.5 .2 .05 270 0 arc
    3.55 3.7 lineto
    3.5 3.7 .05 0 90 arc
    .1 3.75 lineto
    .1 3.7 .05 90 180 arc
    closepath
    pause
} def
/resultpath {
    gsave
    .9 setgray
    newpath
    .1 3.2 moveto
    .2 3.2 .1 180 270 arc
    3.4 3.2 .1 270 0 arc
    3.4 3.6 .1 0 90 arc
    .2 3.6 .1 90 180 arc
    closepath fill
    grestore stroke
    instring stringwidth pop -1 mul 3.1 add 3.2 moveto instring show
    notestring show /notestring () store
    pause
} def
/buttonpath {
    dup
    newpath
    0 .05 moveto
    .05 .05 .05 180 270 arc
    .55 .05 .05 270 0 arc
    .55 .55 .05 0 90 arc
    .05 .55 .05 90 180 arc
    closepath fill
    1 setgray
    stringwidth pop 2 div -1 mul .3 add .1 moveto show
    pause
} def
/Sunlogo {
    gsave
    45 rotate
    /Uchar {
	newpath
	 -.1 0 moveto
	 0 0 .1 180 360 arc
	 0 2.9 rlineto
	 .8 0 rlineto
	 0 -2.9 rlineto
	 0 0 .9 0 180 arcn
	 0 2.9 rlineto
	 .8 0 rlineto
	closepath
	fill
    } def
    /2Uchar { Uchar gsave 4 4 translate Uchar grestore pause} def
    4 { 2Uchar 6 0 translate 90 rotate } repeat
    grestore
} def

/accum 0 def
/dot 0 def
/prev 0 def
/nop { exch pop } def
/op /nop load def

/digit { dot 0 eq { accum 10 mul } 
    { 10 dot exp mul accum /dot dot -1 add def } ifelse
    add /accum exch store dumpdisp
    /op load /pop load eq { /op /nop load store } if
} def

/clearreg { /accum 0 store /dot 0 store /op /nop load store /prev 0 store } def
/equal { /accum prev accum { op } stopped { pop pop 0 } if clearreg store
         /prev accum store } def
/doop { equal load /op exch store dumpdisp /prev accum store /accum 0 store } def

/dumpdisp {
    gsave
    can setcanvas
    clippath pathbbox exch 3.7 div exch 3.8 div  scale pop pop
    /Times-Roman findfont .6 scalefont setfont
    /instring accum (           ) cvs store
    resultpath
    grestore
} def

/pointproc {
    gsave
    can setcanvas
    clippath pathbbox exch 3.7 div exch 3.8 div scale pop pop
    .1 .2 translate .7 .7 scale
    CurrentEventX geteventlocation
    floor 5 mul add floor
    { 0 48 46 61 0  55 56 57 45 47  52 53 54
      43 42  49 50 51 99 0 0 0 0 0 0 0 0 0 0 0 } 
    exch get
    createevent begin
	/Name exch def
	/Canvas currentcanvas def
	/Action /DownTransition def
	currentdict
    end null exch sendevent  % null??
    grestore
} def

% Make window:
    /win framebuffer /new DefaultWindow send def	% Create a window
    {							% Install my stuff.
	/PaintClient { all-damage } def
%	/ShapeIconCanvas {IconCanvas setcanvas calcpath} def
	/PaintIcon { all-damage } def
	/FrameLabel (Calculator) def
    } win send
    /reshapefromuser win send				% Shape it.
    /can win /ClientCanvas get def			% Get my canvas.

% Create handlers for each key
    /handlers 100 dict def
    handlers begin
	0 1 9 {
	    dup 48 add exch [ exch /digit cvx ] cvx def
	} for
	% It sure would be nice if PostScript had character constants
	3 { currentprocess killprocessgroup } def
	99 { clearreg dumpdisp } def
	46 { /dot -1 store /notestring (.) store dumpdisp } def
	61 { equal dumpdisp /accum 0 store /op /pop load store } def
	43 { /notestring (+) store /add doop } def
	45 { /notestring (-) store /sub doop } def
	47 { /notestring (/) store /div doop } def
	42 { /notestring (*) store /mul doop } def
	/LeftMouseButton {pointproc} def
    end

% Activate window
    /map win send  % Map the window. (Damage causes PaintClient to be called)

{ 		% done as a separate process so the file reading
		% process can exit
    can setcanvas

% Start the input handler
    systemdict /Selections known {	% The new extended input system
        currentcanvas addkbdinterests pop
    } if
    createevent dup begin
        /Name 200 dict dup begin
	    0 1 127 { dup def } for
	    /LeftMouseButton dup def
	end def
	/Action /DownTransition def
	/Canvas currentcanvas def
    end expressinterest

systemdict /IP currentprocess put

% Input handling loop
    {   clear
	/CurrentEventX awaitevent def
	CurrentEventX /Name get dup
	handlers exch known {
	    handlers exch get exec
	} if
    } loop
} fork clear
