\ Date & Time Words \ Copyright (C) 2000 Alex Malyshev (alexript@mail.ru) \ This is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License \ as published by the Free Software Foundation; either version 2 \ of the License, or (at your option) any later version. \ This program 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 the \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. uses StartUp uses Date.const uses Char.const uses Ext.tools : ?leapyear { year -- bool } year 4 MOD 0= IF year 100 MOD 0= IF year 400 MOD 0= IF TRUE ELSE FALSE THEN ELSE TRUE THEN ELSE FALSE THEN ; : DaysInMonth ( M Y -- n ) ?leapyear IF lyDays ELSE yDays THEN SWAP 2DUP CELL * + @ ROT ROT 1- CELL * + @ - ; : DayofTheYear ( D M Y -- n ) ?leapyear IF lyDays ELSE yDays THEN SWAP 1- CELL * + @ + ; : NextDay { D M Y -- D M Y } D 1+ DUP M Y DaysInMonth > IF DROP 1 M 1+ DUP 12 > IF DROP 1 Y 1+ ELSE Y THEN ELSE M Y THEN ; : GMT-TRANS { SS MM HH D M Y -- SS MM HH D M Y } SS MM HH GMT 0 < IF GMT + DUP 23 > IF 24 - D 1+ ELSE D THEN ELSE GMT - DUP 0< IF 24 + D 1- ELSE D THEN THEN M Y ; : .WkDay { day -- } case day 0 of ." Sun, " endof 1 of ." Mon, " endof 2 of ." Tue, " endof 3 of ." Wed, " endof 4 of ." Thu, " endof 5 of ." Fri, " endof 6 of ." Sat, " endof 7 of ." Sun, " endof endcase ; : ?WorkDay ( wkday -- flag ) DUP 0> SWAP 6 < AND ; : ?WeekEnd ( wkday -- flag ) DUP 0= SWAP 5 > OR ; : .Month { mon -- } case mon 1 of ." Jan " endof 2 of ." Feb " endof 3 of ." Mar " endof 4 of ." Apr " endof 5 of ." May " endof 6 of ." Jun " endof 7 of ." Jul " endof 8 of ." Aug " endof 9 of ." Sep " endof 10 of ." Nov " endof 11 of ." Oct " endof 12 of ." Dec " endof endcase ; : SecToHMS { S -- Sec Min Hour } S DUP SecsPerHour / { Hour } Hour SecsPerHour * - DUP SecsPerMinute / { Min } Min SecsPerMinute * - Min Hour ; : .time ( sec min hour -- ) <# SEMICOLON HOLD %0d #> TYPE <# SEMICOLON HOLD %0d #> TYPE <# BL HOLD %0d #> TYPE ; : Year2YY ( year -- year/100 yearMOD100 ) DUP 100 / SWAP 100 MOD ; : WkDay ( day month year -- day month year ) 3DUP SWAP DUP 3 < IF 10 + SWAP 1 - ELSE 2 - SWAP THEN Year2YY { D M C Y } D 26 M * 2 - 10 / + Y DUP 4 / + + C 4 / + C 2 * - 7 MOD DUP 0< IF 7 + THEN .WkDay ; : .date ( day month year -- ) WkDay ROT <# BL HOLD %0d #> TYPE SWAP .Month . ; : .gmt_time&date TIME&DATE GMT-TRANS .date .time ." GMT" ; : .time&date TIME&DATE .date .time ;
Make your own free website on Tripod.com