source: trunk/source/contrib/krueger/InterfaceProjects/Utilities/decimal.lisp @ 13390

Last change on this file since 13390 was 13390, checked in by plkrueger, 10 years ago

New contrib from Paul Krueger

File size: 4.5 KB
Line 
1;; decimal.lisp
2
3#|
4The MIT license.
5
6Copyright (c) 2010 Paul L. Krueger
7
8Permission is hereby granted, free of charge, to any person obtaining a copy of this software
9and associated documentation files (the "Software"), to deal in the Software without restriction,
10including without limitation the rights to use, copy, modify, merge, publish, distribute,
11sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
12furnished to do so, subject to the following conditions:
13
14The above copyright notice and this permission notice shall be included in all copies or substantial
15portions of the Software.
16
17THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT
18LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
20WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
23|#
24
25(require :ns-string-utils)
26
27(defpackage :interface-utilities
28  (:nicknames :iu)
29  (:export lisp-to-ns-decimal lisp-from-ns-decimal))
30
31(in-package :iu)
32
33;; This contains a set of utility functions for converting back and forth between
34;; NSDecimalNumber objects and lisp integers.
35;; Lisp does a good job representing large integers, so in general we can do things
36;; like manipulate dollar amounts just by using integers to represent the total
37;; cents value and doing something like:
38;;       (floor lisp-value 100)
39;; to retrieve dollars and cents values.
40
41;; Using float values for dollars and cents is problematic. Rounding errors will get
42;; you anytime you convert to or from float-values and input or display strings. Apple
43;; has created a special class NSDecimalNumber to represent long decimal numbers. They
44;; defined an array of arithmetic functions to manipulate instance of this class. While
45;; we could probably just use those functions in lisp and manipulate NSDecimalNumber
46;; objects directly, it seems preferable to convert back and forth to lisp integers and
47;; use normal arithmetic operations when in Lisp. Of course it will be up to the Lisp
48;; programmer to understand how many decimal digits are being represented whereas this
49;; value is represented within NSDecimalNumberObjects.
50
51(defun lisp-to-ns-decimal (int-val &key (decimals 2))
52  ;; construct an NSDecimalNumber object with the given int-val and number of decimals
53  ;; For example if you have a dollar amount 123.45 represented by the fixnum 12345
54  ;; you would call (make-ns-decimal 12345 :decimals 2) to get a corresponding
55  ;; NSDecimalNumber object. This object is the responsibility of the caller and a
56  ;; call to #/release must be made when the caller is done with it.
57  (unless (typep int-val 'fixnum)
58    (error "Input must be a fixnum"))
59  (#/decimalNumberWithMantissa:exponent:isNegative:
60   ns:ns-decimal-number
61   (abs int-val)
62   (- decimals)
63   (if (minusp int-val) #$YES #$NO)))
64
65(defun lisp-from-ns-decimal (ns-dec-obj &key (decimals 2))
66  ;; This function returns a fixnum that corresponds to the NSDecimalNumber
67  ;; or NSNumber that is passed in as the first argument.
68  ;; The result will be scaled and rounded to represent the desired
69  ;; number of decimal digits as specified by the :decimals keyword argument.
70  ;; For example, if an NSNumber is passed in which is something like 123.45678
71  ;; and you ask for 2 decimal digits, the returned value will be the integer 12346.
72  (let* ((loc (#/currentLocale ns:ns-locale))
73         (lisp-str (ccl::lisp-string-from-nsstring 
74                    (#/descriptionWithLocale: ns-dec-obj loc)))
75         (str-len-1 (1- (length lisp-str)))
76         (dec-pos (or (position #\. lisp-str) str-len-1))
77         (dec-digits (- str-len-1 dec-pos))
78         (dec-diff (- decimals dec-digits))
79         (mantissa-str (delete #\. lisp-str)))
80    (cond ((zerop dec-diff)
81           (read-from-string mantissa-str))
82          ((plusp dec-diff)
83           (read-from-string (concatenate 'string 
84                                          mantissa-str
85                                          (make-string dec-diff :initial-element #\0))))
86          (t ;; minusp dec-diff
87           (let ((first-dropped (+ (length mantissa-str) dec-diff)))
88             (+ (if (> (char-code (elt mantissa-str first-dropped)) (char-code #\4)) 1 0)
89                (read-from-string (subseq mantissa-str 0 first-dropped))))))))
90   
91
Note: See TracBrowser for help on using the repository browser.