picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

cal.l (2453B)


      1 # 01dec10abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # Easter date algorithm from J.M. Oudin (1940)
      5 (de easter (Year)
      6    (let
      7       (C (/ Year 100)
      8          N (% Year 19)  # Metonic cycle
      9          I (%
     10             (+
     11                (- C (/ C 4) (/ (- C (/ (- C 17) 25)) 3))
     12                (* 19 N)
     13                15 )
     14             30 ) )
     15       (dec 'I (* (/ I 28) (- 1 (* (/ I 28) (/ 29 (inc I)) (/ (- 21 N) 11)))))
     16       (let
     17          (L (- I (% (+ Year (/ Year 4) I 2 (- C) (/ C 4)) 7))
     18             Mon (+ 3 (/ (+ L 40) 44)) )
     19          (date Year Mon (+ L 28 (* (/ Mon 4) -31))) ) ) )
     20 
     21 # Feiertage
     22 (de feier (X Year)
     23    (if (sym? X)
     24       (case X
     25          (Neujahr
     26             (date Year 1 1) )
     27          ((Maifeiertag "1. Mai" "Tag der Arbeit")
     28             (date Year 5 1) )
     29          (("Tag der deutschen Einheit" "Deutsche Einheit")
     30             (date Year 10 3) )
     31          ((Weihnachten "1. Weihnachtstag")
     32             (date Year 12 25) )
     33          ("2. Weihnachtstag"
     34             (date Year 12 26) )
     35          (Rosenmontag
     36             (- (easter Year) 48) )
     37          (Aschermittwoch
     38             (- (easter Year) 46) )
     39          (Karfreitag
     40             (- (easter Year) 2) )
     41          ((Ostern Ostersonntag)
     42             (easter Year) )
     43          (Ostermontag
     44             (+ (easter Year) 1) )
     45          ((Himmelfahrt "Christi Himmelfahrt")
     46             (+ (easter Year) 39) )
     47          ((Pfingsten Pfingstsonntag)
     48             (+ (easter Year) 49) )
     49          (Pfingstsmontag
     50             (+ (easter Year) 50) )
     51          (Fronleichnam
     52             (+ (easter Year) 60) ) )
     53       (let L (date X)
     54          (cdr
     55             (or
     56                (assoc (cdr L)
     57                   (quote
     58                      ((1 1) . Neujahr)
     59                      ((5 1) . Maifeiertag)
     60                      ((10 3) . "Tag der deutschen Einheit")
     61                      ((12 25) . Weihnachten)
     62                      ((12 26) . "2. Weihnachtstag") ) )
     63                (assoc (- X (easter (car L)))
     64                   (quote
     65                      (-48 . Rosenmontag)
     66                      (-46 . Aschermittwoch)
     67                      (-2 . Karfreitag)
     68                      (0 . Ostern)
     69                      (1 . Ostermontag)
     70                      (39 . Himmelfahrt)
     71                      (49 . Pfingsten)
     72                      (50 . Pfingstsmontag)
     73                      (60 . Fronleichnam) ) ) ) ) ) ) )
     74 
     75 # Werktag
     76 (de werktag (Dat)
     77    (nor
     78       (member (% Dat 7) (4 5))  # Sa So
     79       (feier Dat) ) )