1#---------------------------------------------------------------------- 2# 3# gregorian.tcl -- 4# 5# Routines for manipulating dates on the Gregorian calendar. 6# 7# Copyright (c) 2002 by Kevin B. Kenny. All rights reserved. 8# 9# See the file "license.terms" for information on usage and redistribution 10# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11# 12# RCS: @(#) $Id: gregorian.tcl,v 1.5 2004/01/15 06:36:12 andreas_kupries Exp $ 13# 14#---------------------------------------------------------------------- 15 16package require Tcl 8.2; # Not tested with earlier releases 17 18#---------------------------------------------------------------------- 19# 20# Many of the routines in this file accept the name of a "date array" 21# in the caller's scope. This array is used to hold the various fields 22# of a civil date. While few if any routines use or set all the fields, 23# the fields, where used or set, are always interpreted the same way. 24# The complete listing of fields used is: 25# 26# ERA -- The era in the given calendar to which a year refers. 27# In the Julian and Gregorian calendars, the ERA is one 28# of the constants, BCE or CE (Before the Common Era, 29# or Common Era). The conventional names, BC and AD 30# are also accepted. In other local calendars, the ERA 31# may be some other value, for instance, the name of 32# an emperor, AH (anno Hegirae or anno Hebraica), AM 33# (anno mundi), etc. 34# 35# YEAR - The number of the year within the given era. 36# 37# FISCAL_YEAR - The year to which 'WEEK_OF_YEAR' (see below) 38# refers. Near the beginning or end of a given 39# calendar year, the fiscal week may be the first 40# week of the following year or the last week of the 41# preceding year. 42# 43# MONTH - The number of the month within the given year. Month 44# numbers run from 1 to 12 in the common calendar; some 45# local calendars include a thirteenth month in some years. 46# 47# WEEK_OF_YEAR - The week number in the given year. On the usual 48# fiscal calendar, the week may range from 1 to 53. 49# 50# DAY_OF_WEEK_IN_MONTH - The ordinal number of a weekday within 51# the given month. Used in conjunction 52# with DAY_OF_WEEK to express constructs like, 53# 'the fourth Thursday in November'. 54# Values run from 1 to the number of weeks in 55# the month. Negative values are interpreted 56# from the end of the month; allowing 57# for 'the last Sunday of October'; 'the 58# next-to-last Sunday of October', etc. 59# 60# DAY_OF_YEAR - The day of the given year. (The first day of a year 61# is day number 1.) 62# 63# DAY_OF_MONTH - The day of the given month. 64# 65# DAY_OF_WEEK - The number of the day of the week. Sunday = 0, 66# Monday = 1, ..., Saturday = 6. In locales where 67# a day other than Sunday is the first day of the week, 68# the values of the days before it are incremented by 69# seven; thus, in an ISO locale, Monday = 1, ..., 70# Sunday == 7. 71# 72# The following fields in a date array change the behavior of FISCAL_YEAR 73# and WEEK_OF_YEAR: 74# 75# DAYS_IN_FIRST_WEEK - The minimum number of days that a week must 76# have before it is accounted the first week 77# of a year. For the ISO fiscal calendar, this 78# number is 4. 79# 80# FIRST_DAY_OF_WEEK - The day of the week (Sunday = 0, ..., Saturday = 6) 81# on which a new fiscal year begins. Days greater 82# than 6 are reduced modulo 7. 83# 84#---------------------------------------------------------------------- 85 86#---------------------------------------------------------------------- 87# 88# The calendar::CommonCalendar namespace contains code for handling 89# dates on the 'common calendar' -- the civil calendar in virtually 90# the entire Western world. The common calendar is the Julian 91# calendar prior to a certain date that varies with the locale, and 92# the Gregorian calendar thereafter. 93# 94#---------------------------------------------------------------------- 95 96namespace eval ::calendar::CommonCalendar { 97 98 namespace export WeekdayOnOrBefore 99 namespace export CivilYearToAbsolute 100 101 # Number of days in the months in a common year and a leap year 102 103 variable daysInMonth [list 31 28 31 30 31 30 31 31 30 31 30 31] 104 variable daysInMonthInLeapYear [list 31 29 31 30 31 30 31 31 30 31 30 31] 105 106 # Number of days preceding the start of a given month in a leap year 107 # and common year. For convenience, these lists are zero based and 108 # contain a thirteenth month; [lindex $daysInPriorMonths 3], for instance 109 # gives the number of days preceding 1 March, and 110 # [lindex $daysInPriorMonths 13] gives the number of days in a common 111 # year. 112 113 variable daysInPriorMonths 114 variable daysInPriorMonthsInLeapYear 115 116 set dp 0 117 set dply 0 118 set daysInPriorMonths [list {} 0] 119 set daysInPriorMonthsInLeapYear [list {} 0] 120 foreach d $daysInMonth dly $daysInMonthInLeapYear { 121 lappend daysInPriorMonths [incr dp $d] 122 lappend daysInPriorMonthsInLeapYear [incr dply $dly] 123 } 124 unset d dly dp dply 125 126} 127 128#---------------------------------------------------------------------- 129# 130# ::calendar::CommonCalendar::WeekdayOnOrBefore -- 131# 132# Determine the last time that a given day of the week occurs 133# on or before a given date (e.g., Sunday on or before January 2). 134# 135# Parameters: 136# weekday -- Day of the week (Sunday = 0 .. Saturday = 6) 137# Days greater than 6 are interpreted modulo 7. 138# j -- Julian day number. 139# 140# Results: 141# Returns the Julian day number of the desired day. 142# 143# Side effects: 144# None. 145# 146#---------------------------------------------------------------------- 147 148proc ::calendar::CommonCalendar::WeekdayOnOrBefore { weekday j } { 149 # Normalize weekday, Monday=0 150 set k [expr { ($weekday + 6) % 7 }] 151 return [expr { $j - ( $j - $k ) % 7 }] 152} 153 154#---------------------------------------------------------------------- 155# 156# ::calendar::CommonCalendar::CivilYearToAbsolute -- 157# 158# Calculate an "absolute" year number, that is, the count of 159# years from the common epoch, 1 B.C.E. 160# 161# Parameters: 162# dateVar -- Name of an array in caller's scope containing the 163# fields ERA (BCE or CE) and YEAR. 164# 165# Results: 166# Returns an absolute year number. The years in the common era 167# have their natural numbers; the year 1 BCE returns 0, 2 BCE returns 168# -1, and so on. 169# 170# Side effects: 171# None. 172# 173# The popular names BC and AD are accepted as synonyms for BCE and CE. 174# 175#---------------------------------------------------------------------- 176 177proc ::calendar::CommonCalendar::CivilYearToAbsolute { dateVar } { 178 179 upvar 1 $dateVar date 180 switch -exact $date(ERA) { 181 BCE - BC { 182 return [expr { 1 - $date(YEAR) }] 183 } 184 CE - AD { 185 return $date(YEAR) 186 } 187 default { 188 return -code error "Unknown era \"$date(ERA)\"" 189 } 190 } 191} 192 193#---------------------------------------------------------------------- 194# 195# The calendar::GregorianCalendar namespace contains codes specific to the 196# Gregorian calendar. These codes deal specifically with dates after 197# the conversion from the Julian to Gregorian calendars (which are 198# various dates in various locales; 1582 in most Catholic countries, 199# 1752 in most English-speaking countries, 1917 in Russia, ...). 200# If presented with earlier dates, these codes will compute based on 201# a hypothetical proleptic calendar. 202# 203#---------------------------------------------------------------------- 204 205namespace eval calendar::GregorianCalendar { 206 207 namespace import ::calendar::CommonCalendar::WeekdayOnOrBefore 208 namespace import ::calendar::CommonCalendar::CivilYearToAbsolute 209 210 namespace export IsLeapYear 211 212 namespace export EYMDToJulianDay 213 namespace export EYDToJulianDay 214 namespace export EFYWDToJulianDay 215 namespace export EYMWDToJulianDay 216 217 namespace export JulianDayToEYD 218 namespace export JulianDayToEYMD 219 namespace export JulianDayToEFYWD 220 namespace export JulianDayToEYMWD 221 222 # The Gregorian epoch -- 31 December, 1 B.C.E, Gregorian, expressed 223 # as a Julian day number. (This date is 2 January, 1 C.E., in the 224 # proleptic Julian calendar.) 225 226 variable epoch 1721425 227 228 # Common years - these years, mod 400, are the irregular common years 229 # of the Gregorian calendar 230 231 variable commonYears 232 array set commonYears { 100 {} 200 {} 300 {} } 233 234} 235 236#---------------------------------------------------------------------- 237# 238# ::calendar::GregorianCalendar::IsLeapYear 239# 240# Tests whether a year is a leap year. 241# 242# Parameters: 243# 244# y - Year number of the common era. The year 0 represents 245# 1 BCE of the proleptic calendar, -1 represents 2 BCE, etc. 246# 247# Results: 248# 249# Returns 1 if the given year is a leap year, 0 otherwise. 250# 251# Side effects: 252# 253# None. 254# 255#---------------------------------------------------------------------- 256 257proc ::calendar::GregorianCalendar::IsLeapYear { y } { 258 259 variable commonYears 260 return [expr { ( $y % 4 ) == 0 261 && ![info exists commonYears([expr { $y % 400 }])] }] 262 263} 264 265#---------------------------------------------------------------------- 266# 267# ::calendar::GregorianCalendar::EYMDToJulianDay 268# 269# Convert a date on the Gregorian calendar expressed as 270# era (BCE or CE), year in the era, month number (January = 1) 271# and day of the month to a Julian Day Number. 272# 273# Parameters: 274# 275# dateArray -- Name of an array in caller's scope containing 276# keys ERA, YEAR, MONTH, and DAY_OF_MONTH 277# 278# Results: 279# 280# Returns the Julian Day Number of the day that starts with 281# noon of the given date. 282# 283# Side effects: 284# 285# None. 286# 287#---------------------------------------------------------------------- 288 289proc ::calendar::GregorianCalendar::EYMDToJulianDay { dateArray } { 290 291 upvar 1 $dateArray date 292 293 variable epoch 294 variable ::calendar::CommonCalendar::daysInPriorMonths 295 variable ::calendar::CommonCalendar::daysInPriorMonthsInLeapYear 296 297 # Convert era and year to an absolute year number 298 299 set y [calendar::CommonCalendar::CivilYearToAbsolute date] 300 set ym1 [expr { $y - 1 }] 301 302 # Calculate the Julian day 303 304 return [expr { $epoch 305 + $date(DAY_OF_MONTH) 306 + ( [IsLeapYear $y] ? 307 [lindex $daysInPriorMonthsInLeapYear $date(MONTH)] 308 : [lindex $daysInPriorMonths $date(MONTH)] ) 309 + ( 365 * $ym1 ) 310 + ( $ym1 / 4 ) 311 - ( $ym1 / 100 ) 312 + ( $ym1 / 400 ) }] 313 314} 315 316#---------------------------------------------------------------------- 317# 318# ::calendar::GregorianCalendar::EYDToJulianDay -- 319# 320# Convert a date expressed in the Gregorian calendar as era (BCE or CE), 321# year, and day-of-year to a Julian Day Number. 322# 323# Parameters: 324# 325# dateArray -- Name of an array in caller's scope containing 326# keys ERA, YEAR, and DAY_OF_YEAR 327# 328# Results: 329# 330# Returns the Julian Day Number corresponding to noon of the given 331# day. 332# 333# Side effects: 334# 335# None. 336# 337#---------------------------------------------------------------------- 338 339proc ::calendar::GregorianCalendar::EYDToJulianDay { dateArray } { 340 341 upvar 1 $dateArray date 342 variable epoch 343 344 set y [CivilYearToAbsolute date] 345 set ym1 [expr { $y - 1 }] 346 347 return [expr { $epoch 348 + $date(DAY_OF_YEAR) 349 + ( 365 * $ym1 ) 350 + ( $ym1 / 4 ) 351 - ( $ym1 / 100 ) 352 + ( $ym1 / 400 ) }] 353 354} 355 356#---------------------------------------------------------------------- 357# 358# ::calendar::GregorianCalendar::EFYWDToJulianDay -- 359# 360# Convert a date expressed in the system of era, fiscal year, 361# week number and day number to a Julian Day Number. 362# 363# Parameters: 364# 365# dateArray -- Name of an array in caller's scope that contains 366# keys ERA, FISCAL_YEAR, WEEK_OF_YEAR, and DAY_OF_WEEK, 367# and optionally contains DAYS_IN_FIRST_WEEK 368# and FIRST_DAY_OF_WEEK. 369# daysInFirstWeek -- Minimum number of days that a week must 370# have to be considered the first week of a 371# fiscal year. Default is 4, which gives 372# ISO8601:1988 semantics. The parameter is 373# used only if the 'dateArray' does not 374# contain a DAYS_IN_FIRST_WEEK key. 375# firstDayOfWeek -- Ordinal number of the first day of the week 376# (Sunday = 0, Monday = 1, etc.) Default is 377# 1, which gives ISO8601:1988 semantics. The 378# parameter is used only if 'dateArray' does not 379# contain a DAYS_IN_FIRST_WEEK key.n 380# 381# Results: 382# 383# Returns the Julian Calendar Day corresponding to noon of the given 384# day. 385# 386# Side effects: 387# 388# None. 389# 390# The ERA element of the array is BCE or CE. 391# The FISCAL_YEAR is the year number in the given era. The year is relative 392# to the fiscal week; hence days that are early in January or late in 393# December may belong to a different year than the calendar year. 394# The WEEK_OF_YEAR is the ordinal number of the week within the year. 395# Week 1 is the week beginning on the specified FIRST_DAY_OF_WEEK 396# (Sunday = 0, Monday = 1, etc.) and containing at least DAYS_IN_FIRST_WEEK 397# days (or, equivalently, containing January DAYS_IN_FIRST_WEEK) 398# The DAY_OF_WEEK is Sunday=0, Monday=1, ..., if FIRST_DAY_OF_WEEK 399# is 0, or Monday=1, Tuesday=2, ..., Sunday=7 if FIRST_DAY_OF_WEEK 400# is 1. 401# 402#---------------------------------------------------------------------- 403 404proc ::calendar::GregorianCalendar::EFYWDToJulianDay { dateArray 405 {daysInFirstWeek 4} 406 {firstDayOfWeek 1} } { 407 upvar 1 $dateArray date 408 409 # Use parameters to supply defaults if the array doesn't 410 # have conversion rules. 411 412 if { ![info exists date(DAYS_IN_FIRST_WEEK)] } { 413 set date(DAYS_IN_FIRST_WEEK) $daysInFirstWeek 414 } 415 if { ![info exists date(FIRST_DAY_OF_WEEK)] } { 416 set date(FIRST_DAY_OF_WEEK) $firstDayOfWeek 417 } 418 419 # Find the start of the fiscal year 420 421 set date2(ERA) $date(ERA) 422 set date2(YEAR) $date(FISCAL_YEAR) 423 set date2(MONTH) 1 424 set date2(DAY_OF_MONTH) $date(DAYS_IN_FIRST_WEEK) 425 set jd [WeekdayOnOrBefore \ 426 $date(FIRST_DAY_OF_WEEK) \ 427 [EYMDToJulianDay date2]] 428 429 # Add the weeks and days. 430 431 return [expr { $jd 432 + ( 7 * ( $date(WEEK_OF_YEAR) - 1 ) ) 433 + $date(DAY_OF_WEEK) - $date(FIRST_DAY_OF_WEEK) }] 434 435} 436 437#---------------------------------------------------------------------- 438# 439# ::calendar::GregorianCalendar::EYMWDToJulianDay -- 440# 441# Given era, year, month, and day of week in month (e.g. "first Tuesday") 442# derive a Julian day number. 443# 444# Parameters: 445# dateVar -- Name of an array in caller's scope containing the 446# date fields. 447# 448# Results: 449# Returns the desired Julian day number. 450# 451# Side effects: 452# None. 453# 454# The 'dateVar' array is expected to contain the following keys: 455# + ERA - The constant 'BCE' or 'CE'. 456# + YEAR - The Gregorian calendar year 457# + MONTH - The month of the year (1 = January .. 12 = December) 458# + DAY_OF_WEEK - The day of the week (Sunday = 0 .. Saturday = 6) 459# If day of week is 7 or greater, it is interpreted 460# modulo 7. 461# + DAY_OF_WEEK_IN_MONTH - The day of week within the month 462# (1 = first XXXday, 2 = second XXDday, ... 463# also -1 = last XXXday, -2 = next-to-last 464# XXXday, ...) 465# 466#---------------------------------------------------------------------- 467 468proc ::calendar::GregorianCalendar::EYMWDToJulianDay { dateVar } { 469 470 upvar 1 $dateVar date 471 472 variable epoch 473 474 # Are we counting from the beginning or the end of the month? 475 476 array set date2 [array get date] 477 if { $date(DAY_OF_WEEK_IN_MONTH) >= 0 } { 478 479 # When counting from the start of the month, begin by 480 # finding the 'zeroeth' - the last day of the prior month. 481 # Note that it's ok to give EYMDToJulianDay a zero day-of-month! 482 483 set date2(DAY_OF_MONTH) 0 484 485 } else { 486 487 # When counting from the end of the month, the 'zeroeth' 488 # is the seventh of the following month. Note that it's ok 489 # to give EYMDToJulianDay a thirteenth month! 490 491 incr date2(MONTH) 492 set date2(DAY_OF_MONTH) 7 493 494 } 495 496 set zeroethDayOfMonth [EYMDToJulianDay date2] 497 498 # Find the zeroeth weekday in the given month 499 500 set wd0 [WeekdayOnOrBefore $date(DAY_OF_WEEK) $zeroethDayOfMonth] 501 502 # Add the requisite number of weeks 503 504 return [expr { $wd0 + 7 * $date(DAY_OF_WEEK_IN_MONTH) }] 505 506} 507 508#---------------------------------------------------------------------- 509# 510# ::calendar::GregorianCalendar::JulianDayToEYD -- 511# 512# Given a Julian day number, compute era, year, and day of year. 513# 514# Parameters: 515# j - Julian day number 516# dateVar - Name of an array in caller's scope that will receive the 517# date fields. 518# 519# Results: 520# Returns an absolute year; that is, returns the year number for 521# years in the Common Era; returns 0 for 1 B.C.E., -1 for 2 B.C.E., 522# and so on. 523# 524# Side effects: 525# The 'dateVar' array is populated with the following: 526# + ERA - The era corresponding to the given Julian Day. 527# (BCE or CE) 528# + YEAR - The year of the given era. 529# + DAY_OF_YEAR - The day within the given year (1 = 1 January, 530# etc.) 531# 532#---------------------------------------------------------------------- 533 534proc ::calendar::GregorianCalendar::JulianDayToEYD { j dateVar } { 535 536 upvar 1 $dateVar date 537 538 variable epoch 539 540 # Absolute day number relative to the Gregorian epoch 541 542 set day [expr { $j - $epoch - 1}] 543 544 # Count 400-year cycles 545 546 set year 1 547 set n [expr { $day / 146097 }] 548 incr year [expr { 400 * $n }] 549 set day [expr { $day % 146097 }] 550 551 # Count centuries 552 553 set n [expr { $day / 36524 }] 554 set day [expr { $day % 36524 }] 555 if { $n > 3 } { # Last day of 1600, 2000, 2400... 556 set n 3 557 incr day 36524 558 } 559 incr year [expr { 100 * $n }] 560 561 # Count 4-year cycles 562 563 set n [expr { $day / 1461 }] 564 set day [expr { $day % 1461 }] 565 incr year [expr { 4 * $n }] 566 567 # Count years 568 569 set n [expr { $day / 365 }] 570 set day [expr { $day % 365 }] 571 if { $n > 3 } { # December 31 of a leap year 572 set n 3 573 incr day 365 574 } 575 incr year $n 576 577 # Determine the era 578 579 if { $year <= 0 } { 580 set date(YEAR) [expr { 1 - $year }] 581 set date(ERA) BCE 582 } else { 583 set date(YEAR) $year 584 set date(ERA) CE 585 } 586 587 # Determine day of year. 588 589 set date(DAY_OF_YEAR) [expr { $day + 1 }] 590 return $year 591 592} 593 594#---------------------------------------------------------------------- 595# 596# ::calendar::GregorianCalendar::JulianDayToEYMD -- 597# 598# Given a Julian day number, compute era, year, month, and day 599# of the Gregorian calendar. 600# 601# Parameters: 602# j - Julian day number 603# dateVar - Name of a variable in caller's scope that will be 604# filled in with the fields, ERA, YEAR, MONTH, DAY_OF_MONTH, 605# and DAY_OF_YEAR (this last comes as a side effect of how 606# the calculations are performed, but is trustworthy). 607# 608# Results: 609# None. 610# 611# Side effects: 612# Requested fields of dateVar are filled in. 613# 614#---------------------------------------------------------------------- 615 616proc ::calendar::GregorianCalendar::JulianDayToEYMD { j dateVar } { 617 618 upvar 1 $dateVar date 619 620 variable ::calendar::CommonCalendar::daysInMonth 621 variable ::calendar::CommonCalendar::daysInMonthInLeapYear 622 623 set year [JulianDayToEYD $j date] 624 set day $date(DAY_OF_YEAR) 625 626 if { [IsLeapYear $year] } { 627 set hath $daysInMonthInLeapYear 628 } else { 629 set hath $daysInMonth 630 } 631 set month 1 632 foreach n $hath { 633 if { $day <= $n } { 634 break 635 } 636 incr month 637 set day [expr { $day - $n }] 638 } 639 set date(MONTH) $month 640 set date(DAY_OF_MONTH) $day 641 642 return 643 644} 645 646#---------------------------------------------------------------------- 647# 648# ::calendar::GregorianCalendar::JulianDayToEFYWD -- 649# 650# Given a julian day number, compute era, fiscal year, fiscal week, 651# and day of week in a fiscal calendar based on the Gregorian calendar. 652# 653# Parameters: 654# j - Julian day number 655# dateVar - Name of an array in caller's scope that is to receive the 656# fields of the date. The array may be prepared with 657# DAYS_IN_FIRST_WEEK and FIRST_DAY_OF_WEEK fields to 658# change the rule for computing the fiscal week. 659# daysInFirstWeek - (Optional) Parameter giving the minimum number 660# of days in the first week of a year. Default is 4. 661# firstDayOfWeek - (Optional) Parameter giving the day number of the 662# first day of a fiscal week (Sunday = 0 .. 663# Saturday = 6). Default is 1 (Monday). 664# 665# Results: 666# None. 667# 668# Side effects: 669# The ERA, YEAR, FISCAL_YEAR, DAY_OF_YEAR, WEEK_OF_YEAR, DAY_OF_WEEK, 670# DAYS_IN_FIRST_WEEK, and FIRST_DAY_OF_WEEK fields in the 'dateVar' 671# array are filled in. 672# 673# If DAYS_IN_FIRST_WEEK or FIRST_DAY_OF_WEEK fields are present in 674# 'dateVar' prior to the call, they override any values passed on the 675# command line. 676# 677#---------------------------------------------------------------------- 678 679proc ::calendar::GregorianCalendar::JulianDayToEFYWD { j 680 dateVar 681 {daysInFirstWeek 4} 682 {firstDayOfWeek 1} } { 683 upvar 1 $dateVar date 684 685 if { ![info exists date(DAYS_IN_FIRST_WEEK)] } { 686 set date(DAYS_IN_FIRST_WEEK) $daysInFirstWeek 687 } 688 if { ![info exists date(FIRST_DAY_OF_WEEK)] } { 689 set date(FIRST_DAY_OF_WEEK) $firstDayOfWeek 690 } 691 692 # Determine the calendar year of $j - $daysInFirstWeek + 1. 693 # Guess the fiscal year 694 695 JulianDayToEYD [expr { $j - $daysInFirstWeek + 1 }] date1 696 set date1(FISCAL_YEAR) [expr { $date1(YEAR) + 1 }] 697 698 # Determine the start of the fiscal year that we guessed 699 700 set date1(WEEK_OF_YEAR) 1 701 set date1(DAY_OF_WEEK) $firstDayOfWeek 702 set startOfFiscalYear [EFYWDToJulianDay \ 703 date1 \ 704 $date(DAYS_IN_FIRST_WEEK) \ 705 $date(FIRST_DAY_OF_WEEK)] 706 707 # If we guessed high, fix it. 708 709 if { $j < $startOfFiscalYear } { 710 incr date1(FISCAL_YEAR) -1 711 set startOfFiscalYear [EFYWDToJulianDay date1] 712 } 713 714 set date(FISCAL_YEAR) $date1(FISCAL_YEAR) 715 716 # Get the week number and the day within the week 717 718 set dayOfFiscalYear [expr { $j - $startOfFiscalYear }] 719 set date(WEEK_OF_YEAR) [expr { ( $dayOfFiscalYear / 7 ) + 1 }] 720 set date(DAY_OF_WEEK) [expr { ( $dayOfFiscalYear + 1 ) % 7 }] 721 if { $date(DAY_OF_WEEK) < $date(FIRST_DAY_OF_WEEK) } { 722 incr date(DAY_OF_WEEK) 7 723 } 724 725 return 726} 727 728#---------------------------------------------------------------------- 729# 730# GregorianCalendar::JulianDayToEYMWD -- 731# 732# Convert a Julian day number to year, month, day-of-week-in-month 733# (e.g., first Tuesday), and day of week. 734# 735# Parameters: 736# j - Julian day number 737# dateVar - Name of an array in caller's scope that holds the 738# fields of the date. 739# 740# Results: 741# None. 742# 743# Side effects: 744# The ERA, YEAR, MONTH, DAY_OF_MONTH, DAY_OF_WEEK, and 745# DAY_OF_WEEK_IN_MONTH fields of the given date are all filled 746# in. 747# 748# Notes: 749# DAY_OF_WEEK_IN_MONTH is always positive on return. 750# 751#---------------------------------------------------------------------- 752 753proc ::calendar::GregorianCalendar::JulianDayToEYMWD { j dateVar } { 754 755 upvar 1 $dateVar date 756 757 # Compute era, year, month and day 758 759 JulianDayToEYMD $j date 760 761 # Find day of week 762 763 set date(DAY_OF_WEEK) [expr { ( $j + 1 ) % 7 }] 764 765 # Find day of week in month 766 767 set date(DAY_OF_WEEK_IN_MONTH) \ 768 [expr { ( ( $date(DAY_OF_MONTH) - 1 ) / 7) + 1 }] 769 770 return 771 772} 773