money_culture.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


immutable class SIGN_POSITIONS < $ENUMS{SIGN_POSITIONS}

immutable class SIGN_POSITIONS < $ENUMS{SIGN_POSITIONS} is -- This is an enumeration class which describes the different -- positions in which a plus/minus sign may be placed when formatting -- a monetary quantity. -- -- There should be associated message files with entries containing -- words indicating the following semantics given in English below -- -- Parentheses - the fact that a quantity is negative is indicated by -- enclosing it and the monetary symbol in parentheses. -- Preceding - the sign appears in front of the value -- Following - the sign appears after the value -- After - the sign appears after the currency symbol -- Before - the sign appears in front of the currency symbol. -- Version 1.0 May 97. Copright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 May 97 kh Original include ENUM{SIGN_POSITIONS} ; private const val_count : CARD := 5 ; -- The next routines provide the enumeration itself for a selection -- of the official registry encodings. Parentheses : SAME is return enum(1) end ; Preceding : SAME is return enum(2) end ; Following : SAME is return enum(3) end ; Before_SY : SAME is return enum(4) end ; After_SY : SAME is return enum(5) end ; end ; -- SIGN_POSITIONS

immutable class MON_SPACING < $ENUMS{MON_SPACING}

immutable class MON_SPACING < $ENUMS{MON_SPACING} is -- This is an enumeration class which describes the positioning of any -- space included in the formatted representation of a monetary quantity. -- The associated messages file should have the following entries with -- the semantics given below in English -- -- None -- Value_Sep - a space is to be placed between the symbol and the value -- Sign_Sep - a space separates the symbol and sign string (if they are -- adjacent) -- Version 1.0 May 97. Copright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 20 May 97 kh Original include ENUM{MON_SPACING} ; private const val_count : CARD := 3 ; -- The next routines provide the enumeration itself for a selection -- of the official registry encodings. None : SAME is return enum(1) end ; Value_Sep : SAME is return enum(2) end ; Sign_Sep : SAME is return enum(3) end ; end ; -- MON_SPACING

class MONEY_FMT < $BINARY

class MONEY_FMT < $BINARY is -- This class implements the specialised money value format description -- for use when preparing textual representations of a money value as well as -- when obtaining a monetary value from a string. -- Version 1.1 Jul 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 22 May 97 kh Original design using ISO/IEC 14652 spec. -- 22 Jul 98 kh Added $BINARY features. include BINARY ; private const Money_Base : CARD := 10 ; private const Carry : CARD := 1 ; -- used when rounding! readonly attr num_fmt : NUMBER_FMT ; readonly attr positive_sign : CHAR_CODE ; readonly attr negative_sign : CHAR_CODE ; readonly attr currency_symbol : CODE_STR ; private attr sections : ARRAY{CARD} ; -- all small numbers private attr places : CARD ; -- a small number private attr positive_symbol_precedes : TRI_STATE ; private attr positive_sign_separation : MON_SPACING ; private attr positive_sign_position : SIGN_POSITIONS ; private attr negative_symbol_precedes : TRI_STATE ; private attr negative_sign_separation : MON_SPACING ; private attr negative_sign_position : SIGN_POSITIONS ; create(dec,sep,plus_mark,minus_mark,symbol : CODE_STR,sects : FLIST{CARD},precision : CARD,plus_before : TRI_STATE,plus_sep : MON_SPACING,plus_posn : SIGN_POSITIONS,neg_before : TRI_STATE,neg_sep : MON_SPACING,neg_pos : SIGN_POSITIONS) : SAME pre ~void(sects) and (sects.size > 0) and ~plus_sep.is_nil and ~plus_posn.is_nil and ~neg_sep.is_nil and ~neg_pos.is_nil post ~void(result) is -- This creation routine is provided to enable the program which is -- creating the binary files from their source text to create one of these -- format objects. --if void(sects) then #OUT+"money_culture.sa create "+"void(sects)"+"\n"; end; -- --if (sects.size > 0).not then #OUT+"money_culture.sa create "+"sects.size"+sects.size.str+"\n"; end; -- --if plus_sep.is_nil then #OUT+"money_culture.sa create "+"plus_sep.is_nil"+"\n"; end; --if plus_posn.is_nil then #OUT+"money_culture.sa create "+"plus_posn.is_nil"+"\n"; end; --if neg_sep.is_nil then #OUT+"money_culture.sa create "+"neg_sep.is_nil"+"\n"; end; --if neg_pos.is_nil then #OUT+"money_culture.sa create "+"neg_pos.is_nil"+"\n"; end; me : SAME := new ; me.num_fmt := NUMBER_FMT::create(dec,sep,sects) ; if ~void(plus_mark) then loop me.positive_sign := plus_mark.elt! ; break! end end ; if ~void(minus_mark) then loop me.negative_sign := minus_mark.elt! ; break! end end ; if ~void(symbol) then me.currency_symbol := symbol end ; me.places := precision ; me.positive_symbol_precedes := plus_before ; me.positive_sign_separation := plus_sep ; me.positive_sign_position := plus_posn ; me.negative_symbol_precedes := neg_before ; me.negative_sign_separation := neg_sep ; me.negative_sign_position := neg_pos ; return me end ; build(index : BIN_CURSOR,lib : LIBCHARS) : SAME pre ~void(index) and ~index.is_done post ~void(result) or index.is_done is -- This routine reads its component values from the binary string -- indicated and then returns the new object. me : SAME := new ; me.num_fmt := NUMBER_FMT::build(index,lib) ; loc_str : BINSTR := index.get_sized ; if loc_str.size > 0 then me.positive_sign := CHAR_CODE::create(loc_str,lib) end ; loc_str := index.get_sized ; if loc_str.size > 0 then me.negative_sign := CHAR_CODE::create(loc_str,lib) end ; loc_cursor : BIN_CURSOR := index.get_sized.cursor ; if ~void(loc_cursor) then me.currency_symbol := CODE_STR::build(loc_cursor,lib) end ; me.places := index.get_item.card ; me.positive_symbol_precedes := TRI_STATE::build(index) ; me.positive_sign_separation := MON_SPACING::build(index) ; me.positive_sign_position := SIGN_POSITIONS::build(index) ; me.negative_symbol_precedes := TRI_STATE::build(index) ; me.negative_sign_separation := MON_SPACING::build(index) ; me.negative_sign_position := SIGN_POSITIONS::build(index) ; return me end ; build(index : BIN_CURSOR) : SAME pre ~void(index) post ~void(result) or index.is_done is -- This routine creates a new object from the given binary string, using -- the default repertoire and encoding. return build(index,LIBCHARS::default) end ; inspect is #OUT+"money_culture.sa inspect: "; #OUT+",num_fmt:"; if void(num_fmt) then #OUT+"/"; else #OUT+"*"; end; #OUT+",positive_sign:"; if void(positive_sign) then #OUT+"/"; else #OUT+"*"; end; #OUT+",negative_sign:"; if void(negative_sign) then #OUT+"/"; else #OUT+"*"; end; #OUT+",currency_symbol:"; if void(currency_symbol) then #OUT+"/"; else #OUT+currency_symbol.tgt_str; end; #OUT+",places:"+ places.str_base(10) ; #OUT+",positive_symbol_precedes:"; if void(positive_symbol_precedes) then #OUT+"/"; else #OUT+"*"; end; #OUT+",positive_sign_separation:"; if void(positive_sign_separation) then #OUT+"/"; else #OUT+"*"; end; #OUT+",positive_sign_position:"; if void(positive_sign_position) then #OUT+"/"; else #OUT+"*"; end; #OUT+",negative_symbol_precedes:"; if void(negative_symbol_precedes) then #OUT+"/"; else #OUT+"*"; end; #OUT+",negative_sign_separation:"; if void(negative_sign_separation) then #OUT+"/"; else #OUT+"*"; end; #OUT+",negative_sign_position:"; if void(negative_sign_position) then #OUT+"/"; else #OUT+"*"; end; #OUT+".\n"; end; binstr : BINSTR pre ~void(self) post ~void(result) is -- This routine returns a binary string representation of self starting -- with the numeric format, the signs/symbols, then the special features. --#OUT+"money_culture.sa binstr 1.\n"; --inspect; loc_str : BINSTR := num_fmt.binstr; --#OUT+"money_culture.sa binstr 2.\n"; loc_str:=loc_str+positive_sign.raw_binstr.sized; --#OUT+"money_culture.sa binstr 3.\n"; loc_str:=loc_str+negative_sign.raw_binstr.sized; --#OUT+"money_culture.sa binstr 4.\n"; loc_str:=loc_str+currency_symbol.binstr.sized ; --#OUT+"money_culture.sa binstr 5.\n"; loc_str := loc_str + OCTET::create(places) ; --#OUT+"money_culture.sa binstr 6.\n"; loc_str := loc_str +positive_symbol_precedes.binstr; --#OUT+"money_culture.sa binstr 7.\n"; loc_str:=loc_str+positive_sign_separation.binstr; --#OUT+"money_culture.sa binstr 8.\n"; loc_str:=loc_str+positive_sign_position.binstr; --#OUT+"money_culture.sa binstr 9.\n"; loc_str:=loc_str+negative_symbol_precedes.binstr; --#OUT+"money_culture.sa binstr 10.\n"; loc_str:=loc_str+negative_sign_separation.binstr; --#OUT+"money_culture.sa binstr 11.\n"; loc_str:=loc_str+negative_sign_position.binstr; --#OUT+"money_culture.sa binstr 12.\n"; return loc_str end ; private do_layout(num : CODE_STR,symbol_precedes : TRI_STATE,sign : CODE_STR,position : SIGN_POSITIONS,separation : MON_SPACING,lib : LIBCHARS) : CODE_STR pre ~void(lib) and (num.size > 0) post result.size >= num.size is -- This is the routine which lays out a monetary string representation -- in accordance with the parameters given. res : CODE_STR := CODE_STR::create(lib) ; if symbol_precedes = TRI_STATE::Yes then -- the value case position when SIGN_POSITIONS::Parentheses then res := res + lib.Left_Parenthesis ; res := res + currency_symbol ; if separation = MON_SPACING::Value_Sep then res := res + lib.Space end ; res := res + num ; res := res + lib.Right_Parenthesis ; return res -- return res + num + lib.Right_Parenthesis when SIGN_POSITIONS::Preceding then res := currency_symbol ; case separation when MON_SPACING::None then res := res + sign when MON_SPACING::Value_Sep then res := res + sign + lib.Space when MON_SPACING::Sign_Sep then res := res + lib.Space + sign end ; return res + num when SIGN_POSITIONS::Following then res := currency_symbol ; case separation when MON_SPACING::None then res := res + num when MON_SPACING::Value_Sep then res := res + lib.Space + num when MON_SPACING::Sign_Sep then res := res + num + lib.Space end ; return res + sign when SIGN_POSITIONS::Before_SY then res := sign ; case separation when MON_SPACING::None then res := res + currency_symbol when MON_SPACING::Value_Sep then res := res + currency_symbol + lib.Space when MON_SPACING::Sign_Sep then res := res + lib.Space + currency_symbol end ; return res + num when SIGN_POSITIONS::After_SY then res := currency_symbol ; case separation when MON_SPACING::None then res := res + sign when MON_SPACING::Value_Sep then res := res + sign + lib.Space when MON_SPACING::Sign_Sep then res := res + lib.Space + sign end ; return res + num end else -- symbol after value case position when SIGN_POSITIONS::Parentheses then res := res + lib.Left_Parenthesis + num ; if separation = MON_SPACING::Value_Sep then res := res + lib.Space end ; return res + currency_symbol + lib.Right_Parenthesis when SIGN_POSITIONS::Preceding then res := sign ; case separation when MON_SPACING::None, MON_SPACING::Value_Sep then res := res + num when MON_SPACING::Sign_Sep then res := res + lib.Space + num end ; return res + currency_symbol when SIGN_POSITIONS::Following then res := num ; case separation when MON_SPACING::None, MON_SPACING::Value_Sep then res := res + sign when MON_SPACING::Sign_Sep then res := res + lib.Space + sign end ; return res + currency_symbol when SIGN_POSITIONS::Before_SY then res := num ; case separation when MON_SPACING::None, MON_SPACING::Value_Sep then res := res + sign when MON_SPACING::Sign_Sep then res := res + sign + lib.Space end ; return res + currency_symbol when SIGN_POSITIONS::After_SY then res := num ; case separation when MON_SPACING::None then res := res + num + currency_symbol when MON_SPACING::Value_Sep then res := res + lib.Space + currency_symbol when MON_SPACING::Sign_Sep then res := res + currency_symbol + lib.Space end ; return res + sign end end end ; fmt(cash : MONEY,lib : LIBCHARS) : STR pre ~void(lib) post ~void(result) -- and it is a culturally correct string is -- The following routine returns the formatted monetary string -- representation for the value given. -- -- This routine produces a formatted version of the given data as a text -- string representation. The first section of the routine converts the -- monetary value into an infinite integer and then a decimal digit list. -- Subsequently the numbers are formatted as a number and then laid out in -- textual representation as required by the format. res : CODE_STR := CODE_STR::create(lib) ; multiplier : INTI := INTI::create(1) ; loc_base : INTI := INTI::create(Money_Base) ; loc_denom : INTI := cash.val.denom ; loc_val : INTI := cash.val.num ; -- for normalisation! loc_val := (loc_val * cash.Precision) / loc_denom ; -- Now get the list of digits (with four decimal places!) digs : FLIST{CARD} := loc_val.digits ; if cash.Calculate_Places > places then loc_round : BOOL := false ; loc_place : CARD ; index : CARD ; loop -- rounding for representation! index := 0.upto!(cash.Calculate_Places - places - 1) ; if loc_round then if digs[index] + 1 >= 5 then loc_place := index else loc_round := false end elsif digs[index] >= 5 then loc_round := true ; loc_place := index end end ; if loc_round then loop -- to round to MS digits as needed index := (loc_place + 1).upto!(digs.size - 1) ; if digs[index] = 9 then digs[index] := 0 else digs[index] := digs[index] + 1 ; break! end end end ; loc_place := cash.Calculate_Places - places ; digs := digs.sublist(loc_place,digs.size - loc_place) end ; loc_sign : CODE_STR ; num : CODE_STR := num_fmt.fmt(digs,places,true,lib) ;-- numeric value string! if cash.val >= RAT::zero then -- use 'positive' comps if void(positive_sign) then loc_sign := CODE_STR::create(lib) else loc_sign := CODE_STR::create(positive_sign) end ; return do_layout(num,positive_symbol_precedes,loc_sign, positive_sign_position,positive_sign_separation, lib).tgt_str else -- use 'negative' comps if void(negative_sign) then loc_sign := CODE_STR::create(lib) else loc_sign := CODE_STR::create(negative_sign) end ; return do_layout(num,negative_symbol_precedes,loc_sign, negative_sign_position,negative_sign_separation, lib).tgt_str end end ; end ; -- MONEY FMT

class CASH < $BINARY

class CASH < $BINARY is -- This class contains the component values and formats for the monetary -- section of the cultural specification in ISO/IEC 14652 (as amended). -- -- Version 1.0 Jun 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 26 Jun 98 kh Original design from cultural compiler include BINARY ; readonly attr local : MONEY_FMT ; readonly attr international : MONEY_FMT ; readonly attr local_duo : MONEY_FMT ; readonly attr international_duo : MONEY_FMT ; readonly attr validity_from : DATES ; readonly attr validity_to : DATES ; readonly attr duo_validity_from : DATES ; readonly attr duo_validity_to : DATES ; readonly attr exchange_rate : RAT ; build(str : BIN_CURSOR,lib : LIBCHARS) : SAME pre ~void(str) and ~str.is_done and ~void(lib) post ~void(result) or str.is_done is -- Given a binary file string, this routine attempts to create a new -- object from the indicated binary string. me : SAME := new ; me.local := MONEY_FMT::build(str,lib) ; me.international := MONEY_FMT::build(str,lib) ; me.local_duo := MONEY_FMT::build(str,lib) ; me.international_duo := MONEY_FMT::build(str,lib) ; me.validity_from := DATES::read(str) ; -- This group of comps is optional me.validity_to := DATES::read(str) ; me.duo_validity_from := DATES::read(str) ; me.duo_validity_to := DATES::read(str) ; me.exchange_rate := RAT::build(str) ; -- not optional if void(me.local) -- have run off the binary string! or void(me.international) or void(me.local_duo) or void(me.international_duo) or void(me.exchange_rate) then return void else return me end end ; build(str : BIN_CURSOR) : SAME pre ~void(str) and ~str.is_done post ~void(result) or str.is_done is -- Given a binary file string, this routine attempts to create a new -- object from the indicated binary string using the default repertoire and -- encoding. return build(str,LIBCHARS::default) end ; binstr : BINSTR pre ~void(self) post ~void(result) is -- This routine returns the contents of self as a binary string. res : BINSTR := BINSTR::create + local.binstr + international.binstr + local_duo.binstr + international_duo.binstr ; res := res + (~(validity_from = DATES::null)).binstr ; if ~(validity_from = DATES::null) then res := res + validity_from.binstr end ; res := res + (~(validity_to = DATES::null)).binstr ; if ~(validity_to = DATES::null) then res := res + validity_to.binstr end ; res := res + (~(duo_validity_from = DATES::null)).binstr ; if ~(duo_validity_from = DATES::null) then res := res + duo_validity_from.binstr end ; res := res + (~(duo_validity_to = DATES::null)).binstr ; if ~(duo_validity_to = DATES::null) then res := res + duo_validity_to.binstr end ; res := res + exchange_rate.binstr ; return res end ; end ; -- CASH