{$I version.pas} {$IFNDEF DELPHI} {$M 64000, $1000, $1000} {$ENDIF}

program HEBCLNDR
  { Passover, and other Hebrew Calendar work ; see procedure Help
    TurboPascal 7, Delphi 3, etc. } ;

uses {$IFDEF DELPHI} SysUtils, {$ELSE} Dos, {$ENDIF} DateProx ;




{ 1 day (-0600..+1800) = 24 hours of 1080 parts each ; 25920 parts per day.
  First Month starts 02d 05h 204p
  Every Month length 29d 12h 793p
  ~ 235 Months are 19 Years }

type HebrYr = 1..5879542 { Max HY for MJD in MJDate = longint } ;

const
MJD_AM1 = -2052003 ;
Three761 = 3761 ;


function HYtoMJD(const Y : HebrYr) : MJDate ;
{ based on E G Richards, Algorithm G, Hebrew Year Start (1 Tishri) to JDN
  with input from Remy Landau, http://www.geocities.com/Athens/1584/
  OK by L E Doggett in http://charon.nmsu.edu/~lhuber/leaphist.html }
const
  hpd = 24   { hours per day } ;
  pph = 1080 { parts per hour } ;
var
  m  { months from AM 1/1/1 },
  tm { minor contribution from parts },
  th { hours from hours & parts },
  d  { days },
  t_ { parts of day } : longint ;
  w  { DoW Sun=1 .. Sat=7 } : word ;
  E  { This Year Leap },
  E_ { Last Year Leap } : boolean ;
begin
  {a } m  := (235*Y - 234) div 19 ;
  {b'} tm := 204 + 793*(m mod pph) ;
  {c } th := 5 + 12*m + tm div pph + 793*(m div pph) ;
  {d } d  := 1 + 29*m + th div hpd ;
  {e } t_ := (tm mod pph) + pph*(th mod hpd) ;
  {          (d, t_) is Molod in Days & Parts from Hebrew time origin }

  {4 } w  := Succ(d mod 7) ;
  {5 } E  := ((7*Y + 13) mod 19) >= 12 ; { Whatever Y is, these  }
  {6 } E_ := ((7*Y +  6) mod 19) >= 12 ; { cannot both give TRUE }

  {7 } if  (t_ >= 18*pph)                                             { DMZ }
    {} or ((t_ >=  9*pph + 204) and (w=3) and not E)                 { DGTR }
    {} or ((t_ >= 15*pph + 589) and (w=2) {and (not E)} and E_)      { DB'T }
    {} then Inc(d) ;
  {8 } if Succ(d mod 7) in [1, 4, 6] then Inc(d) ;                   { DADU }

  HYtoMJD := d + (347997-2400001) { d + 347997 is EGR's answer } ;
  end {HYtoMJD} ;



procedure HebDPtoGregYMDP(var d, p : longint ;
  var GY : integer ; var GM, GD : byte) ;
begin
  Dec(p, 6*1080) ;
  if p < 0 then begin Dec(d) ; Inc(p, 24*1080) end ;
  MJDtoYMD(d{-2052004}+MJD_AM1-1, GY, GM, GD) ;
  end {HebDPtoGregYMDP} ;


function HYtoHebrewMonth(const Y : HebrYr) : longint ;
{ was part of HYtoMJD ; see that for comment }
begin
  {a } HYtoHebrewMonth  := (235*Y - 234) div 19 ;
  end {HYtoHebrewMonth} ;


procedure HebMonthtoMolodDP(m : longint ; var d, t_ : longint) ;
{ was part of HYtoMJD ; see that for comment }
const hpd = 24 ; pph = 1080 ;
var  tm, th : longint ;
begin
  {b'} tm := 204 + 793*(m mod pph) ;
  {c } th := 5 + 12*m + tm div pph + 793*(m div pph) ;
  {d } d  := 1 + 29*m + th div hpd ;
  {e } t_ := (tm mod pph) + pph*(th mod hpd) ;
  end {HebMonthtoMolodDP} ;


procedure HYtoMolodDP(const Y : HebrYr ; var d, t_ : longint) ;
{ as part of HYtoMJD ; see that for comment }
const hpd = 24 ; pph = 1080 ;
var m, tm, th : longint ;
begin
  {a } m  := (235*Y - 234) div 19 ;
  {b'} tm := 204 + 793*(m mod pph) ;
  {c } th := 5 + 12*m + tm div pph + 793*(m div pph) ;
  {d } d  := 1 + 29*m + th div hpd ;
  {e } t_ := (tm mod pph) + pph*(th mod hpd) ;
  end {HYtoMolodDP} ;


function MJDtoHY(const MJD : MJDate) : HebrYr ;
var HY, X : longint ; {Z : integer ;}
begin { firstly use X to approximate well; then shift if needed }
  X := MJD{+2052003}-MJD_AM1 ;
  HY := Succ(X div 365 - X div (1480*365)) ;    {     Z := 0 ; }
  while HYtoMJD(HY)   >  MJD do begin Dec(HY) ; { Dec(Z) } end ;
  while HYtoMJD(HY+1) <= MJD do begin Inc(HY) ; { Inc(Z) } end ;
                                              { Write(Z:5) ; }
  MJDtoHY := HY end {MJDtoHY} ;



procedure InverseCheck ;
var HY, X, Y : HebrYr ; MJD : MJDate ;
const Cap = '      HY         MJD      HY     HY-' ;
begin Writeln(' Inverse Check:'^M^J, Cap) ;
  for HY := 2 to 9999 do begin Write(HY:8) ;
    MJD := HYtoMJD(HY) ; Write(MJD:12) ;
    X := MJDtoHY(MJD) ; Write(X:8) ;
    Y := MJDtoHY(MJD-1) ; Write(Y:8) ; if (X<>HY) or (Y+1<>HY) then Readln ;
    Write(^M) end ;
  Writeln('':50) ;
  end {InverseCheck} ;


function CompareDiff(const A, B : MJDate) : shortint ;
var C : longint ;
begin C := A-B ;
  if C<0 then begin Write('  <  ') ; CompareDiff := -1 end else
  if C>0 then begin write('    >') ; CompareDiff := +1 end else
              begin write('   = ') ; CompareDiff :=  0 end ;
  end {CompareDiff} ;


procedure CompareHeader ;
begin Writeln(' GYear  GY MJD1   GE MJD   JE MJD   ',
  'HebYr? HY+MJD1  15Nisan DoW  G:P  J:P') end {CompareHeader} ;


procedure CompareGregAndJulnEasterWithPesach(const GYS, GYE : integer) ;
var
  MJD, GEMJD, JEMJD : MJDate ;
  HY : HebrYr ;
  GY : integer ;
  GM, GD, JM, JD : byte ;
  Glast, Jlast : array [-1..+1] of word ;
  J : shortint ;
begin
  Writeln(' Compare Greg And Juln Easter With Pesach') ;
  CompareHeader ;
  for GY := GYS to GYE do begin
    Write(GY:6) ;
    MJD := YMD_to_MJD(GrgCal, GY, 1, 1) ; Write(MJD:9) ;

    GregorianEaster(GY, GM, GD) ;
    GEMJD := YMD_to_MJD(GrgCal, GY, GM, GD) ; Write(GEMJD:9) ;

    JulianEaster(GY, JM, JD) ;
    JEMJD := YMD_to_MJD(JulCal, GY, JM, JD) ; Write(JEMJD:9) ;

    HY := GY + Three761 - 1 ; Write(HY:8) ;
    MJD := HYtoMJD(HY+1) ; Write(MJD:9) ;
    MJD := MJD-163 ;
    Write(MJD:9, WkDStr[DayOfWeek(MJD)]:4) ;
    Glast[CompareDiff(GEMJD, MJD)] := GY ;
    Jlast[CompareDiff(JEMJD, MJD)] := GY ;

    if GY=1981 then Write('  <-') ;
    Writeln ;
    {                                    if GY=2005 then BREAK ; }
    end {GY} ;

  CompareHeader ;
  Writeln(
    'Passover = Pesach = 15 Nisan = 163 days before first of next year'^M^J) ;
  Writeln(' Gregorian    Julian') ;
  for J := -1 to 1 do Writeln(Glast[J]:10, Jlast[J]:10) ;

  end {CompareGregAndJulnEasterWithPesach} ;



procedure DoSpans(const HYS, HYE, MaxSpan : integer) ;
var HY, J, Span : integer ;
  Darr : array [0..6] of integer ;
  DSet : set of 0..6 ;
begin
  Writeln(' Seek all-DoW spans within initial Hebrew Years ', HYS, -HYE) ;
  Writeln('    Span    Last   7N+:    0     1     2     3     4     5     6',
    '     Days') ;
  for Span := 1 to MaxSpan do begin Write(Span:8) ;
    DSet := [] ; FillChar(DArr, SizeOf(DArr), 0) ;
    for HY := HYS to HYE do begin
      J := (HYtoMJD(HY+Span)-HYtoMJD(HY)) mod 7 ;
      if DArr[J]=0 then DArr[J] := HY ;
      Include(DSet, J) ;
      if DSet=[0..6] then begin Write(HY:8, '':6) ;
        for J := 0 to 6 do Write(DArr[J]:6) ; Writeln ; BREAK ;
        end ;
      end {HY} ;
    Write(^M) end {Span} ;
  end {DoSpans} ;


procedure CheckPesachAgainstAList ;
var F : text ; MJD, HP : MJDate ; HY : HebrYr ;
  GY : integer ; GM, GD : byte ;
begin Writeln('Check Pesach Against A List') ;
  Write('Open file hebpesak.dat - ') ;
  Assign(F, 'hebpesak.dat') ; Reset(F) ; Writeln('OK') ;
  Writeln(' A.D.            MJD  DoW     A.M.   Calc.MJD  DoW   Diff') ;
  while not EoF(F) do begin Readln(F, GY, GM, GD) ;
    MJD := YMDtoMJD(GY, GM, GD) ;
    HY := GY + Three761 ;
    HP := HYtoMJD(HY) - 163 ;
    Write(GY:5, GM:3, GD:3, MJD:9, WkDstr[DayOfWeek(MJD)]:5,
      HY:9, HP:11, WkDstr[DayOfWeek(HP)]:5, (MJD-HP):6, ^M) ;
    if MJD<>HP then Writeln ;
    end ;
  Writeln('':77) ;
  Close(F) ;
  end {CheckPesachAgainstAList} ;


function HebrLeap(const HY : HebrYr) : boolean ;
begin HebrLeap := byte(HY mod 19) in [0, 3, 6, 8, 11, 14, 17] end {HebrLeap} ;


procedure CheckYearLengthsPlausible ;
var Y : HebrYr ; This, Next : MJDate ; Diff : longint ; Leap : boolean ;
begin Writeln(' Check Year Lengths Plausible : to ', High(HebrYr)) ;
  Writeln(' Impossible results are followed by a line feed :') ;
  Writeln(' Heb Year  First MJD     Next RH   Length  Leap') ;
  This := HYtoMJD(Low(HebrYr)) ;
  for Y := Low(HebrYr) to Pred(High(HebrYr)) do begin
    Write(Y:9, This:11, #32) ;
    Next := HYtoMJD(Y+1); Write(Next:11, #32) ;
    Diff := Next-This ; Write(Diff:8) ;
    Leap := Diff>365 ; Write(Leap:8) ;
    if ((Diff-300) in [53, 54, 55, 83, 84, 85]) and Leap = HebrLeap(Y)
      then Write(^M) else Writeln ;
    This := Next end ;
  Writeln(^M^J'Done') ;
  end {CheckYearLengthsPlausible} ;



function YearLength(const HY : HebrYr) : integer ;
begin YearLength := HYtoMJD(HY+1) - HYtoMJD(HY) end {YearLength} ;

type Six = 1..6 ;

function CutLen(const HY : HebrYr) : Six ;
var YL : integer ;
begin YL := YearLength(HY) ;
  if YL<365 then CutLen := YL-352 else CutLen := YL-382+3 end {Cutlen} ;

const UnCut : array [Six] of word = (353, 354, 355, 383, 384, 385) ;

const Rept = 689472 ;


procedure CheckYearFrequencies ;
var Y : HebrYr ; L, XL : Six ; J : byte ; Total : longint ;
YA : array [Six] of longint ;
YYA : array [Six, Six] of longint ;
YS : array [1..7] of longint ;
const First = 1000 ;
begin Writeln(' Check Year Length & Start Frequencies over ',
  Rept, ' years from ', First) ;

  FillChar(YA, SizeOf(YA), 0) ;
  FillChar(YYA, SizeOf(YYA), 0) ;
  FillChar(YS, SizeOf(YS), 0) ;

  XL := Cutlen(First-1) ;
  for Y := First to First+Rept-1 do begin
    Write(^M, Y:9, #32) ;
    Inc(YS[ISODoW1(HYtoMJD(Y))]) ;
    L := CutLen(Y) ; Inc(YA[L]) ; Inc(YYA[L, XL]) ;
    XL := L end ;
  Writeln(^M, '':11, ^M^J'Year start frequencies:') ;
  for J := 1 to 7 do Write(WkDstr[WkDys(J)]:9) ; Writeln ;
  for J := 1 to 7 do Write(YS[J]:9) ;

  Writeln(^M^J^M^J'Year length frequencies:'^M^J,
    ' Count & fraction :') ;

  Total := 0 ;
  for L := Low(Six) to High(Six) do begin
    Write(UnCut[L]:6, YA[L]:7) ; Inc(Total, YA[L]) end ;
  Writeln ;
  for L := Low(Six) to High(Six) do Write('':2,
    (YA[L]*(100000 div 16) div (Rept div 16)):7, 'e-5 ') ;
  Writeln(^M^J' in total ', Total) ;

  Total := 0 ;
  Writeln ; Write('Length') ;
  for XL := Low(Six) to High(Six) do Write(UnCut[XL]:7) ;
  Write('  followed by') ;
  for L := Low(Six) to High(Six) do begin Writeln ; Write(UnCut[L]:6) ;
    for XL := Low(Six) to High(Six) do begin
      Write(YYA[L, XL]:7) ; Inc(Total, YYA[L, XL]) end ;
    end ;
  Writeln('   in total ', Total) ;

  end {CheckYearFrequencies} ;


procedure SeekRepeatSequence ;
var Start : HebrYr ; After, SMax, Same : longint ; OK : boolean ;
const K = 5730 {HebrYr} ;
begin
  Writeln(' Seek Repeat Sequence (should be ', Rept, ')') ;
  Writeln('   After   Length',
    '    ---------------- Hebrew Years ----------------') ;
  SMax := 0 ;
  for After := 1 to 1000000 do begin Write(After:8, #32) ;
    OK := true ; Same := 0 ;
    for Start := K to K+After-1 do begin
      if YearLength(Start) <> YearLength(Start+After) then begin
        OK := false ; BREAK end ;
      Inc(Same) ;
      end ;
    if Same>SMax then begin SMax := Same ;
      Writeln(Same:8, K:8, ' to', K+Same-1:8,
        '  matched by', K+After:8, ' to', K+After+Same-1:8) ;
      end ;
    if OK then Writeln('  OK') else Write(^M) ;
    end {After} ;

  Writeln('':77, ^M) ;
  end {SeekRepeatSequences} ;


procedure SeekAllRepeatSequences ;
var Start, From : HebrYr ; Sepn, S, SMax, SMaxMax : longint ;
ThisEq : boolean ;
const Kmax = 690000 ;
begin
  Writeln(' Seek All Repeat Sequences') ; SMaxMax := 0 ;
  Writeln(' Separation  Max Span    From      To   =    From      To') ;
  for Sepn := 1 to Kmax do begin Write(^M, '':70, ^M, Sepn:8, #32) ;
    SMax := 0 ; S := 0 ; From := 1 ;
    for Start := 5700 to 5700+KMax+SMax do begin
      ThisEq := YearLength(Start) = YearLength(Start+Sepn) ;
      if ThisEq then Inc(S) else begin
        if S>SMax then begin SMax := S ; From := Start end ;
        S := 0 end ;
      end ;
    Write(SMax:8, From:12, From+Smax-1:8, From+Sepn:12, From+Sepn+Smax-1:8) ;
    if SMax>SMaxMax then begin SMaxMax := SMax ; Writeln end ;
    end {Sepn} ;

  Writeln('':77, ^M) ;
  end {SeekAllRepeatSequences} ;



procedure Sextuplets ;
const Six5 = 6*6*6*6*6 { 7776 } ;
var From : HebrYr ; Count, J, Goes : longint ; Len : Six ; X, Y : word ;
S6 : set of Six ; Arr : array [0..5] of Six ;
BigArr : array [0..500{Six5}] of record A : array [boolean] of word ;
  W : word ; S : set of 0..18 ; D : set of WkDys end ;
Start : array [0..18] of word ;
begin
  Writeln(' Sextuplets covering all lengths - X is a sequence "label",',
    ' first observed:') ;
  Count := 0 ; Goes := 0 ;
  FillChar(BigArr, SizeOf(BigArr), 0) ;
  FillChar(Start, SizeOf(Start), 0) ;

  for From := 5700 to 5700+Rept-1 do begin Inc(Goes) ; S6 := [] ;
    if From mod 1000 = 0 then Write(^M, From:6, Count:6) ;
    for J := 0 to 5 do begin Len := CutLen(From+J) ;
    Include(S6, Len) ; Arr[J] := Len end ;
    if S6 <> [1..6] then CONTINUE ;                            { <----- }
    Inc(Count) ; Inc(Start[From mod 19]) ;
    X := 0 ; for J := 0 to 4 do X := 6*X + Arr[J] ;
    X := X-5500 { Range known small } ;
    with BigArr[X] do begin Y := From mod 19 ;
      Inc(W) ; Inc(A[Y > 9]) ;
      Include(S, Y) ;
      Include(D, DayOfWeek(HYtoMJD(From))) ;
      if W=1 then begin Write(^M, ' X=', X) ;
        for J := 0 to 5 do Write(From+J:6, YearLength(From+J):4) ;
        Writeln end ;
      end ;
    end ;

  Writeln(^M, '':18, 'Starting year can be year of cycle') ;
  Write('':6) ;
  for Y := 0 to 18 do Write(Y:3) ; Writeln('times':9) ;
  for X := Low(BigArr) to High(BigArr) do with BigArr[X] do if W>0 then begin
    Write(' X=', X) ;
    for Y := 0 to 18 do if Y in S then write('  +') else write('   ') ;
    for Y := 0 to 1 do Write(A[Y>0]:6) ;
    Writeln end ;

  Write('Starting day can be':21) ;
  for Y := 0 to 6 do Write(WkDstr[WkDys(Y)]:5) ; Writeln ;
  for X := Low(BigArr) to High(BigArr) do with BigArr[X] do if W>0 then begin
    Write(' X=', X, W:7, ' times ') ;
    for Y := 0 to 6 do if WkDys(Y) in D then write('+':5) else write('':5) ;
    Writeln end ;

  Writeln(' Total  ', Count, ' times in ', Goes,
    ' years, of which a full sextuplet starts in') ;
  for X := 0 to 18 do if Start[X]>0 then
    Writeln(' year', X:3, ' of a cycle', Start[X]:5, ' times') ;
  end {Sextuplets} ;



procedure GregDatesForAllHY ;
var HY : HebrYr ; MJD : MJDate ;
LY : longint ; GY : integer ; GM, GD : byte ;
const D400 = 146097 ; Cap = ' HebYr   1st MJD    Gregorian  Diff' ;
begin
  Writeln('Gregorian Dates for full repeat of Hebrew calendar:'^M^J, Cap) ;
  for HY := 1 to 690000 do begin
    MJD := HYtoMJD(HY) ;
    Write(HY:6, MJD:10) ;
    if MJD<0 then LY := 0 else
      begin LY := 400*(MJD div D400) ; MJD := MJD mod D400 end ;
    MJDtoYMD(MJD, GY, GM, GD) ; LY := GY+LY ;
    Write(LY:7, LZ(GM):3, LZ(GD):3, HY-LY:6) ;
    if HY=Rept then Write('  __') ;
    Writeln end ;
  Writeln(Cap) ; HALT end {GregDatesForAllHY} ;


procedure SimpleLeap ;
const NY : array [boolean] of char = ' *' ;
var HY : HebrYr ;
begin Writeln(' Simple Leap Year Stuff'^M^J) ;
  for HY := 1 to 19 do Write(HY:3) ; Writeln ;
  for HY := 1 to 19 do Write(NY[HebrLeap(HY)]:3) ; Writeln(^M^J) ;
  for HY := 5740 to 5799 do begin
    if HebrLeap(HY) then Write(HY:5) else Write('':5) ;
    if (HY mod 10) = 9 then Writeln ;
    end ;
  Writeln('  Consistency:') ;
  for HY := 700000 downto 1 do begin Write(^M, HY:7) ;
    if HebrLeap(HY) <> (YearLength(HY)>365) then Writeln ;
    end ;
  Write(^M) end {SimpleLeap} ;


procedure IntervalSpanningYearLengths ;
type Str50 = string [50] ;
PLisT = ^LisT ;
LisT = record Next : PList ; HY : HebrYr ; Ct : word ; St : Str50 end ;
var HY1, HY2, MinY, MaxY : HebrYr ; MJD : MJDate ; P : PLisT ;
M, Max, Min, MaxC, MinC : word ;
Len : Six ; S6 : set of Six ; S7 : set of WkDys ; DW : WkDys ; B : byte ;
S19 : set of 0..18 ;
S : Str50 ;
const Start = {5760} 1 ;
PL : PList = NIL ;

begin Max := 0 ; Min := 65535 ; MaxC := 0 ; MinC := 0 ; S7 := [] ;
{$IFDEF DELPHI} MaxY := 1 ; MinY := 1 ; {$ENDIF to keep it happy}
  Writeln(' Check from ', Start, ' for ', Rept, ' years as start of run.'^M^J,
    ' Doing  Run   Min First Count   Max First Count   SMTWTFS   Span') ;
  for HY1 := Start to Start+Rept-1 do begin Write(^M, HY1:6) ; S6 := [] ;
    for HY2 := HY1 to HY1+700000 {!} do begin
      Len := CutLen(HY2) ; Include(S6, Len) ;
      if S6=[1..6] then begin M := HY2-HY1+1 ; Write(M:5) ;
        if M<Min then begin Min := M ; MinY := HY1 ; MinC := 0 end ;
        if M=Min then Inc(MinC) ;
        Dec(M) {**} ;
        if M>Max then begin
          Max := M ; MaxY := HY1 ; MaxC := 0 ; S7 := [] ; S19 := [] end ;
        if M=Max then Inc(MaxC) ;
        Write(Min:6, MinY:6, MinC:6,
          {}  Max:6, MaxY:6, MaxC:6, '':3) ;
        if M=Max then begin
          MJD := HYtoMJD(HY1) ; DW := DayOfWeek(MJD) ;
          Include(S7, DW) ; Include(S19, HY1 mod 19) ;
          for DW := Sun0 to Sat do if DW in S7 then Write('^') else write('.') ;
          MJD := HYtoMJD(HY2)-MJD ; Write(MJD:7, #32) ;
          if M=43 then begin
            for B := 0 to 18 do if B in S19 then Write(B:3) ;
            if (MJD<>15681) then begin Write(' 44 not 15681!') ; Readln end ;
            end ;

          S := '' ;
          for HY2 := HY1 to HY2-1 do S := S + char(48+CutLen(HY2)) ;
          P := PL ; while P<>NIL do begin
            if S=P^.St then begin Inc(P^.Ct) ; BREAK end ;
          P := P^.Next end ;
          if P=NIL then begin P := New(PList) ;
            P^.Next := PL ; P^.HY := HY1 ; P^.Ct := 1 ; P^.St := S ; PL := P end ;

          end ;
        BREAK end ;
      end ;
    end ;

  Writeln(^M, '':12, ^M^J'        Prev  First   Pattern ... Last Next') ;

  Write('Min', Min:3, CutLen(Pred(MinY)):6, MinY:7, '':3) ;
  for HY1 := MinY to Pred(MinY+Min) do Write(CutLen(HY1)) ;
  Writeln(Pred(MinY+Min):7, CutLen(MinY+Min):4) ;

  Write('Max', Max:3, CutLen(Pred(MaxY)):6, MaxY:7, '':3) ;
  for HY1 := MaxY to (MaxY+Max-1) do Write(CutLen(HY1)) ;
  Writeln((MaxY+Max-1):7, CutLen(MaxY+Max{-1}):4) ;

  P := PL ;
  while P<>NIL do with P^ do begin
    if Length(St)=Max then Writeln(Ct:9, '*', HY:9, St:46) ;
    P := Next end ;

  end {IntervalSpanningYearLengths} ;


procedure YearLengthsInCycles ;
var HY1, HY2 : HebrYr ; Q : longint ; CC : word ; N, M : byte ;
Miss : array [Six] of word ;
J, K, Len : Six ; S6, SX6 : set of Six ;
const Start = 303*19 ;
begin
  Writeln(' Check from ', Start, ' for ', Rept, ' years as start of cycle,',
    ^M^J'  counting year-lengths in 19 year cycles:'^M^J,
    ' Start year  Included  Excluded;    Were Excluded') ;
  for Q := 1 to 19 do begin
    HY1 := Start ; SX6 := [] ; FillChar(Miss, SizeOf(Miss), 0) ;
    CC := 0 ; M := 0 ;

    repeat Write(^M, HY1:11) ; S6 := [] ; Inc(CC) ;
      for HY2 := Q+HY1 to Q+HY1+18 do begin
        Len := CutLen(HY2) ; Include(S6, Len) ;
        end ;
      Write('':4) ;
      for J := 1 to 6 do if J in S6 then Write(J) else Write('.') ;
      Write('':4) ; N := 0 ;
      for J := 1 to 6 do if J in S6 then Write('.') else
        begin Write(J) ; Inc(N) ;
          (* if N=2 then begin Writeln ;
            for HY2 := Q+HY1 to Q+HY1+18 do Write(YearLength(HY2):4) ;
            readln end ;  *)
        end ;
      Write(N:2) ; if M<N then M := N ;
      for J := 1 to 6 do if not (J in S6) then begin Inc(Miss[J]) ;
        if not (J in SX6) then begin Include(SX6, J) ;
          Write('':10) ;
          for K := 1 to 6 do if K in SX6 then Write(K) else Write('.') ;
          end ;
        end ; { Layout assumes no, but would show, double-excludes }
      Inc(HY1, 19) until HY1 >= Start+Rept-1 ;

    if CC <> Rept div 19 then begin Write(' *(', CC, ')* ') ; Readln end ;
    Writeln(^M' First ', (Q+Start), -(Q+18+Start), ' Sometimes missing:':23) ;
    Write('  => for start year 19*N+', LZ(Q), '  Freqs:') ;
    for J := 1 to 6 do begin Write(Miss[J]:6) ; if J=3 then Write('':3) end ;
    Writeln('  M=', M) end {Q} ;
  Write('':35) ;
  for J := 1 to 6 do begin Write(UnCut[J]:6) ; if J=3 then Write('':3) end ;
  Writeln end {YearLengthsInCycles} ;


procedure WriteYMD(const GY : integer ; const GM, GD : byte) ;
begin Write(GY:7, '-', LZ(GM), '-', LZ(GD)) end {WriteYMD} ;


procedure WriteHP(const p : longint) ;
begin Write(p div 1080:3, 'h', p mod 1080:5, 'p') end {WriteHP} ;


procedure WriteHYMolod1(const HY : HebrYr) ;
var GY : integer ; GM, GD : byte ; d, p : longint ;
begin
  HebMonthtoMolodDP(HYtoHebrewMonth(HY), d, p) ;
  HebDPtoGregYMDP(d, p, GY, GM, GD) ;
  WriteYMD(GY, GM, GD) ;
  WriteHP(p) ;
  end {WriteHYMolod1} ;


procedure WriteGreg(const MJD : MJDate) ;
var GY : integer ; GM, GD : byte ;
begin
  MJDtoYMD(MJD, GY, GM, GD) ;
  WriteYMD(GY, GM, GD) ;
  Write(WkDStr[DayOfWeek(MJD)]:4) ;
  end {WriteGreg} ;


procedure Cap ;
begin Writeln('Hebrew L Dys     MJD    Gregorian       1st Pesach',
    '       ? Molod of Tishri ?') ;
      Writeln(' Year  Y            1 Tishri            (Passover)',
    '              ?GMT?         ') ;
  end {Cap} ;


procedure Calendar ;
const LR : array [boolean] of char = ' *' ;
var HY : HebrYr ; MJD : MJDate ;
begin Cap ;
  for HY := 5700 to 6000 do begin MJD := HYtoMJD(HY) ;
    Write(HY:6, LR[HebrLeap(HY)]:2, YearLength(HY):4, MJD:8) ;
    WriteGreg(MJD) ;
    WriteGreg(HYtoMJD(HY+1)-163) ;
    WriteHYMolod1(HY) ;
    Writeln end ;
  Cap end {Calendar} ;


procedure WritePartsAsHMS(p : word) ;
var h, m, s, f : word ;
begin
  h := p div 1080 ; p := p mod 1080 ;
  m := p div   18 ; p := p mod   18 ;
  s := (p*10) div 3 ; f := ((p*10) mod 3)*33 ; if f=66 then f := 67 ;
  Write(LZ(h):4, ':', LZ(m), ':', LZ(s), '.', LZ(f)) ;
end {WritePartsAsHMS} ;


procedure StatsForHY(HY : HebrYr) ;
var MJD : MJDate ; GY : integer ; GM, GD : byte ;
begin
  Writeln('AM':8, '1st MJD':9, 'Gregorian':17, 'Molod ?GMT?':21,
    'Pesach':17) ;
  if HY<4000 then Inc(HY, Three761) ;
  MJD := HYtoMJD(HY) ; MJDtoYMD(MJD, GY, GM, GD) ;
  Write('**', HY:6, MJD:9, GY:6, LZ(GM):3, LZ(GD):3,
    ISODow1(MJD):3, WkDstr[DayOfWeek(MJD)]:4) ;
  WriteHYMolod1(HY) ;

  MJD := HYtoMJD(HY) - 163 ; MJDtoYMD(MJD, GY, GM, GD) ;
  Write(GY:7, LZ(GM):3, LZ(GD):3,
    {ISODow1(MJD):3,} WkDstr[DayOfWeek(MJD)]:4) ;

  Writeln ;
  HALT end {StatsForHY} ;


procedure CurrentMolods ;
var DM, HM, d, p : longint ; GY : integer ; GM, GD : byte ;
{$IFNDEF DELPHI} X, {$ENDIF} Y, M : word ;
begin Writeln(' ?GMT? of some Current Molods':30) ;
  {$IFDEF DELPHI} Y := 1900 + Trunc((Date+181)*4) div 1461 ; M := 0 ;
  {$ELSE} GetDate(Y, M, X, X) ; {$ENDIF}
  HM := HYtoHebrewMonth(Three761+Y-Ord(M<7)) ;
  Writeln('  Month   Gregorian') ;
  for DM := 0 to 20 do begin Write(HM:7) ;
    HebMonthtoMolodDP(HM, d, p) ;
    HebDPtoGregYMDP(d, p, GY, GM, GD) ;
    WriteYMD(GY, GM, GD) ;
    WritePartsAsHMS(p) ;
    Inc(HM) ; Writeln end ;
  end {CurrentMolods} ;


procedure Help ;
begin
  Writeln(
    '  0 params or just /? : this;'^M^J,
    '  1 param :'^M^J,
    '    0 : Greg Dates for all Hebrew Years of a Cycle {25 MB}'^M^J,
    '    1 : Check Pesach Against A List - needs file hebpesak.dat'^M^J,
    '    2 : Check Year Lengths Plausible'^M^J,
    '    3 : Seek Repeat Sequence'^M^J,
    '    4 : Seek All Repeat Sequences { takes ages }'^M^J,
    '    5 : check MJDtoHY'^M^J,
    '    6 : Check Year Frequencies'^M^J,
    '    7 : Simple Leap Years'^M^J,
    '    8 : Interval spanning year types'^M^J,
    '    9 : Year types in 19-year cycles'^M^J,
    '    10 : Calendar, AM 5700-6000 (inc Greg start, Pesach, Tishri)'^M^J,
    '    11 : Seek Sextuplets of all year-lengths'^M^J,
    '    12 : Current Molods'^M^J,
    '    > : Report on that Year : <4000 = AD, else AM'^M^J,
    '  Start, End : Greg Yrs for Passover/Easter comparison,'^M^J,
    '  Start, End, MaxSpan : Hebrew Year for all span-lengths mod 7 days.'^M^J,
    ' Further guidance may be found in comment in the source.'^M^J,
    ' Use Break or ^C to stop.') ;
  HALT end {Help} ;



function GetParam(const N : word) : integer ;
var J, P : integer ;
begin Val(ParamStr(N), P, J) ;
  if J<>0 then begin Writeln('Param Error!') ; HALT(1) end ;
  GetParam := P end {GetParam} ;


procedure FixedText ;
var Q : longint ;
begin Q := HYtoMJD(Rept+9)-HYtoMJD(9) ;
  Writeln(#32, Rept, ' Hebrew years is always ', Q, ' days; ',
    Q div 7, ' weeks plus ', Q mod 7, ' days;') ;
  Writeln(#32, Rept div 19, ' 19-year leap-cycles.',
    '  Year lengths 353..385 map to 1..6 as needed.') end {FixedText} ;



BEGIN ;
Writeln(^M'HEBCLNDR ', ParamStr(1), #32, ParamStr(2), #32, ParamStr(3),
  ' :   www.merlyn.demon.co.uk  >= 2005-02-11') ;

if (ParamCount=0) or (ParamStr(1)='/?') then Help ;

if (ParamCount=1) and (GetParam(1)>12) then StatsForHY(GetParam(1)) ;

FixedText ;

case ParamCount of

  1 : case GetParam(1) of
    0 : GregDatesForAllHY ;
    1 : CheckPesachAgainstAList ;
    2 : CheckYearLengthsPlausible ;
    3 : SeekRepeatSequence ;
    4 : SeekAllRepeatSequences ;
    5 : InverseCheck ;
    6 : CheckYearFrequencies ;
    7 : SimpleLeap ;
    8 : IntervalSpanningYearLengths ;
    9 : YearLengthsInCycles ;
    10 : Calendar ;
    11 : Sextuplets ;
    12 : CurrentMolods ;
    else Help ;
    end ;

  2 : CompareGregAndJulnEasterWithPesach(GetParam(1), GetParam(2)) ;

  3 : DoSpans(GetParam(1), GetParam(2), GetParam(3)) ;

  else Writeln('Wrong number of parameters.') end ;

Write('<Enter> ? ') ; Readln   ;
END.