• Another example -- discover next blue moon

Suppose your boss comes into your office/cubicle and asks:

When's the next

blue moon ?

You look at her like she has two heads.

She says it's not her idea.

The brass is developing a major new product and wants to initiate a massive marketing campaign on the day of the next blue moon.

You might proceed by digging into calendars of the next few years.

Blue moons typically occur approximately every three years, BUT there is no predictable pattern.

There was a lengthy gap between blue moons which occurred on 8/31/1993 and 1/31/1999.

• Blue moon genie !

The blueMoonGenie.rooProgram comes to the rescue.
It computes the next blue moon from the current date.
It cycles through all of the dates of full moons which follow Jan 1, 2000.
It stops when it encounters a full moon date which exceeds today's date, provided that the full moon date also occurs on the 30th or 31st day of a month.
The duration between full moons is 29.53059 days (synodic period).
Blue moons rarely occur on the 30th day of the month, but 11/30/2001 was a blue moon.

blueMoonGenie.rooProgram

-- blueMoonGenie.rooProgram
-- discovers next blue moon

-- uses 'fullMoon_ice.rooProgram' to determine
-- the date of the Nth full moon after Jan 1, 2000

arg noteType   -- get type of 'note' to display

-- get today's base date

baseDateToday = date( 'Base' )

-- establish 'date' class instance (see date.roo)

nthDate = ^^ date

-- iterate until the next blue moon is discovered

do N=1

  call charout !, '.'      -- let user know program is progressing

  -- get the base date of the Nth full moon
  -- after January 1, 2000

  baseDateOfFullMoonN = fullMoon_ice( N )

  -- analyze full moon with base date
  -- greater than or equal to today's base date

  if baseDateOfFullMoonN >= baseDateToday then do

    -- set date associated with 'date' class instance
    
    nthDate ~ setDate( baseDateOfFullMoonN  )

    -- if the day of the month is greater than 29
    -- then it's a blue moon !
  
    if 29 <  word( nthDate ~ getDate( 'Normal' ), 1 ) then do

      call lineout !, ''

      blueMoonText = nthDate ~ getDate( 'Weekday' )',' nthDate ~ toString

      select 
        when noteType = 'NOTE' then
          ! 'start vuhtml "{The next blue moon is:' blueMoonText'}" note.htm'

        when noteType = 'MARQUEE' then
          ! 'showNote' '"The next blue moon is:' blueMoonText'"'

        otherwise 
          say 'The next blue moon is:' blueMoonText

        end 

      leave 

      end 

    end 

  end 

exit 0

• Supporting 'date' class

The blueMoonGenie program uses the following date class.
It provides funcionality similar to the date built-in function, but for a specific base date, or a specific month, day, and year.

date.roo

-- date.roo
-- date class

-- provides functionality similar to the <b>date</b> built-in function,
-- for a specific base date,
-- or for a specific month, day, and year.

shared _baseDate _Mmm _monthName _mm _dd _yy _yyyy _julianDay _dayOfWeek

shared _quadYearDays _centuryDays _quadCenturyDays _daysInMonth _monthOffset _monthOffsetLeap

-- initialization method
-- usage:
--   dateRef = ^^ date( 731306 ) -- establishes information for a specific base date -- Wed,  2 Apr 2003
-- or:
--   dateRef = ^^ date( 4 2 2003 ) -- establishes information for a specific month day and year

-- then, you can get date information as follows:
--   say dateRef ~ getDate( [dateFormat] )
-- where the dateFormat is the same as the parameter of the date built-in function

-- the following shows how to establish a date instance for a day which is two weeks from today
--   dateRef = ^^ date( date( 'B' ) + 2 * 7 ) -- establishes information for the day that is two weeks from today


initialize  :  method

  _quadYearDays    = 1461     -- 4 * 365 + 1

  _centuryDays     = 36524    -- 25 * _quadYearDays - 1

  _quadCenturyDays = 146097   -- 4 * _centuryDays + 1

  _daysInMonth     = { 31, 28, 31, 30, 31,  30,  31,  31,  30,  31,  30,  31 }

  _monthOffset     = { 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 }

  _monthOffsetLeap = { 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335 }

  return ^ setDate( arg( 1 ) )

toString  :  method
  return ^ getDate

getDate  :  method

  parse upper arg ch +1

  select 
    when words( arg( 1 ) ) > 1 then
      call raiseObjection 'Only 1 argument value is expected. The argument is:' arg( 1 )

    when left( ch'N', 1 ) = 'N' then     -- Normal (default)
      return ( 0 + _dd ) _Mmm _yyyy

    when ch = 'B' then                   -- Base
      return _baseDate

    when ch = 'D' then                   -- Day
      return _julianDay

    when ch = 'E' then                   -- European
      return _dd'/'_mm'/'_yy

    when ch = 'M' then                   -- Month
      return _monthName

    when ch = 'O' then                   -- Ordered
      return _yy'/'_mm'/'_dd

    when ch = 'S' then                   -- Standard
      return _yyyy || _mm || _dd

    when ch = 'U' then                   -- USA
      return _mm'/'_dd'/'_yy

    when ch = 'W' then                   -- Weekday
      return _dayOfWeek

    otherwise 
      call raiseObjection 'Unrecognized argument value. The argument is:' arg( 1 )
  end 

setDate  :  method

  select 

    when arg( 1 ) = '' then
      _baseDate = date( 'Base' )

    when words( arg( 1 ) ) = 1 then do

      dateNumber = arg( 1 )

      if \ datatype( dateNumber, 'WholeNumber' ) then
        return 'Base day must be a positive whole number. The erroneous value is:' dateNumber

      if dateNumber < 1 then
        return 'Base day must be a positive whole number. The erroneous value is:' dateNumber

      _baseDate = dateNumber

      end 

    when words( arg( 1 ) ) = 3 then do
      parse arg month day year

      if \ validMonthAndDay( month, day, year ) then
        return 'Invalid day of month. Expected argument format: mm dd yyyy. The erroneous value is:' arg( 1 )

      if \ validYear( year ) then
        return 'Invalid year. Expected argument format: mm dd yyyy. The erroneous value is:' arg( 1 )

      _baseDate = computeBaseDate( month day year )

      end 

    otherwise 
      return 'Invalid argument. Expected argument format: baseDay# | mm dd yyyy. The erroneous value is:' arg( 1 )
    
    end 

  call computeOtherDateValues
 
  return ''

-- COMPUTEOTHERDATEVALUES procedure
-- computes other date values from base date

computeOtherDateValues  :  procedure

  -- compute: _Mmm _monthName _mm _dd _yy _yyyyy _julianDay _dayOfWeek

  todaysDate = _baseDate

  nQuadCenturies = trunc( todaysDate / _quadCenturyDays )

  todaysDate = todaysDate - nQuadCenturies * _quadCenturyDays

  nCenturies = trunc( todaysDate / _centuryDays )

  if nCenturies = 4 then
    nCenturies = 3

  todaysDate = todaysDate - nCenturies * _centuryDays

  nQuadYears = trunc( todaysDate / _quadYearDays )

  todaysDate = todaysDate - nQuadYears * _quadYearDays

  nYears = trunc( todaysDate / 365 )

  if nYears = 4 then
    nYears = 3

  todaysDate = todaysDate - nYears * 365

  _yyyy = nYears ,
        + 4 * nQuadYears ,
        + 100 * nCenturies ,
        + 400 * nQuadCenturies ,
        + 1

  _yy = right( _yyyy, 2, '0' )

  _julianDay = 0

  isLeapYear = leap( _yyyy )

  do i=1 to 12
    
    monthOffset = _monthOffset[ i ] + ( isLeapYear * ( i > 2 ) )

    if todaysDate < monthOffset then
      leave 

    _mm = i
    
    _julianDay = monthOffset

    end 

  _mm = right( _mm, 2, '0' )

  _dd = todaysDate - ( _monthOffset[ _mm ] + ( isLeapYear * ( _mm > 2 ) ) ) + 1
  
  _julianDay = _julianDay + _dd

  _dd = right( _dd, 2, '0' )

  _Mmm = word( 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec', _mm )

  _monthName = word( 'January February March April May June July August September October November December', _mm )

  _dayOfWeek = word( "Monday Tuesday Wednesday Thursday Friday Saturday Sunday", 1 + ( _baseDate // 7 ) )

  return 

-- COMPUTEBASEDATE procedure
-- computes base date for a specific month day year

computeBaseDate  :  procedure
  
  parse arg month day year

  thisYear        = year - 1                         -- 0-origin

  nQuadCenturies  = trunc( thisYear / 400 )

  thisYear        = thisYear - 400 * nQuadCenturies

  nCenturies      = trunc( thisYear / 100 )

  thisYear        = thisYear - 100 * nCenturies

  nQuadYears      = trunc( thisYear / 4 )

  thisYear        = thisYear - 4 * nQuadYears

  yearOffset      = nQuadCenturies * _quadCenturyDays ,
                  + nCenturies * _centuryDays ,
                  + nQuadYears * _quadYearDays ,
                  + thisYear * 365

  if leap( year ) then
      return yearOffset + _monthOffsetLeap[ month ] + day - 1

  return yearOffset + _monthOffset[ month ] + day - 1

-- LEAP procedure
-- identify if this year is a leap year (the year 2000 is not a leap year)

leap  :  procedure
  arg yr

  return (yr//4 = 0) & ((yr//100 <> 0) | (yr//400 = 0))   -- after Pope Gregory

-- RANGE procedure
-- validates range of argument

range  :  procedure
  parse arg n, lo, hi
  return n >= lo & n <= hi

-- VALIDMONTHANDDAY procedure
-- ensures month and day are valid

validMonthAndDay  :  procedure
  parse arg month, day, year

  if \ datatype( month, 'WholeNumber' ) then
    return 0

  if \ range( month, 1, 12 ) then
    return 0

  if \ datatype( day, 'WholeNumber' ) then
    return 0

  daysInThisMonth = _daysInMonth[ month ]

  if leap( year ) & ( month = 2 ) then      -- identify if this is a leap month
    daysInThisMonth = daysInThisMonth + 1   -- february has 29 days in a leap year

  if \ range( day, 1, daysInThisMonth ) then
    return 0

  return 1

-- VALIDYEAR procedure
-- ensures year is between 1 and 9999 inclusive

validYear  :  procedure
  year = arg( 1 )

  if \ datatype( year, 'WholeNumber' ) then
    return 0

  if \ range( year, 1, 9999 ) then
    return 0

  return 1

• Full moon computation program

Various roo!™ solutions are implemented as '_ice' files to comply with copyright requirements of the algorithm's authors.
The program that computes the Nth full moon after Jan 1, 2000 is provided as an '_ice' file because the author does not allow the algorithm to be distributed in source form.
roo!™ '_ice' files are created by using the chill facility.
Here is a synopsis of the fullMoon_ice program.

fullMoon_ice.rooProgram

external procedure, computes base date of Nth full moon after Jan 1, 2000

Usage:
fullMoonBaseDate = fullMoon_ice( N ) -- where: N is a positive whole number