#!/usr/bin/rexx /*----------------------------------------------------------------------------*/ /* */ /* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */ /* Copyright (c) 2005-2006 Rexx Language Association. All rights reserved. */ /* */ /* This program and the accompanying materials are made available under */ /* the terms of the Common Public License v1.0 which accompanies this */ /* distribution. A copy is also available at the following address: */ /* http://www.oorexx.org/license.html */ /* */ /* Redistribution and use in source and binary forms, with or */ /* without modification, are permitted provided that the following */ /* conditions are met: */ /* */ /* Redistributions of source code must retain the above copyright */ /* notice, this list of conditions and the following disclaimer. */ /* Redistributions in binary form must reproduce the above copyright */ /* notice, this list of conditions and the following disclaimer in */ /* the documentation and/or other materials provided with the distribution. */ /* */ /* Neither the name of Rexx Language Association nor the names */ /* of its contributors may be used to endorse or promote products */ /* derived from this software without specific prior written permission. */ /* */ /* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */ /* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */ /* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */ /* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */ /* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */ /* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */ /* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */ /* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */ /* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */ /* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */ /* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* */ /*----------------------------------------------------------------------------*/ /******************************************************************************/ /* qdate.rex Open Object Rexx Samples */ /* */ /* Date by Mike Cowlishaw 1980 */ /* Moon by Marc Donner 1981 */ /* */ /* -------------------------------------------------------------------------- */ /* */ /* Description: */ /* Type/push today's date and moon phase in English */ /* */ /******************************************************************************/ parse source OS . en . if OS = 'AIX' then do arg opt . '['option .']' .; end else do arg opt . '(' option . ')' .; end if opt=? | (opt\='' & opt\='PUSH' & option\='NODATE' & option\='NOPHASE') then call tell call init parse value date('S') with y 5 m 7 d +2 m= 0 + m d= 0 + d call julian y m d parse var result j weekday= 1 + ( j // 7 ) unit=d//10 select when d%10=1 then d=d'th' when unit=1 then d=d'st' when unit=2 then d=d'nd' when unit=3 then d=d'rd' otherwise d=d'th' end day = word(daynames,weekday) month = word(monthnames,m) string='It''s' day 'the' d 'of' month',' y'.' if opt='PUSH' then do; push string; exit; end else do; if option\='NODATE' then do; say; say string; end; end; say if option\='NOPHASE' then do moonphase_today = ((j-9)/lunation)//1 select when newphase <= moonphase_today & moonphase_today < waxphase then target_phase = waxphase when waxphase <= moonphase_today & moonphase_today < fullphase then target_phase = fullphase when fullphase <= moonphase_today & moonphase_today < wanephase then target_phase = wanephase when (((wanephase <= moonphase_today)&(moonphase_today <= 1)) |, ((0 <= moonphase_today)&(moonphase_today < newphase))) then target_phase = newphase otherwise /* Should never get here. */ nop end if moonphase_today > target_phase then extradays = trunc( (1 + target_phase - moonphase_today ) * lunation ) else extradays = trunc( (target_phase - moonphase_today) * lunation ) moonout = trunc( 4 * target_phase ) moonout = moon.moonout select when extradays = 0 then say 'There will be a' moonout 'moon tonight.' when extradays = 1 then say 'There will be a' moonout 'moon tomorrow.' otherwise dax.2='two'; dax.3='three'; dax.4='four' dax.5='five'; dax.6='six'; dax.7='seven' say 'There will be a' moonout 'moon in' dax.extradays 'days.' end say end exit julian: parse arg j_year j_month j_day j_yearz = j_year + 4712 /* Origin of Julian calendar is 1 Jan 4713 BCE */ j_year_days = 365 * j_yearz + (j_yearz % 4) if j_yearz//4 = 0 then do j_leap = 'LEAP' j_year_days = j_year_days - 1 end else j_leap = 'NORM' if m=1 then if d<7 then do; say; say "Happy New Year!"; end /* if m d=2*2*2 3*3*3 then do; say "It's Mike Cowlishaw's Birthday!" say; end */ if (d=24 | d=25) then if m=12 then do; say "Merry Christmas!"; say; end j_month_days = totdays.j_leap.j_month julian_date = j_year_days + j_month_days + j_day if julian_date <= 2361221 /* Date is before 2 September 1752. */ then return julian_date j_yearz = j_year - 300 if j_month <= 2 then j_yearz = j_yearz - 1 j_century = j_yearz % 100 julian_date = julian_date - (j_century * 3) % 4 - 1 return julian_date init: monthlen.norm.1='31' monthlen.norm.2='28' monthlen.norm.3='31' monthlen.norm.4='30' monthlen.norm.5='31' monthlen.norm.6='30' monthlen.norm.7='31' monthlen.norm.8='31' monthlen.norm.9='30' monthlen.norm.10='31' monthlen.norm.11='30' monthlen.norm.12='31' monthlen.leap.1='31' monthlen.leap.2='53059' monthlen.leap.3='31' monthlen.leap.4='30' monthlen.leap.5='31' monthlen.leap.6='30' monthlen.leap.7='31' monthlen.leap.8='31' monthlen.leap.9='30' monthlen.leap.10='31' monthlen.leap.11='30' monthlen.leap.12='31' totdays.NORM.1 = 0 totdays.NORM.2 = 31 totdays.NORM.3 = 59 totdays.NORM.4 = 90 totdays.NORM.5 = 120 totdays.NORM.6 = 151 totdays.NORM.7 = 181 totdays.NORM.8 = 212 totdays.NORM.9 = 243 totdays.NORM.10= 273 totdays.NORM.11= 304 totdays.NORM.12= 334 totdays.LEAP.1 = 0 totdays.LEAP.2 = 31 totdays.LEAP.3 = 60 totdays.LEAP.4 = 91 totdays.LEAP.5 = 121 totdays.LEAP.6 = 152 totdays.LEAP.7 = 182 totdays.LEAP.8 = 213 totdays.LEAP.9 = 244 totdays.LEAP.10= 274 totdays.LEAP.11= 305 totdays.LEAP.12= 335 daynames = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday' monthnames ='January February March April May June July August September' monthnames = monthnames 'October November December' moon.0 = 'new' moon.1 = 'waxing half' moon.2 = 'full' moon.3 = 'waning half' lunation = 29.53059 dayphase = 1 / lunation newphase = dayphase / 2 waxphase = .25 + dayphase / 2 fullphase = .5 + dayphase / 2 wanephase = .75 + dayphase / 2 return tell: say en 'will query the date and return in an English form, and also' say ' give information about the phase of the moon.' say 'Call without any parameter to display the date, or with "PUSH"' say ' to push the date-string alone onto the Stack.' if OS = 'AIX' then do say 'Call with "[NODATE]" to give only the information about the' say ' phase of the moon.' say 'Call with "[NOPHASE]" to give only the date in an English form.' say return end else do say 'Call with "(NODATE)" to give only the information about the' say ' phase of the moon.' say 'Call with "(NOPHASE)" to give only the date in an English form.' say return end