Files
harbour-core/harbour/contrib/libnf/easter.prg
Viktor Szakats 82d8ab9d01 2007-10-23 13:30 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/directx/w32_ddrw.cpp
   * contrib/directx/w32_ddrw.h
     ! Cleanup, formatting.
     ! Tabs converted to spaces.

   * contrib/libnf/aading.prg
   * contrib/libnf/aavg.prg
   * contrib/libnf/acctadj.prg
   * contrib/libnf/acctmnth.prg
   * contrib/libnf/acctqtr.prg
   * contrib/libnf/acctweek.prg
   * contrib/libnf/acctyear.prg
   * contrib/libnf/adessort.prg
   * contrib/libnf/aemaxlen.prg
   * contrib/libnf/aeminlen.prg
   * contrib/libnf/amedian.prg
   * contrib/libnf/anomatch.prg
   * contrib/libnf/any2any.prg
   * contrib/libnf/aredit.prg
   * contrib/libnf/asum.prg
   * contrib/libnf/at2.prg
   * contrib/libnf/bitclr.prg
   * contrib/libnf/bitset.prg
   * contrib/libnf/blink.prg
   * contrib/libnf/byt2bit.prg
   * contrib/libnf/byt2hex.prg
   * contrib/libnf/byteand.prg
   * contrib/libnf/byteneg.prg
   * contrib/libnf/bytenot.prg
   * contrib/libnf/byteor.prg
   * contrib/libnf/bytexor.prg
   * contrib/libnf/calendar.prg
   * contrib/libnf/clrsel.prg
   * contrib/libnf/cntryset.prg
   * contrib/libnf/d2e.prg
   * contrib/libnf/datecnfg.prg
   * contrib/libnf/dayofyr.prg
   * contrib/libnf/daytobow.prg
   * contrib/libnf/dectobin.prg
   * contrib/libnf/descend.c
   * contrib/libnf/dfile.prg
   * contrib/libnf/dhkey.h
   * contrib/libnf/diskfunc.prg
   * contrib/libnf/dispmsg.prg
   * contrib/libnf/dosver.prg
   * contrib/libnf/e2d.prg
   * contrib/libnf/easter.prg
   * contrib/libnf/elapmil.prg
   * contrib/libnf/elapsed.prg
   * contrib/libnf/eltime.prg
   * contrib/libnf/findith.prg
   * contrib/libnf/firstday.prg
   * contrib/libnf/floptst.prg
   * contrib/libnf/ftattr.c
   * contrib/libnf/ftint86.ch
   * contrib/libnf/ftmenuto.ch
   * contrib/libnf/fttext.c
   * contrib/libnf/gcd.prg
   * contrib/libnf/getenvrn.c
   * contrib/libnf/getver.c
   * contrib/libnf/getvid.c
   * contrib/libnf/hex2dec.prg
   * contrib/libnf/idle.c
   * contrib/libnf/invclr.prg
   * contrib/libnf/isbit.prg
   * contrib/libnf/isbiton.prg
   * contrib/libnf/isshare.prg
   * contrib/libnf/kspeed.c
   * contrib/libnf/lastday.prg
   * contrib/libnf/linked.prg
   * contrib/libnf/madd.prg
   * contrib/libnf/menu1.prg
   * contrib/libnf/menuto.prg
   * contrib/libnf/metaph.prg
   * contrib/libnf/miltime.prg
   * contrib/libnf/min2dhm.prg
   * contrib/libnf/month.prg
   * contrib/libnf/mouse.c
   * contrib/libnf/mouse1.prg
   * contrib/libnf/mouse2.prg
   * contrib/libnf/netpv.prg
   * contrib/libnf/nooccur.prg
   * contrib/libnf/ntow.prg
   * contrib/libnf/nwlstat.prg
   * contrib/libnf/nwsem.prg
   * contrib/libnf/nwuid.prg
   * contrib/libnf/ontick.c
   * contrib/libnf/origin.c
   * contrib/libnf/page.prg
   * contrib/libnf/pchr.prg
   * contrib/libnf/peek.c
   * contrib/libnf/pegs.prg
   * contrib/libnf/pending.prg
   * contrib/libnf/pickday.prg
   * contrib/libnf/poke.c
   * contrib/libnf/popadder.prg
   * contrib/libnf/prtesc.prg
   * contrib/libnf/prtscr.c
   * contrib/libnf/pvid.prg
   * contrib/libnf/qtr.prg
   * contrib/libnf/rand1.prg
   * contrib/libnf/readme.txt
   * contrib/libnf/restsets.prg
   * contrib/libnf/round.prg
   * contrib/libnf/savearr.prg
   * contrib/libnf/savesets.prg
   * contrib/libnf/scancode.prg
   * contrib/libnf/scregion.prg
   * contrib/libnf/setdate.prg
   * contrib/libnf/settime.prg
   * contrib/libnf/sinkey.prg
   * contrib/libnf/sleep.prg
   * contrib/libnf/sqzn.prg
   * contrib/libnf/sysmem.prg
   * contrib/libnf/tbwhile.prg
   * contrib/libnf/test.prg
   * contrib/libnf/vertmenu.prg
   * contrib/libnf/vidcur.prg
   * contrib/libnf/vidmode.prg
   * contrib/libnf/wda.prg
   * contrib/libnf/week.prg
   * contrib/libnf/workdays.prg
   * contrib/libnf/woy.prg
   * contrib/libnf/xbox.prg
   * contrib/libnf/year.prg
   - contrib/libnf/idle.c
   + contrib/libnf/ftidle.c
   + contrib/libnf/iamidle.c
   * contrib/libnf/Makefile
   * contrib/libnf/makefile.bc
   * contrib/libnf/makefile.vc
     + Added svn headers.
     ! Fixed FT_IDLE()
     ! Renamed idle.c to not clash with core idle.obj.
     ! FT_F*() functions fully ported from original NFLIB.
       Pls test.
     * Some minor cleanups, formatting.

   * include/filesys.api
     ! _fsRead(), _fsWrite() now more compatible.

   * include/hbundoc.api
     + Added _lcopy(), _ncopyuc(), _ncopylc() compatibility 
       functions.

   * include/hbapi.h
   * source/common/hbstr.c
     + Added hb_strncpyLower()
2007-10-23 11:32:22 +00:00

125 lines
3.1 KiB
Plaintext

/*
* $Id$
*/
/*
* File......: EASTER.PRG
* Author....: Paul Tucker
* Email.....: <ptucker@sympatico.ca>
*
* While I can say that I wrote the program, the algorithm is from Donald
* Knuth's The Art of Computer Programming, Section 1.3.2. So, the source
* code is an original work by Paul Tucker and is placed in the public
* domain
*
* Modification history:
* ---------------------
*
* Rev 1.2 15 Aug 1991 23:05:28 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.1 14 Jun 1991 19:51:42 GLENN
* Minor edit to file header
*
* Rev 1.0 01 Apr 1991 01:01:16 GLENN
* Nanforum Toolkit
*
*/
/* $DOC$
* $FUNCNAME$
* FT_EASTER()
* $CATEGORY$
* Date/Time
* $ONELINER$
* Return the date of Easter
* $SYNTAX$
* FT_EASTER( <xYear> ) -> dEdate
* $ARGUMENTS$
* xYear can be a character, date or numeric describing the year
* for which you wish to receive the date of Easter.
* $RETURNS$
* The actual date that Easter occurs.
* $DESCRIPTION$
* Returns the date of Easter for any year after 1582 up to Clipper's
* limit which the manual states is 9999, but the Guide agrees with
* the actual imposed limit of 2999.
*
* This function can be useful in calender type programs that indicate
* when holidays occur.
* $EXAMPLES$
* dEdate := FT_EASTER( 1990 ) && returns 04/15/1990
* $END$
*/
FUNCTION FT_EASTER (nYear)
local nGold, nCent, nCorx, nCorz, nSunday, nEpact, nMoon,;
nMonth := 0, nDay := 0
IF VALTYPE (nYear) == "C"
nYear = VAL(nYear)
ENDIF
IF VALTYPE (nYear) == "D"
nYear = YEAR(nYear)
ENDIF
IF VALTYPE (nYear) == "N"
IF nYear > 1582
* <<nGold>> is Golden number of the year in the 19 year Metonic cycle
nGold = nYear % 19 + 1
* <<nCent>> is Century
nCent = INT (nYear / 100) + 1
* Corrections:
* <<nCorx>> is the no. of years in which leap-year was dropped in order
* to keep step with the sun
nCorx = INT ((3 * nCent) / 4 - 12)
* <<nCorz>> is a special correction to synchronize Easter with the moon's
* orbit.
nCorz = INT ((8 * nCent + 5) / 25 - 5)
* <<nSunday>> Find Sunday
nSunday = INT ((5 * nYear) / 4 - nCorx - 10)
* Set Epact <<nEpact>> (specifies occurance of a full moon)
nEpact = INT ((11 * nGold + 20 + nCorz - nCorx) % 30)
IF nEpact < 0
nEpact += 30
ENDIF
IF ((nEpact = 25) .AND. (nGold > 11)) .OR. (nEpact = 24)
++nEpact
ENDIF
* Find full moon - the <<nMoon>>th of MARCH is a "calendar" full moon
nMoon = 44 - nEpact
IF nMoon < 21
nMoon += 30
ENDIF
* Advance to Sunday
nMoon = INT (nMoon + 7 - ((nSunday + nMoon) % 7))
* Get Month and Day
IF nMoon > 31
nMonth = 4
nDay = nMoon - 31
ELSE
nMonth = 3
nDay = nMoon
ENDIF
ENDIF
ELSE
nYear = 0
ENDIF
RETURN StoD( Str( nYear,4) + PadL( nMonth, 2, "0" ) + PadL( Int( nDay ), 2, "0" ) )