; $Id: wcalc.pro,v 1.1 1993/04/02 19:54:08 idl Exp $

; Copyright (c) 1991-1993, Research Systems, Inc.  All rights reserved.
;	Unauthorized reproduction prohibited.
;+
; NAME:
;	WCALC
;
; PURPOSE:
;	This routine emulates a scientific calculator.
;
; CATEGORY:
;	Widgets, math.
;
; CALLING SEQUENCE:
;	WCALC
;
; INPUTS:
;	None.
;
; KEYWORD PARAMETERS:
;	GROUP:	The widget ID of the widget that calls WCALC.  When this
;		ID is specified, a death of the caller results in a death of
;		WCALC.
;
;	FONT:	A string containing the name of the X-Windows font to be
;		used for the calculator buttons and display.  If no font is
;		specified, the first available 20-point font is used.
;		On many systems, you can see the names of available fonts
;		by entering the command "xlsfonts" from the Unix command line.
;
; OUTPUTS:
;	None.
;
; OPTIONAL OUTPUT PARAMETERS:
;	None.
;
; COMMON BLOCKS:
;	WCALCBLOCK, WTRANSBLOCK
;
; SIDE EFFECTS:
;	Initiates the XManager if it is not already running.
;
; RESTRICTIONS:
;	Math error trapping varies depending upon system.
;
; PROCEDURE:
;	Create and register the widget, allow computations, and then exit.
;
; MODIFICATION HISTORY:
;	WIDGET CALCULATOR by Keith R Crosley, RSI, October 1991
;	Created from a template written by: Steve Richards, January, 1991
;-

;------------------------------------------------------------------------------
;       procedure update
;------------------------------------------------------------------------------
PRO update, number

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop

stuff=stuff+number

WIDGET_CONTROL, display, SET_VALUE=' '
curr = FLOAT(stuff)
WIDGET_CONTROL, display, SET_VALUE=stuff

;print, ''
;print, 'AFTER UPDATE:'
;print, 'CURRENT =',curr
;print, 'PRVIOUS =',prev

END


;------------------------------------------------------------------------------
;       procedure set
;
;
;------------------------------------------------------------------------------
PRO set, NOPREV=noprev

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop

IF KEYWORD_SET(noprev) EQ 0 THEN prev = curr

stuff = ''

;print, ''
;print, 'AFTER SET:'
;print, 'CURRENT = ', curr
;print, 'PRVIOUS = ', prev

set = 1

END

;------------------------------------------------------------------------------
;       procedure show
;------------------------------------------------------------------------------
PRO show, string

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop

WIDGET_CONTROL, display, SET_VALUE=string

END


;------------------------------------------------------------------------------
;       procedure equals
;------------------------------------------------------------------------------
PRO equals, NOSET=noset

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop

        CASE lastop OF

	   '^':BEGIN
                curr = prev^curr
                prev = curr
                IF KEYWORD_SET(noset) EQ 0 THEN SET
                SHOW, STRING(prev)
                lastop='NOOP'
                END

           '*':BEGIN
                curr = curr*prev
                prev = curr
                IF KEYWORD_SET(noset) EQ 0 THEN SET
                SHOW, STRING(prev)
                lastop='NOOP'
                END

           '/':BEGIN
                curr = prev/curr
                prev = curr
                IF KEYWORD_SET(noset) EQ 0 THEN SET
                SHOW, STRING(prev)
                lastop='NOOP'
                END
           '-':BEGIN
                curr = prev-curr
                prev = curr
                IF KEYWORD_SET(noset) EQ 0 THEN SET
                SHOW, STRING(prev)
                lastop='NOOP'
                END
           '+':BEGIN
                curr = curr+prev
                prev = curr
                IF KEYWORD_SET(noset) EQ 0 THEN SET
                SHOW, STRING(prev)
                lastop='NOOP'
                END
        'NOOP': BEGIN
		SET
                END
        ENDCASE
END



;------------------------------------------------------------------------------
;	procedure wcalc_ev
;------------------------------------------------------------------------------
; This procedure processes the events being sent by the XManager.
;*** This is the event handling routine for the wcalc widget.  It is 
;*** responsible for dealing with the widget events such as mouse clicks on
;*** buttons in the wcalc widget.  The tool menu choice routines are 
;*** already installed.  This routine is required for the wcalc widget to
;*** work properly with the XManager.
;------------------------------------------------------------------------------
PRO wcalc_ev, event

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop
COMMON wtransblock, conv1, conv2

WIDGET_CONTROL, event.id, GET_UVALUE = eventval		;find the user value
							;of the widget where
							;the event occured
CASE eventval OF

;*** here is where you would add the actions for your events.  Each widget
;*** you add should have a unique string for its user value.  Here you add
;*** a case for each of your widgets that return events and take the
;*** appropriate action.

  '1':	BEGIN
	  UPDATE, '1'
	END

  '2':  BEGIN
         UPDATE, '2'
        END

  '3':  BEGIN
         UPDATE, '3'
        END

  '4':  BEGIN
         UPDATE, '4'
        END

  '5':  BEGIN
         UPDATE, '5'
        END

  '6':  BEGIN
         UPDATE, '6'
        END

  '7':  BEGIN
         UPDATE, '7'
        END

  '8':  BEGIN
         UPDATE, '8'
        END

  '9':  BEGIN
         UPDATE, '9'
        END

  '0':	BEGIN
         UPDATE, '0'
	END

  '.':	BEGIN
         UPDATE, '.'
	END

  '=':  EQUALS

  '^':  BEGIN
        CASE lastop OF
        'NOOP': BEGIN
                lastop = '^'
                SET
                END
        '^':    BEGIN
                lastop='^'
                curr = prev^curr
                prev = curr
                SET
                SHOW, STRING(prev)
                END
        ELSE:   BEGIN
                EQUALS, /NOSET
                lastop = '^'
                SET
                END
        ENDCASE
        END


  '*':  BEGIN
	CASE lastop OF
        'NOOP': BEGIN
                lastop = '*'
                SET
        	END
	'*':	BEGIN
		lastop='*'
		curr = curr*prev
		prev = curr
		SET
		SHOW, STRING(prev)
		END
	ELSE:	BEGIN
		EQUALS, /NOSET
		lastop = '*'
		SET
		END
	ENDCASE
        END


  '/':  BEGIN
	CASE lastop OF
	'NOOP':	BEGIN
                lastop = '/'
                SET
		END
	'/':	BEGIN
                lastop='/'
                curr = prev/curr
                prev = curr
                SET
                SHOW, STRING(prev)
		END
	ELSE:	BEGIN
		EQUALS, /NOSET
		lastop = '/'
		SET
		END
        ENDCASE
        END

  '-':	BEGIN
	CASE lastop OF
	'NOOP':	BEGIN
		lastop = '-' 
		SET
		END
	'-':	BEGIN
		lastop='-'
		curr = prev-curr
		prev = curr
		SET
		SHOW, STRING(prev)
		END
	ELSE:	BEGIN
		EQUALS, /NOSET
		lastop = '-'
		SET
		END
	ENDCASE
	END

  '+':	BEGIN
	CASE lastop OF
	'NOOP':	BEGIN
		lastop = '+'
		SET
		END
	'+':	BEGIN
		lastop='+'
		curr = curr+prev
		prev = curr
		SET
		SHOW, STRING(prev)
		END
	ELSE:	BEGIN
		EQUALS, /NOSET
		lastop = '+'
		SET
		END
	ENDCASE
	END

  'C':	BEGIN
	curr=0
	prev=0
	stuff=''
	lastop = 'NOOP'
	SET
	SHOW, STRING(curr)
	END

'CE':  	BEGIN
        curr = 0
	stuff=''
        SHOW, STRING(curr)
        END


'+/-': 	BEGIN
        curr = -(curr)
        SHOW, STRING(curr)
        END

'M':	BEGIN
	mem = curr
	SHOW, STRING(curr)
	SET, /NOPREV
	END

'M+':	BEGIN
	mem = mem+curr
	SHOW, STRING(curr)
	SET, /NOPREV
	END

'MR':	BEGIN
	curr = mem
	SHOW, STRING(curr)
	SET, /NOPREV
	END

'MC':	BEGIN
	mem = 0
	END

'DEGREES': BEGIN
	    conv1=!dtor
	    conv2=!radeg
	   END

'RADIANS': BEGIN
	    conv1 = 1
	    conv2 = 1
	   END

'SQRT':	BEGIN
	curr = SQRT(curr)
	SHOW, STRING(curr)
	SET, /NOPREV	
	END

'X^2': 	BEGIN
        curr = curr^2
        SHOW, STRING(curr)
	SET, /NOPREV
        END

'X^3':  BEGIN
        curr = curr^3
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'1/X':  BEGIN
        curr = 1/curr
        SHOW, STRING(curr)
        SET, /NOPREV
        END



'ALOG':	BEGIN
	curr = ALOG(curr)
	SHOW, STRING(curr)
        SET, /NOPREV
	END

'ALOG10':BEGIN
	curr = ALOG10(curr)
	SHOW, STRING(curr)
        SET, /NOPREV
	END

'EXP':	BEGIN
	curr = EXP(curr)
	SHOW, STRING(curr)
        SET, /NOPREV
	END

'SIN':	BEGIN
	curr = SIN(curr*conv1)
	SHOW, STRING(curr)
        SET, /NOPREV
	END

'COS':  BEGIN
        curr = COS(curr*conv1)
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'TAN':  BEGIN
        curr = TAN(curr*conv1)
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'PI':	BEGIN
	curr = !pi
	SHOW, STRING(curr)
	SET, /NOPREV
	END

'ASIN':  BEGIN
        curr = ASIN(curr)*conv2
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'ACOS':  BEGIN
        curr = ACOS(curr)*conv2
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'ATAN':  BEGIN
        curr = ATAN(curr)*conv2
        SHOW, STRING(curr)
        SET, /NOPREV
        END


'SINH': BEGIN
        curr = SINH(curr*conv1)
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'COSH': BEGIN
        curr = COSH(curr*conv1)
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'TANH': BEGIN
        curr = TANH(curr*conv1)
        SHOW, STRING(curr)
        SET, /NOPREV
        END

'!':	BEGIN
	IF curr LT 0 THEN RETURN
	IF curr EQ 0 THEN curr=1 ELSE BEGIN
		curr = FIX(curr)
		temp = 1.
		FOR i=1,curr DO temp=temp*i
		curr = FLOAT(temp)
	ENDELSE
	SHOW, STRING(curr)
        SET, /NOPREV
	END


  "XLOADCT": XLoadct, GROUP = event.top			;XLoadct is the library
							;routine that lets you
							;select and adjust the
							;color palette being
							;used.

  "XPALETTE": XPalette, GROUP = event.top		;XPalette is the
							;library routine that
							;lets you adjust 
							;individual color
							;values in the palette.

  "XMANTOOL": XMTool, GROUP = event.top			;XManTool is a library
							;routine that shows 
							;which widget
							;applications are 
							;currently registered
							;with the XManager as
							;well as which
							;background tasks.

  "EXIT": WIDGET_CONTROL, event.top, /DESTROY		;There is no need to
							;"unregister" a widget
							;application.  The
							;XManager will clean
							;the dead widget from
							;its list.

  ELSE: MESSAGE, "Event User Value Not Found"		;When an event occurs
							;in a widget that has
							;no user value in this
							;case statement, an
							;error message is shown
ENDCASE

END ;============= end of wcalc event handling routine task =============



;------------------------------------------------------------------------------
;	procedure wcalc
;------------------------------------------------------------------------------
; This routine creates the widget and registers it with the XManager.
;*** This is the main routine for the wcalc widget.  It creates the
;*** widget and then registers it with the XManager which keeps track of the 
;*** currently active widgets.  This routine builds the widget and includes a 
;*** menu built using the function "mkmenu.pro".  The routine "mkmenu.pro"
;*** build the menu defined by the file "wcalc.mnu" and this file must
;*** be in the same directory as "wcalc.pro" to work.
;------------------------------------------------------------------------------
PRO wcalc, GROUP = GROUP, FONT = font


 

COMMON wcalcblock, display, stuff, curr, prev, mem, set, lastop
COMMON wtransblock, conv1, conv2

;*** If wcalc can have multiple copies running, then delete the following
;*** line and the comment for it.  Often a common block is used that prohibits
;*** multiple copies of the widget application from running.  In this case, 
;*** leave the following line intact.

IF(XRegistered("wcalc") NE 0) THEN RETURN		;only one instance of
							;the wcalc widget
							;is allowed.  If it is
							;already managed, do
							;nothing and return

;*** Next the main base is created.  You will probably want to specify either
;*** a ROW or COLUMN base with keywords to arrange the widget visually.

wcalcbase = WIDGET_BASE(TITLE = "IDL Calculator", /COLUMN)	;create the main base

;*** Here some default controls are built in a menu.  The descriptions of these
;*** procedures can be found in the wcalc_ev routine above.  If you would
;*** like to add other routines or remove any of these, remove them both below
;*** and in the wcalc_ev routine.

XPdMenu, [	'"Done"				EXIT',		$
		'"Tools"	{',				$
				'"XLoadct"	XLOADCT',	$
				'"XPalette"	XPALETTE',	$
				'"XManagerTool"	XMANTOOL',	$
				'}'],				$
	 wcalcbase


IF KEYWORD_SET(font) EQ 0 THEN font='*20'


row1 = WIDGET_BASE(wcalcbase, /ROW)

display = WIDGET_TEXT(row1, VALUE='0                              ', $
	  FONT=font,/FRAME)

special = WIDGET_BASE(wcalcbase, /ROW, /FRAME)
slcol   = WIDGET_BASE(special, /COLUMN)
sl2col  = WIDGET_BASE(special, /COLUMN)
smcol   = WIDGET_BASE(special, /COLUMN)
srcol   = WIDGET_BASE(special, /COLUMN)
s4col   = WIDGET_BASE(special, /COLUMN)
s5col   = WIDGET_BASE(special, /COLUMN)
s6col   = WIDGET_BASE(special, /COLUMN)

; COMMONLY USED FN'S:
sqrt = 	WIDGET_BUTTON(slcol, VALUE='SQRT', UVALUE='SQRT')
x2   =  WIDGET_BUTTON(slcol, VALUE='X^2', UVALUE='X^2')
x3   =  WIDGET_BUTTON(slcol, VALUE='X^3', UVALUE='X^3')
x1   =  WIDGET_BUTTON(slcol, VALUE='1/X', UVALUE='1/X')


;LOGS:
alog = 	WIDGET_BUTTON(sl2col, VALUE='LN', UVALUE='ALOG')
alog10 = WIDGET_BUTTON(sl2col, VALUE='LOG', UVALUE='ALOG10')
exp  =	WIDGET_BUTTON(sl2col, VALUE='EXP', UVALUE='EXP')


; TRANSCENDENTALS:
sin =	WIDGET_BUTTON(smcol, VALUE='SIN', UVALUE='SIN')
cos = 	WIDGET_BUTTON(smcol, VALUE='COS', UVALUE='COS')
tan =	WIDGET_BUTTON(smcol, VALUE='TAN', UVALUE='TAN')
pi  =   WIDGET_BUTTON(smcol, VALUE='PI',  UVALUE='PI')

asin =   WIDGET_BUTTON(srcol, VALUE='ASIN', UVALUE='ASIN')
acos =   WIDGET_BUTTON(srcol, VALUE='ACOS', UVALUE='ACOS')
atan =   WIDGET_BUTTON(srcol, VALUE='ATAN', UVALUE='ATAN')

sinh =   WIDGET_BUTTON(s4col, VALUE='SINH', UVALUE='SINH')
cosh =   WIDGET_BUTTON(s4col, VALUE='COSH', UVALUE='COSH')
tanh =   WIDGET_BUTTON(s4col, VALUE='TANH', UVALUE='TANH')

;OTHER FN'S:
fact = WIDGET_BUTTON(sl2col, VALUE='!', UVALUE='!')

;THE DEGREE/RADIAN TOGGLE:
togglebase = WIDGET_BASE(s5col, /COLUMN, /FRAME, /EXCLUSIVE)

degree = WIDGET_BUTTON(togglebase, VALUE='Degrees', $
		       UVALUE = 'DEGREES', /NO_RELEASE)

radian = WIDGET_BUTTON(togglebase, VALUE='Radians', $
                       UVALUE = 'RADIANS', /NO_RELEASE)


keypad = WIDGET_BASE(wcalcbase, /ROW, /FRAME)
lcol   = WIDGET_BASE(keypad, /COLUMN)
rcol   = WIDGET_BASE(keypad, /COLUMN)
r2col  = WIDGET_BASE(keypad, /COLUMN)
r3col  = WIDGET_BASE(keypad, /COLUMN)

row2 = WIDGET_BASE(lcol, /ROW)
seven = WIDGET_BUTTON(row2, VALUE='7', FONT=font, UVALUE='7')
eight = WIDGET_BUTTON(row2, VALUE='8', FONT=font, UVALUE='8')
nine = WIDGET_BUTTON(row2, VALUE='9', FONT=font, UVALUE='9')

row3 = WIDGET_BASE(lcol, /ROW)
four = WIDGET_BUTTON(row3, VALUE='4', FONT=font, UVALUE='4')
five = WIDGET_BUTTON(row3, VALUE='5', FONT=font, UVALUE='5')
six = WIDGET_BUTTON(row3, VALUE='6', FONT=font, UVALUE='6')

row4 = WIDGET_BASE(lcol, /ROW)
one = WIDGET_BUTTON(row4, VALUE='1', FONT=font, UVALUE='1')
two = WIDGET_BUTTON(row4, VALUE='2', FONT=font, UVALUE='2')
three = WIDGET_BUTTON(row4, VALUE='3', FONT=font, UVALUE='3')

row5 = WIDGET_BASE(lcol, /ROW)
zero = WIDGET_BUTTON(row5, VALUE='0', FONT=font, UVALUE='0')
point = WIDGET_BUTTON(row5, VALUE=' .', FONT=font, UVALUE='.')
equals = WIDGET_BUTTON(row5, VALUE=' = ', FONT=font, UVALUE='=')


clear= WIDGET_BUTTON(rcol, VALUE='C', FONT=font, UVALUE='C')
mult = WIDGET_BUTTON(rcol, VALUE='*', FONT=font, UVALUE='*')
div  = WIDGET_BUTTON(rcol, VALUE='/', FONT=font, UVALUE='/')
minus= WIDGET_BUTTON(rcol, VALUE='-', FONT=font, UVALUE='-')
plus = WIDGET_BUTTON(rcol, VALUE='+', FONT=font, UVALUE='+')

ce   = WIDGET_BUTTON(r2col, VALUE='CE', FONT=font, UVALUE='CE')
power= WIDGET_BUTTON(r2col, VALUE='^', FONT=font, UVALUE='^')
plusmin=WIDGET_BUTTON(r2col, VALUE='+/-', FONT=font, UVALUE='+/-')

mem  = WIDGET_BUTTON(r3col, VALUE='M', FONT=font, UVALUE='M')
mempl= WIDGET_BUTTON(r3col, VALUE='M+', FONT=font, UVALUE='M+')
memr = WIDGET_BUTTON(r3col, VALUE='MR', FONT=font, UVALUE='MR')
memc = WIDGET_BUTTON(r3col, VALUE='MC', FONT=font, UVALUE='MC')


; INITIALIZE:

curr = 0.
prev = 0.
mem  = 0.
set = 0
stuff=''
lastop='NOOP'
conv1 = !dtor
conv2 = !radeg

WIDGET_CONTROL, wcalcbase, /REALIZE			;create the widgets
							;that are defined

WIDGET_CONTROL, degree, /SET_BUTTON

XManager, "wcalc", wcalcbase, $			;register the widgets
		EVENT_HANDLER = "wcalc_ev", $	;with the XManager
		GROUP_LEADER = GROUP			;and pass through the
							;group leader if this
							;routine is to be 
							;called from some group
							;leader.

END ;==================== end of wcalc main routine =======================