#!/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. */ /* */ /*----------------------------------------------------------------------------*/ /******************************************************************************/ /* qtime.rex Open Object Rexx Samples */ /* */ /* Mike Cowlishaw 1979 */ /* */ /* -------------------------------------------------------------------------- */ /* */ /* Description: */ /* Displays or stacks time in real English, also chimes. */ /* */ /* Arguments: PUSH pushes single result line onto stack. */ /* TEST hh:mm:ss runs with specified test time. */ /******************************************************************************/ Parse source . . program . /* get my real name */ Parse upper arg arg rest /* get arguments */ if arg='?' then do call tell /* say what we do */ parse var rest arg rest /* remove "?" */ end stack=0 /* flag to say whether pushing or saying */ c8=time() /* Normally use the time Now */ /* Detect and handle PUSH option */ if arg='PUSH' then do stack=1 /* set flag to indicate request */ parse var rest arg rest /* .. and remove the word */ end /* Detect and handle TEST option (must follow PUSH) */ if arg='TEST' then parse var rest c8 arg rest /* set c8 and remove */ /* Now check for extraneous (or unrecognised) args */ if arg\='' then do if rest='' then do; plural=''; own='has'; end /* grammar.. */ else do; plural='s'; own='have'; end say 'The extra argument'plural '"'space(arg rest)'"', 'that you gave to' program own 'been ignored.' end /************** OK, off we go... ***************/ ot="It's" hr=substr(c8,1,2)+0 /* extract hours, mins, secs.. */ mn=substr(c8,4,2) sc=substr(c8,7,2) h.1 = 'one' ; h.2 = 'two'; h.3 = 'three'; h.4 = 'four' h.5 = 'five'; h.6 = 'six'; h.7 = 'seven'; h.8 = 'eight' h.9 = 'nine'; h.10= 'ten'; h.11= 'eleven'; h.12= 'twelve' if sc>29 then mn=mn+1 /* round up mins */ if mn>32 then hr=hr+1 /* something to.. */ mod=mn//5 /* find 5-minute bracket */ select when mod=0 then nop /* exact */ when mod=1 then ot=ot 'just gone' when mod=2 then ot=ot 'just after' when mod=3 then ot=ot 'nearly' when mod=4 then ot=ot 'almost' end /* select */ mn=mn+2 /* round up */ if hr//12=0 & mn//60<=4 then signal midnoon /* special case noon and midnight */ mn=mn-(mn//5) /* to nearest 5 mins */ if hr>12 then hr=hr-12 /* get rid of 24-hour clock */ else if hr=0 then hr=12 /* cater for midnight */ select when mn=0 then nop /* add O'clock later */ when mn=60 then mn=0 when mn= 5 then ot=ot 'five past' when mn=10 then ot=ot 'ten past' when mn=15 then ot=ot 'a quarter past' when mn=20 then ot=ot 'twenty past' when mn=25 then ot=ot 'twenty-five past' when mn=30 then ot=ot 'half past' when mn=35 then ot=ot 'twenty-five to' when mn=40 then ot=ot 'twenty to' when mn=45 then ot=ot 'a quarter to' when mn=50 then ot=ot 'ten to' when mn=55 then ot=ot 'five to' end ot=ot h.hr /* add the hour number */ if mn=0 then ot=ot "o'clock" /* and O'clock if exact */ ot=ot'.' /* and the correct punctuation */ /* Now stack or display the result */ if \stack then do if mod=0 & mn//15=0 then call chime /* only if displaying */ say; say ot; say end else push ot exit /* Special-case Midnight and Noon */ MIDNOON: if hr=12 then ot=ot 'Noon.' else ot=ot 'Midnight.' if \stack then do hr=12 if mn//60=2 then do mn=0 call chime end say; say ot; say end else push ot exit /* "Chime" the hours or quarters */ CHIME: /* Give chimes */ if mn//60=0 then /* hourly chime */ do chime='Bong' num=hr end else do /* quarterly tinkles */ chime='Ding-Dong' num=mn%15 end say; say ot ot='('chime /* Parenthesis and first chime */ do num-1 /* Add the remainder of chiming sounds ... */ ot=ot||',' chime end ot=ot||'!)' /* ... and final punctuation and parenthesis */ return /* from chime */ TELL: say say program 'will query the time and display or return it in English.' say 'Call without any arguments to display the time, or with "PUSH"' say ' to push the time-string onto the Stack (without blank lines).' say program 'will "chime" at the quarter-hours and on the hours, but' say ' the chimes are also not placed on the stack.' say say 'English (British) idioms are used in this program.' return /* Mike Cowlishaw, December 1979 - July 1983 */