Calendar from 1562 - 3999

[utopiomania]

Code updated For 5.20+

This is some simple date functions and a crappy (sorry) demo to show how they can be used to create a calendar.
The original uses html to display the calendar together with a picture and links to notes and such. Hope it can be useful.

Code: Select all

    ;Date calculation functions:

    Procedure DaysInMonth(Yr, Mn)
      ;Years 1562-3999, Mn 1-based
      Dim N(12)
      N(0) = 31: N(1) = 28: N(2) = 31: N(3) = 30: N(4) = 31: N(5) = 30
      N(6) = 31: N(7) = 31: N(8) = 30: N(9) = 31: N(10) = 30: N(11) = 31
      N(1) = N(1) + Bool( (Yr % 4 = 0) | (Yr % 100 = 0) & (Yr % 400 = 0))
      ProcedureReturn N(Mn - 1)
    EndProcedure

    Procedure DayInWeek(Yr, Mn, Dy)
      ;Years 1562-3999, Mn/Dy 1-based, 1 is Sunday
      N = Int((14 - Mn) / 12)
      Y = Yr - N
      M = Mn + 12 * N - 2
      D = (Dy + Y + Int(Y / 4) - Int(Y / 100) + Int(Y / 400) + Int(31 * M / 12)) % 7
      ProcedureReturn D + 1
    EndProcedure

    Procedure NumWeeks(Yr, Mn)
      ;Number of weeks (calendar rows) in a month, 4, 5 or 6
      Days = DayInWeek(Yr, Mn, 1) - 1 + DaysInMonth(Yr, Mn)
      If (Days % 7)
        ProcedureReturn Int(Days / 7) + 1
      Else
        ProcedureReturn Int(Days / 7)
      EndIf
    EndProcedure



    ;Crappy demo:
    Dim D.s(8)
    D(0) = "": D(1) = "SUN": D(2) = "MON": D(3) = "TUE"
    D(4) = "WED": D(5) = "THU": D(6) = "FRI": D(7) = "SAT"
    Dim Dt(42)

    OpenConsole()
    ConsoleTitle("Calendar")
    ConsoleColor(8, 15)

    Repeat
      ClearConsole()

      Print("Year (1562 - 3999): "): Year = ValF(Input()):  PrintN("")
      Print("Month (1 - 12)    : "): Month = ValF(Input()):  PrintN("")
       
      Days = NumWeeks(Year, Month)
      First = DayInWeek(Year, Month, 1)
      Last = First + DaysInMonth(Year, Month) - 1

      Date = 1
      For Day = First To Last
        Dt(Day) = Date
        Date + 1
      Next Day

      For Day = 1 To 7
        ConsoleLocate(Day * 8, 4)
        Print(D(Day))
      Next Day

      Weeks = NumWeeks(Year, Month)
      For Week = 1 To Weeks
        For Day = 1 To 7
          Date = (Week - 1) * 7 + Day
          ConsoleLocate(Day * 8, Week * 2 + 4)
          If Dt(Date) <> 0
            Print(Str(Dt(Date)))
          Else
            Print("")     
          EndIf
        Next Day
      Next Week

      ConsoleLocate(1, 22)
      Print("Press <Enter> To quit, Or C <Enter> To Continue...")

      Key.s = UCase(Input())
    Until Key <> "C"

    CloseConsole()
    End
    ;Demo end

[jb]

These date functions are very useful! Thanks for sharing.

[Psychophanta]

What about holidays? there aren't
Aha! i see you have done a calendar for Fred; no holidays
Or better; everyday are holydays
Hi utopiomania
What do you expect this line do?

Code: Select all

  N(1) = N(1) + (Yr % 4 = 0) | (Yr % 100 = 0) | (Yr % 400 = 0) 

It never changes N(1) , which means February always have 28 days
PB <> C

[utopiomania]

No, no holidays for Fred !!

Code: Select all

Dim N(1)

N(0) = 1
Debug(N(0) = N(0) + 2)

Prints 3 which is correct ??

Or:

Code: Select all

Debug (200 % 200 = 0)
Debug (201 % 200 = 0)

Prints 1 and 0, which is also correct.

[Psychophanta]

This way sometimes works, sometimes doesn't. It is not safe because it is not a correct code.

[utopiomania]

This way sometimes works, sometimes doesn't. It is not safe because it is not a correct code.

Heeelp.... I'm sinking... Can someone from the Team here step in and explain ?

[Pupil]

Can't you just do this for now?

Code: Select all

; example
; N(1) = N(1) + (Yr % 4 = 0) | (Yr % 100 = 0) | (Yr % 400 = 0)
; turns into this:

If (Yr % 4 = 0) Or (Yr % 100 = 0) Or (Yr % 400 = 0)
  N(1)+1
EndIf

[Psychophanta]

Pupil,
you forgot to add:

[utopiomania]

Can't you just do this for now?

I give up, I'll see what I can do.

jb, you're welcome !

[blueznl]

i think it's a matter of readablity, i don't know where the limits or logical limits are in pb for these kind of things, but i find them confusing to read

i (personally) think it's better to leave comparisons outside of expressions

to me, old fashioned basic programmer that i am:

variable = expression

an expression is something like a+b+c, it's not a condition in my book such as 'if a = b'

which is one of the reasons you never see me use a+1 instead of a=a+1, although i can live with a++

[Psychophanta]

This is a functional way for your DaysInMonth procedure:

Code: Select all

Procedure.b DaysInMonth(Yr.l,Mn.l)
  ;Years 1562-3999, Mn 1-based
  N.b=PeekB(?months+Mn-1)
  If Mn=2 And ((Yr%4=0 And Yr%100) Or Yr%400=0):N.b+1:EndIf
  ProcedureReturn N.b
  DataSection:months:Data.b 31,28,31,30,31,30,31,31,30,31,30,31:EndDataSection
EndProcedure

[blueznl]

If Mn=2 And ((Yr%4=0 And Yr%100) Or Yr%400=0):N.b+1:EndIf

stick to assembly, psycho

brrr... still brrr....

i'd rather write something like:

Code: Select all

if mn = 2 and ( ( yr % 4 = 0 and yr % 100 <> 0) or yr % 400 = 0)
  n = n+1
endif

then again, it's all preferences, personal et all