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