eradates.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 ERA_DATES < $DATES{ERA_DATES}

immutable class ERA_DATES < $DATES{ERA_DATES} is -- This class provides the ability to find, check and manipulate dates -- which belong to some culture-dependent date era system. -- Version 1.0 Jun 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 16 Jun 97 kh Original from DATES. -- NOTE THIS IMPLEMENTATION IS MERELY A SKELETON WHICH NEEDS FLESHING -- OUT FOR A GIVEN ERA SYSTEM IN A PARAMETERISED WAY. IT IS NOT -- VALID CODE!!!!! include COMPARABLE ; include BINARY ; include ERADATE_STR ; private attr val : CARD ; private const Years_in_Era : CARD := 100 ; -- ?????????????????????? private const Leap_Cycle : CARD := 4 ; private const Days_in_Week : CARD := 7 ; private const Days_in_Year : CARD := 365 ; -- in an ordinary year anyway! private const Base_Year : CARD := 1900 ; -- ????????????????????? private const Base_Wday : WEEKDAYS := WEEKDAYS::Sunday ; -- ?????????????????????? private const February : CARD := 2 ; -- ?????????????????????? private const Month_Max : ARRAY{CARD} := | 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 | ; --????????? -- NOTE The above array has a dummy entry at the beginning! nil : SAME is -- This procedure returns the nil date. return val(CARD::nil) end ; count : CARD is -- This procedure returns the number of days since the base date -- -- ie it merely returns self! return val end ; private days_in_years( year : CARD ) : CARD pre (year >= Base_Year) post (result > 0) is -- This routine returns the number of days since the base date up to -- the beginning of the year indicated. leap_days : CARD := 0 ; loop loc_year : CARD := Base_Year.upto!(year - 1) ; if is_leap_year(loc_year) then leap_days := leap_days + 1 end end ; return (year - Base_Year) * Days_in_Year + leap_days end ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true is -- This routine builds a time value from the binary string indicated. base : CARD := CARD::build(cursor) ; offset : CARD := CARD::build(cursor) ; if base = Base_Year then return val(offset) else -- need to do some arithmetic! if base > Base_Year then return val(offset - days_in_years(base)) else -- its less! loop count : CARD := (Base_Year - 1).downto!(year) ; if is_leap_year(count) then offset := offset + Days_in_Year + 1 else offset := offset + Days_in_Year end end ; return val(offset) end end end ; create( time_stamp : TIME_STAMP ) : SAME is -- This routine returns the date component of the given time_stamp return val(time_stamp.num_days) end ; from_days( days : CARD ) : SAME is -- This routine creates a new date which has the given number of days -- after the base date! See the inverse 'days' routine. return val(days) end ; today : SAME is -- This routine returns the current date as indicated by the computer -- system clock ; sys : OS_TIME := OS_TIME::time_stamp ; return val(sys.days) end ; is_eq( other : SAME ) : BOOL is -- This function returns true iff other and same represent the same -- date. return val = other.val end ; is_lt( other : SAME ) : BOOL is -- This function returns true iff self is earlier than other. return val < other.val end ; is_nil : BOOL is -- This function returns true iff self is the nil date. return val = CARD::nil end ; plus( num : ELAPSED ) : SAME is -- This returns the result of adding a number of days to the date. return val(val + num.days) end ; minus( num : ELAPSED ) : SAME is -- This returns the effect of subtracting a number of days from the date -- provided that this still yields a positive date! return val(val - num.days) end ; minus( other : SAME ) : ELAPSED is -- This returns the difference between self and other as an elapsed -- number of days. This is always positive irrespective of whether self -- is greater than other or not. if val < other.val then return ELAPSED::create(other.val - val, 0) -- NO milliseconds else return ELAPSED::create(val - other.val, 0) end end ; binstr : BINSTR pre true post val.binstr = result is -- This routine returns a binary string form representation of the date -- indicated by self. return Base_Year.binstr + val.binstr end ; -- The following group of routines are private auxiliaries -- used in determining some date component for use when -- providing some external representation of a date. private is_leap_year( yr : CARD ) : BOOL is -- This routine returns true iff the year value supplied is -- a leap year, otherwise false. if (yr.mod(Years_in_Century) = 0) then return (yr.mod(Years_in_Era * Leap_Cycle) = 0) else return (yr.mod(Leap_Cycle) = 0) end end ; private year_count( days : CARD, out days_left : CARD ) : CARD is -- This routine returns the number of years since the base year and sets -- days-left to be the number of days into the current year! loc_length : CARD := Days_in_Year ; -- 1900 was not a leap year loc_yr : CARD := Base_Year ; -- initialise loop! loc_days : CARD := days ; loop if is_leap_year(loc_yr) then loc_length := loc_length + 1 end ; if loc_days < loc_length then break! end ; loc_days := loc_days - loc_length ; loc_yr := loc_yr + 1 ; loc_length := Days_in_Year end ; days_left := loc_days ; return loc_yr - Base_Year end ; private find_month( days : CARD, -- from end of previous year. leap : BOOL, -- this year is a leap year out date : CARD -- in current month. ) : CARD is -- This routine returns the month in the year in the range 1 to 12 and -- sets date to be the date in that month. loc_month : CARD := 1 ; -- initialise loop! loc_length : CARD := Month_Max[loc_month] ; -- January loc_days : CARD := days ; loop if (loc_month = February) and leap then loc_length := loc_length + 1 end ; if loc_days < loc_length then break! end ; loc_days := loc_days - loc_length ; loc_month := loc_month + 1 ; loc_length := Month_Max[loc_month] end ; date := loc_days ; return loc_month end ; -- The following pairs of routines is provided for use when -- providing a value for formatting (with the parameter) and -- the property of self -- without parameter. year( days : CARD ) : CARD is -- This routine returns the whole number of years of the date -- represented by days since the beginning of the current era. dummy : CARD ; return year_count(days,out dummy) + Base_Year end ; year : CARD is -- This routine returns the number of years in self since the beginning -- of the current era. return year(val) end ; era( days : CARD ) : CARD is -- This routine returns the current century of the date represented by -- days in the current era. return year(days) / Years_in_Era end ; era : CARD is -- This routine returns the current century in the date represented by -- self in the current era. return era(val) end ; year_this_era( days : CARD ) : CARD is -- This routine returns the whole number of years in days in the current -- century, taking account of leap years. dummy : CARD ; return year_count(days,out dummy) % Years_in_Era end ; year_this_era : CARD is -- This routine returns the number of years in self since the beginning -- of the current century. return year_this_era(val) end ; day_in_year( days : CARD ) : CARD is -- This routine returns the number in the range 1 to 366 giving the -- day component of a Julian date for days. days_left : CARD ; loc_year : CARD := year_count(days,out days_left) ; return days_left end ; day_in_year : CARD is -- This routine returns the number in the range 1 to 366 giving the -- day component of a Julian date for self. return day_in_year(val) end ; week_in_year( days : CARD ) : CARD is -- This routine returns the number in the range 1 to 53 giving the -- day component of a Julian date for days. return day_in_year(days) / Days_in_Week end ; week_in_year : CARD is -- This routine returns the number in the range 1 to 53 giving the -- day component of a Julian date for self. return week_in_year(val) end ; month_number( days : CARD ) : CARD is -- This routine returns the month in the current year, counting the -- first month as 1. dummy : CARD ; days_left : CARD ; loc_year : CARD := year_count(days,out days_left) ; return find_month(days_left, is_leap_year(loc_year + Base_Year),out dummy) end ; month_number : CARD is -- This routine returns the number of the month in the current year -- in self. return month_number(val) end ; date( days : CARD ) : CARD is -- This routine returns the date in the current month represented by -- days. res : CARD ; days_left : CARD ; loc_year : CARD := year_count(days,out days_left) ; dummy : CARD := find_month(days_left, is_leap_year(loc_year + Base_Year), out res) ; return res end ; date : CARD is -- This routine returns the day in the current month represented by self. return date(val) end ; day_of_week( days : CARD ) : CARD is -- This routine returns the day of the week represented by days, Sunday -- being day zero. It makes use of the fact that the last day of 1899 -- happened to be a Sunday (ie day 0). return days % Days_in_Week end ; day_of_week : CARD is -- This routine returns the day of the week represented by self. return day_of_week(val) end ; weekday( days : CARD ) : WEEKDAYS is -- This routine returns the day of the week as enumerated value. The -- value 1 is added to the result of calling the numeric version of this -- routine because enumeration values do not include void (zero). return WEEKDAYS::create(day_of_week(days) + 1) end ; weekday : WEEKDAYS is -- This routine returns the day of the week represented by self as -- an enumerated value. return WEEKDAYS::create(day_of_week(val) + 1) end ; hash : CARD is -- This routine is provided to enable the establishment of date based -- queues/lists. return val.hash end ; end ; -- ERA_DATES