copyright (c) 2010 Peter W A Wood Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. REBOL [ title: "Decimal Arithmetic" version: {see money/version} date: 22-Jul-2010 author: Peter W A Wood file: %money.r purpose: {Decimal arithmetic for numbers held as strings. Numbers may have up to 12 integral digits and always have 2 fractional digits} library: [ type: [package tool] domain: [math] license: 'mit ] ] money: make object! [ ;; object variables version: "0.5.5" lib: none ;; the money library add-routine: none subtract-routine: none multiply-routine: none divide-routine: none format-routine: none accounting-format-routine: none version-routine: none answer: none answer-length: none float-first: none float-second: none answer-init: "^(20)********************************" ;; parse validation rules dec: charset [#"0" - #"9"] valid-number: [[opt #"-"] any dec opt [#"." [0 2 dec]]] ;; internal functions _check-numbers: func [ first-number [string!] second-number [string!] ][ any [ not parse/all first-number valid-number not parse/all second-number valid-number error? try [float-first: to decimal! first-number] error? try [float-second: to decimal! second-number] 999999999999.99 < abs float-first 999999999999.99 < abs float-second ] ] _check-number: func [ number [string!]12 ][ any [ not parse/all number valid-number error? try [float-first: to decimal! number] 999999999999.99 < abs float-first ] ] _extract-answer: func [] [ answer-length: to integer! first answer remove answer copy/part answer answer-length ] _prepare: func[ n [string!]] [ insert copy n to char! min length? n 32 ] init: func [ {Loads the library and creates the routines} library-name [file!] /local script-vers lib-vers ][ ;; Load the library lib: load/library library-name ;; Check it is the correct version by comparing the major and minor release ;; numbers of the script and libary version-routine: make routine! [ answer [string!] ] lib "version" answer: copy answer-init version-routine answer remove answer script-vers: copy version script-vers: remove/part find next find script-vers "." "." index? tail script-vers lib-vers: copy answer lib-vers: remove/part find next find copy lib-vers "." "." length? lib-vers if lib-vers <> script-vers [ make error! "Incompatible versions of the script and dynamic libary" ] ;; setup the working routines add-routine: make routine! [ first-number [string!] second-number [string!] answer [string!] ] lib "add" subtract-routine: make routine! [ first-number [string!] second-number [string!] answer [string!] ] lib "subtract" multiply-routine: make routine! [ first-number [string!] second-number [string!] answer [string!] ] lib "multiply" divide-routine: make routine! [ first-number [string!] second-number [string!] answer [string!] ] lib "divide" format-routine: make routine! [ number [string!] answer [string!] ] lib "format" accounting-format-routine: make routine! [ number [string!] answer [string!] ] lib "accountingformat" #[unset!] ;; so as not to return the last routine made ] free-lib: func [ {Frees the dynamic library} ][ free lib #[unset!] ] add: func [ {Returns the addition of two numbers} first-number [string!] second-number [string!] ][ if any [ _check-numbers first-number second-number 999999999999.99 < abs (float-first + float-second) ][ return "error" ] ;; initialise the "return string" answer: copy answer-init ;; call the library routine add-routine _prepare first-number _prepare second-number answer _extract-answer ] subtract: func [ {Returns the result of subtracting the second number from the first} first-number [string!] second-number [string!] ][ if any [ _check-numbers first-number second-number 999999999999.99 < ((abs float-first) + (abs float-second)) ][ return "error" ] ;; initialise the "return string" answer: copy answer-init ;; call the library routine subtract-routine _prepare first-number _prepare second-number answer _extract-answer ] multiply: func [ {Returns the multiplication of the two numbers} first-number [string!] second-number [string!] ][ if any [ _check-numbers first-number second-number 999999999999.99 < ((abs float-first) * (abs float-second)) ][ return "error" ] answer: copy answer-init ;; call the library routine multiply-routine _prepare first-number _prepare second-number answer _extract-answer ] divide: func [ {Returns the result of dividing the first number by the second} first-number [string!] second-number [string!] ][ if any [ _check-numbers first-number second-number float-second = 0 999999999999.99 < ((abs float-first) / (abs float-second)) ][ return "error" ] answer: copy answer-init ;; call the library routine divide-routine _prepare first-number _prepare second-number answer _extract-answer ] format: func [ {returns a formatted number with thousands separators} number [string!] ][ if any [ _check-number number ][ return "error" ] answer: copy answer-init format-routine _prepare number answer _extract-answer ] accounting-format: func [ {returns a formatted number with thousands separators and negative numbers enclosed in parentheses} number [string!] ][ if any [ _check-number number ][ return "error" ] answer: copy answer-init accounting-format-routine _prepare number answer _extract-answer ] ]