Rebol [
	title: "Supercalculator"
	author: "Massimiliano Vessi"
	date:  17/02/2010
	email: maxint@tiscali.it
	file: %supercalculator.r
	Purpose: {"Scientific calculator in Rebol!"}
	;following data are for www.rebol.org library
	;you can find a lot of rebol script there
	library: [ 
		level: 'beginner 
		platform: 'all 
		type: [tutorial  tool] 
		domain: [vid gui  text-processing ui user-interface scientific] 
		tested-under: [windows linux] 
		support: none 
		license: [gpl] 
		see-also: none 
		] 
	version: 3.8.23
	]

;FOREWORDS
;I wrote this scientific calculatur with only 200 lines of code (1-2 hours)!
;I used RebGUI, but I could use VID...
;but RebGui is more beautiful than VID...
;no other language make people capable of writing a scientific calculatoin 2 hours or less.
if not exists? %rebgui_218.r  [  alert "RebGUI v.218 not found, I'll try to download it."
	temp: read http://www.maxvessi.net/rebsite/rebgui_218.r
	write %rebgui_218.r temp
	notify "RebGUI v.218 correctly downloaded and saved to disk."
	]

do %rebgui_218.r


;system variabels:
conf: make object! [
 fix_digits: true  ;set fixed digit approximation (just on the screen, numbers are never really approximated)
 digits:  2  ;set number of digits if fix_digits is true
 hystory: true  ;set write history 
 hystory_data: " "
 ultimo: 0
 hystory_len: 10
 ]

;load variables from configuration file, if it exists
if exists? %.supercalculator.conf [ conf:  do load %.supercalculator.conf ]



;Here starts supercalculator script:
errore: false  ;error checking
;set background color
CTX-REBGUI/COLORS/page: 255.255.240
	
;following lines are to obtain current file version
header-script: system/script/header
version: "Version: "
append version header-script/version
	
;che i load old results hystory
either conf/hystory [
	aa: risultato2: conf/hystory_data	
	ultimo: conf/ultimo
	] [
	aa: risultato2: " "
	ultimo: 0	
	]



decimali: 0.1 ** conf/digits
; We define a function to round the values to the specified digits
troncare: func [ misura2 ]
   [
   esatto: round/to misura2 decimali
   return esatto
   ]


valuta: func [frase][	
	frase: to-string frase
	frase: trim/all frase  ;we avoid spaces
	nega: false
	
	 
	;let's check if want to reuse last result
	if (parse frase  [ ["+"|"-"|"*"|"/"|"^^" ] to end ])  [ 
		ultimo2: to-decimal ultimo 
		if ultimo2 < 0 [   ;so we avoid problems with negative numbers
			ultimo: to-string ultimo 
			insert ultimo "0"  
			nega: true
			]
		insert frase ultimo
		]
	
	replace/all frase "("  " ((( " ;so we don't mix original parentheisis with the followings
	replace/all frase ")"  " ))) " ;so we don't mix original parentheisis with the followings
	replace/all frase  "abs-"   "  abs  " ;it's tricky but necessary
	replace/all frase  "abs+"   "  abs  "
	replace/all frase "exp-"   "  exp  negate "
	replace/all frase "log-"   "  log negate  "
	replace/all frase "ln-"   "  ln negate  "
	replace/all frase "sin-"   "  sin negate  " 
	replace/all frase "cos-"   "  cos negate  "
	replace/all frase "tangent-"   "  tangent  negate "
	replace/all frase "arcs-"   "  arcs negate  " ;bad change, but necessary
	replace/all frase "arcc-"   "  arcc negate  " ;bad change, but necessary
	replace/all frase "arct-"   "  arct negate  " ;bad change, but necessary
	replace/all frase "*"  " ) * ( "
	replace/all frase "/"   " ) / ( "
	replace/all frase "+"   " )) + (( "
	replace/all frase "-"   " )) - (( "
	replace/all frase "^^"   "  **  " ;bad change, but necessary
	replace/all frase "exp"   "  exp  "
	replace/all frase "log"   "  log-10  "
	replace/all frase "ln"   "  log-e  "
	replace/all frase "sqrt"   "  square-root  " ;bad change, but necessary
	replace/all frase  "abs"   "  abs  "
	replace/all frase "sin"   "  sine  " 
	replace/all frase "cos"   "  cosine  "
	replace/all frase "tangent"   "  tangent  "
	replace/all frase "arcs"   "  arcsine  " ;bad change, but necessary
	replace/all frase "arcc"   "  arccosine  " ;bad change, but necessary
	replace/all frase "arct"   "  arctangent  " ;bad change, but necessary
	replace/all frase "e )) - (( "   "e-" ;bad change, but necessary
	insert frase " (( "
	append frase " )) "	
	
	;uncomment the following line to debug or to see what happen...	
	;print frase
	
	frase2: parse frase none ;split frase
	temp2: 0
	;transform all integers in decimal, to avoid overflow
	foreach item frase2 [
		temp2: temp2 + 1
		temp: attempt [type? do item ]		
		if temp = integer! [frase2/(reduce temp2): to-decimal frase2/(reduce temp2) ]
		]
	frase2: form frase2
	
	risultato: attempt [do frase2 ]

	if risultato = none  [  errore: true 
		risultato: 0 ]
	
	ultimo:  risultato ;the last result
	;check if user wants to round result
	if  conf/fix_digits  [  risultato: troncare risultato ]
	
	;print risultato
	;restore the origina string
	replace/all frase    "  **  " "^^"
	replace/all frase   "  arcsine  "  "arcs" 
	replace/all frase    "  arccosine  " "arcc"
	replace/all frase   "  arctangent  " "arct" 
	replace/all frase    "  square-root  " "sqrt"
	replace/all frase    "  abs  "  "abs"
	replace/all frase    "  sine  "  "sin"
	replace/all frase   "  cosine  " "cos" 
	replace/all frase    "  log-10  " "log"
	replace/all frase    "  log-e  " "ln"
	
	replace/all frase    "  exp  negate " "exp-"
	replace/all frase    "  log negate  " "log-"
	replace/all frase    "  ln negate  "  "ln-"
	replace/all frase    "  sin negate  "  "sin-"
	replace/all frase    "  cos negate  " "cos-"
	replace/all frase    "  tangent  negate " "tangent-"
	replace/all frase   "  arcs negate  "   "arcs-" 
	replace/all frase    "  arcc negate  "  "arcc-"
	replace/all frase   "  arct negate  "  "arct-" 
	
	replace/all  frase " ) " "" ;remove al simple parenthesis
	replace/all  frase " ( " "" ;remove al simple parenthesis
	replace/all  frase " (( " "" ;remove al double parenthesis
	replace/all  frase " )) " "" ;remove al double parenthesis
	replace/all frase   " ((( "  "(" ;
	replace/all frase   " ))) "  ")"
	
	
	
	pretty_frase: trim/all frase
	if nega = true [ remove pretty_frase] ;we remove the first zero added to avoid problems with negative numbers
	;riga is the separetor line
	riga: copy "-------"
	n_riga: length? pretty_frase
	for i 1 n_riga 1 [ append riga "-" ]
	
	risultato2: head risultato2
	either errore [  risultato2: insert risultato2  (reform [ "^/" pretty_frase "^/" riga "^/= " " ERROR!^/"]) ] [
		risultato2: insert risultato2  (reform [ "^/" pretty_frase "^/" riga "^/= " risultato "^/"]) 
		]
	risultato2: head risultato2
	errore: false
	;save history, if it is set on
	if  conf/hystory [
		if   conf/hystory_len > 0 [ conf/hystory_data: copy/part risultato2  (conf/hystory_len * 30) ]
		if   conf/hystory_len = 0 [ conf/hystory_data: copy risultato2 ]
		conf/ultimo: ultimo
		save %.supercalculator.conf  conf
		] 		
	return risultato2
	]



display "Supercalculator" [

	text "History:"
	return
	a_field: area 130x50 aa
	
	
	
	
	return
	text "Write expression:"
	b_field: field 100x5 [ 
		if  b_field/text = "" [ b_field/text: "0"]
		a_field/text: to-string (valuta b_field/text)
		;b_field/text: copy []
		clear-text/focus b_field
		;b_field/text: to-string b_field/text
		show [ a_field b_field]
		]
	return 
	button  yellow "1" [ append b_field/text "1"  show b_field]
	button  yellow "2" [ append b_field/text "2"  show b_field]
	button  yellow "3" [ append b_field/text "3"  show b_field]
	button   "+" [ append b_field/text "+"  show b_field]
	button   "-" [ append b_field/text "-"  show b_field]
	button "sin"   [ append b_field/text "sin"  show b_field]
	button "cos"  [ append b_field/text "cos"  show b_field]
	button "tan"  [ append b_field/text "tangent"  show b_field]
	return
	button yellow  "4" [ append b_field/text "4"  show b_field]
	button  yellow "5" [ append b_field/text "5"  show b_field]
	button  yellow "6" [ append b_field/text "6"  show b_field]
	button   "*" [ append b_field/text "*"  show b_field]
	button   "/" [ append b_field/text "/"  show b_field]
	button "asin"  [ append b_field/text "arcs"  show b_field]
	button "acos"  [ append b_field/text "arcc"  show b_field]
	button "atan"  [ append b_field/text "arct"  show b_field]
	return
	button  yellow "7" [ append b_field/text "7"  show b_field]
	button  yellow "8" [ append b_field/text "8"  show b_field]
	button yellow  "9" [ append b_field/text "9"  show b_field]
	
	button   " ^^ " [ append b_field/text "^^"  show b_field]
	button  "EE" [ append b_field/text "e"  show b_field]
	button  "log"  [ append b_field/text "log"  show b_field]	
	button  "ln" [ append b_field/text "ln"  show b_field]	
	button  "e^^"  [ append b_field/text " exp "  show b_field]	
	
	return
	button  yellow "." [ append b_field/text "."  show b_field]
	button yellow  "0" [ append b_field/text "0"  show b_field]
	button   green "=" [ 
		if  b_field/text = "" [ b_field/text: "0"] ;b_field is formula field
		a_field/text: to-string (valuta b_field/text) ;a_field is history field
		b_field/text: copy []
		b_field/text: to-string b_field/text
		show [ a_field b_field]
		]
	button red  "CC" [ b_field/text: copy []   show b_field]
	button    "SQRT" [ append b_field/text "sqrt"  show b_field]
	
	button   "(" [ append b_field/text "("  show b_field]
	button   ")" [ append b_field/text ")"  show b_field]
	
	button  "abs"   [ append b_field/text "abs"  show b_field]	
		
		
	return
	
	
	button blue "Configuration" [ 
		display "Configuration" [
			y_chk: check "Fixed decimal digits?" data conf/fix_digits [ 
			conf/fix_digits: y_chk/data 
			save %.supercalculator.conf  conf
			]
			text "Digits"
			cifredecimali: spinner options [1 15 1]  data  conf/digits [
				decimali: 0.1 ** (  cifredecimali/data )
				conf/digits: cifredecimali/data
				save %.supercalculator.conf  conf
				]
			return	
			h_chk: check "Save history?" data 	conf/hystory [ 
				conf/hystory: h_chk/data   
				save %.supercalculator.conf  conf
				]
			text "History lenght?" 	
			hyst_len: spinner options [0 1000 1] data conf/hystory_len [ 
				conf/hystory_len: hyst_len/data
				save %.supercalculator.conf  conf
				]
			return 	
			text 	"(0 means infinite history)" italic
			]
		]
	button blue "?" [ display "Help"  [ 
			heading "HELP"
			return
			text {Welcome to Supercalculator, a Scientific calculator written in Rebol.
You can use it on Windows, Linux, Mac and whatever Rebol works!
You can write directly the formulas in the field an press ENTER or press =.
You can use parethesis to write correctly the formulas. 
If you have some trouble, try to delete ".supercalculator.conf" file.
You can contact me for help: 
Massimiliano Vessi }
return link ( rejoin [ "maxint" "@" "tiscali.it"])
			return
			text  version
			return
			image logo.gif [display "my note" [text {I wrote this scientific calculatur with only 200 lines of code (1-2 hours), 
I used RebGUI, but I could use the orginal VID reducing to the original 200 lines of code,
but RebGui is more beautiful than VID...
However no other language make people capable of writing a scientific calculator in 2 hours or less.
Massimiliano Vessi}] 
				]
			]
		]	
	text version ;to visualize version	
	do [set-focus b_field]
	]

do-events