' =============================================================================
'                   Source code: PowerBASIC for DOS
'
'           Author: Egbert Zijlema (e.zylema@castel.nl)
' Copyright status: Public Domain
'
' Displays the celebration days for a given year.
' Additionally performs a browsable (monthly) calendar.
' Screen text is in 1 out of 6 languages: English, German,
' French, Spanish, Swedish or Dutch.

' Using DOS' country information, the program pre-selects one
' of these languages for the following countries:
' Belgium, The Netherlands: Dutch
' Sweden: Swedish
' Spain, Mexico, Latin America: Spanish
' France, French Canada: French
' Germany, Austria, Switzerland: German
' All other countries: English

' You may alter this choice (use key F4). This is especially useful
' for Swish and Belgian users when they prefer French above the
' program's choice, which is arbitrary indeed. Choosing
' a different language does not change the delimiter within
' DATE$ (hyphen, slash, dot or whatsoever). When the delimiter
' appears to be wrong, you should check your CONFIG.SYS file for
' correct COUNTRY settings.

' Note: COUNTRY.TXT in the DOS(6.22) directory provides
' information on this matter.

' Related article at: http://www.basicguru.com/zijlema/julian.htm
' =============================================================================

DEFINT A - Z                          ' all variables integer, unless tagged
DIM days(1 : 6, 1 : 7) AS SHARED STRING
DIM months (1 : 6, 1 : 12) AS SHARED STRING
DIM ScreenText(1 : 6, 1 : 13) AS SHARED STRING
DIM HelpText(1 : 6, 1 : 10) AS SHARED STRING
DIM DateScr AS SHARED STRING
DIM TimeScr AS SHARED STRING
DIM HelpScr AS SHARED STRING
DIM LangScr AS SHARED STRING
DIM lang AS SHARED INTEGER            ' language flag
DIM ScrnSeg AS SHARED INTEGER

IF (pbvScrnCard AND 1) = 0 THEN
  ScrnSeg = &HB800
  SCREEN 0, 0, 1, 0
ELSE
  ScrnSeg = &HB000
END IF

%ALTX = 45 * 256 : %F1   = 59 * 256 : %F2    = 60 * 256 : %F3   = 61 * 256
%F4   = 62 * 256 : %F5   = 63 * 256 : %HOME  = 71 * 256 : %UP   = 72 * 256
%PGUP = 73 * 256 : %LEFT = 75 * 256 : %RIGHT = 77 * 256 : %DOWN = 80 * 256
%PGDN = 81 * 256

' main
  Languages
  BackGroundScreens
  DateAndTimeScreen
  FrontDoor
  Menu
END

SUB Languages
  GetCountryInfo country, 0, ""       ' which country?
  SELECT CASE country
    CASE 31, 32     : lang = 1        ' Netherlands/Belgium
    CASE 2, 33      : lang = 2        ' French Canada/France
    CASE 34, 52, 3  : lang = 3        ' Spain/Mexico/Latin America
    CASE 41, 43, 49 : lang = 5        ' Switzerland/Austria/Germany
    CASE 46         : lang = 6        ' Swedish
    CASE ELSE       : lang = 4        ' default to English
  END SELECT

  ' dutch
  days(1, 1) = "maan"   : days(1, 2) = "dins"
  days(1, 3) = "woens"  : days(1, 4) = "donder"
  days(1, 5) = "vrij"   : days(1, 6) = "zater"
  days(1, 7) = "zon"

  months(1, 1)  = "januari"   : months(1, 2)  = "februari"
  months(1, 3)  = "maart"     : months(1, 4)  = "april"
  months(1, 5)  = "mei"       : months(1, 6)  = "juni"
  months(1, 7)  = "juli"      : months(1, 8)  = "augustus"
  months(1, 9)  = "september" : months(1, 10) = "oktober"
  months(1, 11) = "november"  : months(1, 12) = "december"

  ScreenText(1, 1)  = "Datum: "
  ScreenText(1, 2)  = "Week : "
  ScreenText(1, 3)  = "Tijd : "
  ScreenText(1, 4)  = "Nieuwjaarsdag"
  ScreenText(1, 5)  = "Goede Vrijdag"
  ScreenText(1, 6)  = "Eerste Paasdag"
  ScreenText(1, 7)  = "Tweede Paasdag"
  ScreenText(1, 8)  = "Hemelvaartsdag"
  ScreenText(1, 9)  = "Pinksterzondag"
  ScreenText(1, 10) = "Pinkstermaandag"
  ScreenText(1, 11) = "Eerste Kerstdag"
  ScreenText(1, 12) = "Tweede Kerstdag"
  ScreenText(1, 13) = " v.C."

  HelpText(1, 1)  = "Hulp"
  HelpText(1, 2)  = "Datum"
  HelpText(1, 3)  = "Tijd"
  HelpText(1, 4)  = "Taal"
  HelpText(1, 5)  = "Feestdagen"
  HelpText(1, 6)  = "Maand"
  HelpText(1, 7)  = "Jaar"
  HelpText(1, 8)  = "Vandaag"
  HelpText(1, 9)  = "Afsluiten"
  HelpText(1, 10) = "Eeuw"

  ' french
  days(2, 1) = "lundi"     : days(2, 2) = "mardi"
  days(2, 3) = "mercredi"  : days(2, 4) = "jeudi"
  days(2, 5) = "vendredi"  : days(2, 6) = "samedi"
  days(2, 7) = "dimanche"

  months(2, 1)  = "janvier"   : months(2, 2)  = "f" + CHR$(130) + "vrier"
  months(2, 3)  = "mars"      : months(2, 4)  = "avril"
  months(2, 5)  = "mai"       : months(2, 6)  = "juin"
  months(2, 7)  = "juillet"   : months(2, 8)  = "ao" + CHR$(150) + "t"
  months(2, 9)  = "septembre" : months(2, 10) = "octobre"
  months(2, 11) = "novembre"  : months(2, 12) = "d" + CHR$(130) + "cembre"

  ScreenText(2, 1)  = "Date   : "
  ScreenText(2, 2)  = "Semaine: "
  ScreenText(2, 3)  = "Heure  : "
  ScreenText(2, 4)  = "Jour de l'An"
  ScreenText(2, 5)  = "Vendredi saint"
  ScreenText(2, 6)  = "P" + CHR$(131) + "ques"
  ScreenText(2, 7)  = "Lundi de " + ScreenText(2, 6)
  ScreenText(2, 8)  = "Ascension"
  ScreenText(2, 9)  = "Pentec" + CHR$(147) + "te"
  ScreenText(2, 10) = "Lundi de " + ScreenText(2, 9)
  ScreenText(2, 11) = "No" + CHR$(137, 108)
  ScreenText(2, 12) = "Lendemain de " + ScreenText(2, 11)
  ScreenText(2, 13) = " a.C."

  HelpText(2, 1)  = "Assistance"
  HelpText(2, 2)  = "Date"
  HelpText(2, 3)  = "Heure"
  HelpText(2, 4)  = "Langue "
  HelpText(2, 5)  = "F" + CHR$(136) + "tes"
  HelpText(2, 6)  = "Mois"
  HelpText(2, 7)  = "An"
  HelpText(2, 8)  = "Aujourd'hui"
  HelpText(2, 9)  = "Quitter"
  HelpText(2, 10) = "Si" + CHR$(138) + "cle"

  ' spanish
  days(3, 1) = "lunes"     : days(3, 2) = "martes"
  days(3, 3) = "miercoles" : days(3, 4) = "jueves"
  days(3, 5) = "viernes"   : days(3, 6) = "sabado"
  days(3, 7) = "domingo"

  months(3, 1)  = "enero"      : months(3, 2)  = "febrero"
  months(3, 3)  = "marzo"      : months(3, 4)  = "abril"
  months(3, 5)  = "mayo"       : months(3, 6)  = "junio"
  months(3, 7)  = "julio"      : months(3, 8)  = "agosto"
  months(3, 9)  = "septiembre" : months(3, 10) = "octubre"
  months(3, 11) = "noviembre"  : months(3, 12) = "diciembre"

  ScreenText(3, 1)  = "Fecha : "
  ScreenText(3, 2)  = "Semana: "
  ScreenText(3, 3)  = "Hora  : "
  ScreenText(3, 4)  = "A" + CHR$(164) + "o nuevo"
  ScreenText(3, 5)  = "Viernes santo"
  ScreenText(3, 6)  = "Pascua"
  ScreenText(3, 7)  = "Lunes de " + ScreenText(3, 6)
  ScreenText(3, 8)  = "Ascensi" + CHR$(162, 110)
  ScreenText(3, 9)  = "Pentecost" + CHR$(130, 115)
  ScreenText(3, 10) = "Lunes de " + ScreenText(3, 9)
  ScreenText(3, 11) = "Navidad"
  ScreenText(3, 12) = "San Stefano"
  ScreenText(3, 13) = " a.C."

  HelpText(3, 1)  = "Ayuda"
  HelpText(3, 2)  = "Fecha"
  HelpText(3, 3)  = "Hora"
  HelpText(3, 4)  = "Lengua"
  HelpText(3, 5)  = "Festivos"
  HelpText(3, 6)  = "Mes"
  HelpText(3, 7)  = "A" + CHR$(164) +"o"
  HelpText(3, 8)  = "Hoy"
  HelpText(3, 9)  = "Salida"
  HelpText(3, 10) = "Siglo"

  ' english
  days(4, 1) = "Monday"    : days(4, 2) = "Tuesday"
  days(4, 3) = "Wednesday" : days(4, 4) = "Thursday"
  days(4, 5) = "Friday"    : days(4, 6) = "Saturday"
  days(4, 7) = "Sunday"

  months(4, 1)  = "January"   : months(4, 2)  = "February"
  months(4, 3)  = "March"     : months(4, 4)  = "April"
  months(4, 5)  = "May"       : months(4, 6)  = "June"
  months(4, 7)  = "July"      : months(4, 8)  = "August"
  months(4, 9)  = "September" : months(4, 10) = "October"
  months(4, 11) = "November"  : months(4, 12) = "December"

  ScreenText(4, 1)  = "Date: "
  ScreenText(4, 2)  = "Week: "
  ScreenText(4, 3)  = "Time: "
  ScreenText(4, 4)  = "New Year"
  ScreenText(4, 5)  = "Good Friday"
  ScreenText(4, 6)  = "Easter Sunday"
  ScreenText(4, 7)  = "Easter Monday"
  ScreenText(4, 8)  = "Ascension day"
  ScreenText(4, 9)  = "Whit Sunday"
  ScreenText(4, 10) = "Whit Monday"
  ScreenText(4, 11) = "Christmas day"
  IF country = 44 THEN
    ScreenText(4, 12) = "Boxing Day"                  ' United Kingdom
  ELSE
    ScreenText(4, 12) = "St. Stephen's Day"           ' other countries
  END IF
  ScreenText(4, 13) = " b.C."

  HelpText(4, 1)  = "Help"
  HelpText(4, 2)  = "Date"
  HelpText(4, 3)  = "Time"
  HelpText(4, 4)  = "Language"
  HelpText(4, 5)  = "Celebr. days"
  HelpText(4, 6)  = "Month"
  HelpText(4, 7)  = "Year"
  HelpText(4, 8)  = "Today"
  HelpText(4, 9)  = "Quit"
  HelpText(4, 10) = "Century"

  ' german
  days(5, 1) = "Montag"    : days(5, 2) = "Dienstag"
  days(5, 3) = "Mittwoch"  : days(5, 4) = "Donnerstag"
  days(5, 5) = "Freitag"   : days(5, 6) = "Samstag"
  days(5, 7) = "Sonntag"

  months(5, 1)  = "Januar"               : months(5, 2)  = "Februar"
  months(5, 3)  = "M" + CHR$(132) + "rz" : months(5, 4)  = "April"
  months(5, 5)  = "Mai"                  : months(5, 6)  = "Juni"
  months(5, 7)  = "Juli"                 : months(5, 8)  = "August"
  months(5, 9)  = "September"            : months(5, 10) = "Oktober"
  months(5, 11) = "November"             : months(5, 12) = "Dezember"

  ScreenText(5, 1)  = "Datum: "
  ScreenText(5, 2)  = "Woche: "
  ScreenText(5, 3)  = "Zeit : "
  ScreenText(5, 4)  = "Neu Jahr"
  ScreenText(5, 5)  = "Karfreitag"
  ScreenText(5, 6)  = "Ostersonntag"
  ScreenText(5, 7)  = "Ostermontag"
  SELECT CASE country
    CASE 41
      ScreenText(5, 8)  = "Auffahrt"             ' Switzerland
      ScreenText(5, 12) = "Stephanstag"
    CASE 43
      ScreenText(5, 8)  = "Christi Himmelfahrt"  ' Austria
      ScreenText(5, 12) = "Stephanstag"
    CASE ELSE
      ScreenText(5, 8)  = "Himmelfahrt"          ' Germany
      ScreenText(5, 12) = "2. Weihnachtsfeiertag"
  END SELECT
  ScreenText(5, 9)  = "Pfingstsonntag"
  ScreenText(5, 10) = "Pfingstmontag"
  ScreenText(5, 11) = "Weihnachten"
  ScreenText(5, 13) = " v.C."

  HelpText(5, 1)  = "Hilfe"
  HelpText(5, 2)  = "Datum"
  HelpText(5, 3)  = "Zeit"
  HelpText(5, 4)  = "Sprache"
  HelpText(5, 5)  = "Feiertage"
  HelpText(5, 6)  = "Monat"
  HelpText(5, 7)  = "Jahr"
  HelpText(5, 8)  = "Heute"
  HelpText(5, 9)  = "Ende"
  HelpText(5, 10) = "Jahr100"

  ' swedish
  days(6, 1) = CHR$(109, 134, 110)
  days(6, 2) = "tis"  : days(6, 3) = "ons"
  days(6, 4) = "tors" : days(6, 5) = "fre"
  days(6, 6) = CHR$(108, 148, 114)
  days(6, 7) = CHR$(115, 148, 110)

  FOR count = 1 TO 12
    months(6, count) = months(1, count)
  NEXT
  months(6, 3)  = "mars"
  months(6, 5)  = "maj"
  months(6, 8)  = "augusti"

  ScreenText(6, 1)  = "Daterar: "
  ScreenText(6, 2)  = "Vecka  : "
  ScreenText(6, 3)  = "Dags   : "
  ScreenText(6, 4)  = "Ny" + CHR$(134) + "rdag"
  ScreenText(6, 5)  = "L" + CHR$(134) + "ngfredag"
  ScreenText(6, 6)  = "P" + CHR$(134) + "skdag"
  ScreenText(6, 7)  = "Annandag P" + CHR$(134) + "sk"
  ScreenText(6, 8)  = "Kristi Himmelf" + CHR$(132) + "rdsdag"
  ScreenText(6, 9)  = "Pingstdag"
  ScreenText(6, 10) = "Annandag Pingst"
  ScreenText(6, 11) = "Juldag"
  ScreenText(6, 12) = "Annandag Jul"
  ScreenText(6, 13) = " f.Kr."

  HelpText(6, 1)  = "Assistens"
  HelpText(6, 2)  = "Daterar"
  HelpText(6, 3)  = "Dags"
  HelpText(6, 4)  = "Spr" + CHR$(134, 107)
  HelpText(6, 5)  = "Helgdagar"
  HelpText(6, 6)  = "M" + CHR$(134) + "nad"
  HelpText(6, 7)  = CHR$(143, 114)
  HelpText(6, 8)  = "Idag"
  HelpText(6, 9)  = "Slutar"
  HelpText(6, 10) = "Sekel"
END SUB

SUB BackGroundScreens
  IF ScrnSeg = &HB800 THEN offset = 4096 ELSE offset = 0

  ' 1. help screen
  RefreshHelp
  DEF SEG = ScrnSeg
  HelpScr = PEEK$(offset, 4000)
  DEF SEG
  CLS

  ' 2. date modification screen
  IF ScrnSeg = &HB800 THEN
    fg = 11 : bg = 4
  END IF
  box 9, 48, 9, 24, 15, bg
  COLOR 15, bg
  LOCATE  9, 50 : PRINT " [  -    ] "
  COLOR fg
  LOCATE 11, 48 : PRINT CHR$(25)
  LOCATE 16, 71 : PRINT CHR$(24)
  LOCATE 17, 50 : PRINT CHR$(32, 27, 32)
  LOCATE 17, 57 : PRINT " Pg"; CHR$(24, 25, 32)
  LOCATE 17, 67 : PRINT CHR$(32, 26, 32)
  RefreshCal DATE$
  DEF SEG = ScrnSeg
  DateScr = PEEK$(offset, 4000)
  DEF SEG
  COLOR 7, 0 : CLS

  ' 3. language menuscreen
  box 10, 53, 8, 14, 15, 0
  LOCATE 11, 53 : PRINT CHR$(25)
  LOCATE 16, 66 : PRINT CHR$(24)
  RefreshLang lang
  DEF SEG = ScrnSeg
  LangScr = PEEK$(offset, 4000)
  DEF SEG
  CLS

  ' 4. time menuscreen
  GetCountryInfo 0, 0, buffer$
  box 12, 53, 3, 4, 15, 0
  box 12, 58, 3, 4, 15, 0
  box 12, 63, 3, 4, 15, 0
  FOR colm = 56 TO 66 STEP 5
    LOCATE 13, colm : PRINT CHR$(18)
  NEXT
  LOCATE 13, 57 : PRINT MID$(buffer$, 14, 1)
  LOCATE 13, 62 : PRINT MID$(buffer$, 14, 1)
  LOCATE 14, 57 : PRINT CHR$(29)
  LOCATE 14, 62 : PRINT CHR$(29)
  COLOR 0, 7
  LOCATE 13, 54 : PRINT SPACE$(2)
  DEF SEG = ScrnSeg
  TimeScr = PEEK$(offset, 4000)
  DEF SEG
  SCREEN 0, 0, 0, 0
END SUB

SUB RefreshHelp
  REDIM CommonText$ (1 : 10)
  CommonText$(1)  = "     F1"
  CommonText$(2)  = "     F2"
  CommonText$(3)  = "     F3"
  CommonText$(4)  = "     F4"
  CommonText$(5)  = "     F5"
  CommonText$(6)  = SPACE$(4) + CHR$(27, 32, 26)
  CommonText$(7)  = SPACE$(4) + CHR$(25, 32, 24)
  CommonText$(8)  = "   Home"
  CommonText$(9)  = "  Alt-x"
  CommonText$(10) = "PgUp/Dn"

  CleanArea 7, 46, 13, 28, 0
  FOR row = 9 TO 18
    COLOR 15, 0
    LOCATE row, 50 : PRINT CommonText$(row - 8)
    COLOR 7
    LOCATE row, 57 : PRINT CHR$(58, 32); HelpText(lang, row - 8)
  NEXT
END SUB

SUB DateAndTimeScreen
  SplitDate DATE$, year, month, day
  CleanArea 3, 46, 3, 35, 0
  COLOR 7, 0
  FOR row = 3 TO 5
    LOCATE row, 46 : PRINT ScreenText(lang, row - 2)
  NEXT
  LOCATE 2, 1 : PRINT SPACE$(45)

  column = 46 + LEN(ScreenText(lang, 1))
  temp$ = days(lang, DayOfWeek(year, month, day))
  IF lang = 1 OR lang = 6 THEN temp$ = temp$ + "dag"
  IF lang = 3 THEN between$ = " de " ELSE between$ = CHR$(32)

  COLOR 15
  LOCATE 2, 1
  PRINT UCASE$(MID$(temp$, 1, 1)) + MID$(temp$, 2) + ", " + _
        LTRIM$(STR$(day)) + between$ + months(lang, month) + _
        CHR$(32) + PrintedYear(year)
  LOCATE 3, column     : PRINT CountrySpecificDate(DATE$)
  LOCATE 4, column - 1 : PRINT WeekNum(year, month, day)
END SUB

SUB DisplayCalendar(page, annum)
  IF ScrnSeg = &HB800 THEN
    back = 1 : title = 14
  ELSE
    back = 7
  END IF

  SplitDate DATE$, year, month, day            ' Julian for
  ToDay& = Julian(year, month, day)            '       actual date
  NewY&  = Julian(annum, 1, 1)                 ' Julian for New Year
  Xmas&  = Julian(annum, 12, 25)               ' Julian for Christmas

  CleanArea 11, 1, 9, 43, 0                    ' celebration days area
  COLOR title, back
  CleanArea 4, 1, 7, 43, back                  ' calendar background
  LOCATE 4, 3 : PRINT PrintedYear(annum)
  LOCATE 5, 3 : PRINT months(lang, page)
  col = (DayOfWeek(annum, page, 1) - 1) * 4 + 16
  row = 5 : celebrow = 11
  FOR count = 1 TO DaysInMonth(page, annum)
    match = 0 : record = 0
    sunday? = DayOfWeek(annum, page, count)
    TestDate& = Julian(annum, page, count)
    IF sunday? = 7 THEN match = -1             ' sundays intense
    IF annum > 324 THEN
      SELECT CASE TestDate&
        CASE NewY&               : record = 4
        CASE GoodFriday(annum)   : record = 5
        CASE EasterSunday(annum) : record = 6
        CASE EasterMonday (annum): record = 7
        CASE AscensionDay(annum) : record = 8
        CASE WhitSunday(annum)   : record = 9
        CASE WhitMonday (annum)  : record = 10
        CASE Xmas&               : record = 11
        CASE Xmas& + 1           : record = 12
      END SELECT
    END IF

    ' display public holidays of this month - if any
    IF record THEN
      match = -1
      COLOR 15, 0
      LOCATE celebrow,  1 : PRINT ScreenText(lang, record)
      LOCATE celebrow, 24 : PRINT RIGHT$(SPACE$(2) + _
                            LTRIM$(RTRIM$(STR$(count))), 2)
      INCR celebrow
    END IF

    IF ScrnSeg = &HB800 THEN
      fore = 7
      IF match THEN INCR fore, 8
    END IF
    IF TestDate& = ToDay& THEN
      COLOR back, fore                         ' actual date inverse
    ELSE
      COLOR fore, back
    END IF
    LOCATE row, col
    IF Julian(annum, page, count) < 1 THEN
      PRINT SPACE$(2)
    ELSE
      PRINT RIGHT$(SPACE$(2) + LTRIM$(RTRIM$(STR$(count))), 2)
    END IF
    INCR col, 4
    IF col = 44 THEN
      col = 16 : INCR row
    END IF
  NEXT
END SUB

SUB celebrations(yr, mth)
  DEF SEG = ScrnSeg
  OldScreen$ = PEEK$(0, 4000)
  DEF SEG
  CleanArea 11, 1, 9, 43, 0
  COLOR 7, 0
  FOR row = 11 TO 19
    LOCATE row, 1 : PRINT ScreenText(lang, row - 7)
  NEXT
  LOCATE 11, 24 : PRINT conversion(Julian(yr, 1, 1), mth, 11)
  LOCATE 12, 24 : PRINT conversion(GoodFriday(yr), mth, 12)
  LOCATE 13, 24 : PRINT conversion(EasterSunday(yr), mth, 13)
  LOCATE 14, 24 : PRINT conversion(EasterMonday(yr), mth, 14)
  LOCATE 15, 24 : PRINT conversion(AscensionDay(yr), mth, 15)
  LOCATE 16, 24 : PRINT conversion(WhitSunday(yr), mth, 16)
  LOCATE 17, 24 : PRINT conversion(WhitMonday(yr), mth, 17)
  LOCATE 18, 24 : PRINT conversion(Julian(yr, 12, 25), mth, 18)
  LOCATE 19, 24 : PRINT conversion(Julian(yr, 12, 26), mth, 19)
  dummy = GetKey
  DEF SEG = ScrnSeg
  POKE$ 0, OldScreen$
  DEF SEG
END SUB

FUNCTION conversion(celebrat&, mth, row) AS STRING
  temp$ = JulToDate(celebrat&)
  dai$  = MID$(temp$, 4, 2) + CHR$(32)
  IF LEFT$(dai$, 1) = "0" THEN dai$ = CHR$(32) + MID$(dai$,2)
  month = VAL(MID$(temp$, 1, 2))

  ' make holidays of actual month intense
  IF month = mth THEN
    offset = (row - 1) * 160 + 1                    ' color offset
    DEF SEG = ScrnSeg
    FOR count = offset TO offset + 84 STEP 2
      POKE count, 15
    NEXT
    DEF SEG
    COLOR 15
  ELSE
    COLOR 7
  END IF
  FUNCTION = dai$ + months(lang, month)
END FUNCTION

FUNCTION PrintedYear(BYVAL year) AS STRING
  IF year < 1 THEN
    DECR year : extension$ = ScreenText(lang, 13)
  END IF
  FUNCTION = LTRIM$(RTRIM$(STR$(ABS(year)))) + extension$
END FUNCTION

FUNCTION header(blanks AS BYTE) AS STRING
  IF blanks = 2 THEN temp$ = SPACE$(15)
  FOR count = 1 TO 7
    temp$ = temp$ + LEFT$(days(lang, count), 2) + SPACE$(blanks)
  NEXT
  FUNCTION = temp$
END FUNCTION

SUB InsertHeaders(mnth)
  IF ScrnSeg = &HB800 THEN
    back = 1 : title = 14 : attri = 15 + 64
  ELSE
    back = 7 : title =  0 : attri = 15
  END IF

  COLOR title, back
  LOCATE 3, 1 : PRINT header(2)
  temp$ = header(1)
  FOR count = 1 TO LEN(temp$)
    head$ = head$ + MID$(temp$, count, 1) + MKBYT$(attri)
  NEXT
  MID$(DateScr, 1539, LEN(head$)) = head$
END SUB

SUB FrontDoor
  IF ScrnSeg = &HB800 THEN
    fg = 9 : txt = 12
  END IF
  box 7, 46, 14, 28, fg, 7
  box 8, 46, 12, 14, fg, 7
  box 8, 60, 12, 14, fg, 7
  FOR row = 8 TO 19 STEP 11
    LOCATE row, 46 : PRINT CHR$(204)
    LOCATE row, 73 : PRINT CHR$(185)
  NEXT
  LOCATE 14, 59 : PRINT CHR$(8, 8)

  box  9, 48, 10, 9, fg, 7
  box 10, 51,  8, 3, fg, 7
  box  9, 63, 10, 9, fg, 7
  box 10, 66,  8, 3, fg, 7
  COLOR txt, 7
  text$ = "EGBERT"
  FOR count = 1 TO LEN(text$)
    LOCATE 10 + count, 52 : PRINT MID$(text$, count, 1)
  NEXT
  text$ = "ZYLEMA"
  FOR count = 1 TO LEN(text$)
    LOCATE 10 + count, 67 : PRINT MID$(text$, count, 1)
  NEXT
END SUB

FUNCTION GetKey AS INTEGER
  column = 46 + LEN(ScreenText(lang, 1))
  DO
    COLOR 15, 0
    LOCATE 5, column
    PRINT CountrySpecificTime;
    COLOR 7
    PRINT " ("; TwelveTime; ") "
  LOOP UNTIL INSTAT
  pressed = CVI(INKEY$ + CHR$(0))
  IF pressed = %ALTX THEN TheEnd ELSE FUNCTION = pressed
END FUNCTION

SUB TheEnd
  COLOR 7, 0       ' restore DOS default
  CLS
  SYSTEM
END SUB

SUB Menu
  SplitDate DATE$, annum, page, 0
  InsertHeaders page
  DisplayCalendar page, annum
  KeyIn = -1
  DO
    OldPage = page
    OldAnnum = annum
    IF KeyIn = -1 THEN KeyIn = %F1 ELSE KeyIn = GetKey
    SELECT CASE KeyIn
      CASE %F1
        OpenCurtain 8, 46, 12, 28, 22, HelpScr, curtain$
        dummy = GetKey
        CloseCurtain 8, 46, 12, 28, 22, curtain$
      CASE %F2
        OldDate$ = DATE$
        OpenCurtain 8, 46, 12, 28, 26, DateScr, curtain$
        SetDateMenu
        CloseCurtain 8, 46, 12, 28, 26, curtain$
        IF DATE$ <> OldDate$ THEN
          OldDate$ = DATE$
          SplitDate DATE$, annum, page, 0
          DateAndTimeScreen
          DisplayCalendar page, annum
        END IF
      CASE %F3
        OpenCurtain 8, 46, 12, 28, 16, TimeScr, curtain$
        SetTimeMenu
        CloseCurtain 8, 46, 12, 28, 16, curtain$
      CASE %F4
        OldLang = lang
        OpenCurtain 8, 46, 12, 28, 16, LangScr, curtain$
        LangMenu
        IF lang <> OldLang THEN
          RefreshHelp
          DEF SEG = ScrnSeg
          HelpScr = PEEK$(0, 4000)
          DEF SEG
          InsertHeaders page
          DateAndTimeScreen
          DisplayCalendar page, annum
          FrontDoor
        ELSE
          CloseCurtain 8, 46, 12, 28, 16, curtain$
        END IF
      CASE %F5
        celebrations annum, page
      CASE %LEFT
        DECR page
        IF page <1 THEN
          page = 12
          DECR annum
        END IF
      CASE %RIGHT
        INCR page
        IF page > 12 THEN
          page = 1
          INCR annum
        END IF
      CASE %HOME : SplitDate DATE$, annum, page, 0
      CASE %UP   : INCR annum
      CASE %DOWN : DECR annum
      CASE %PGDN : INCR annum, 100
      CASE %PGUP : DECR annum, 100
    END SELECT
    IF (Julian(annum, page, 1) < -23) OR (annum > 9999) THEN
      annum = OldAnnum : page = OldPage
    END IF
    IF (annum <> OldAnnum) OR (page <> OldPage) THEN
      DisplayCalendar page, annum
    END IF
  LOOP UNTIL KeyIn = %ALTX
  TheEnd
END SUB

SUB OpenCurtain(row, col, rows, cols, howmany, bg$, curtn$)
  ' row     = first row to open
  ' rows    = number of rows
  ' col     = utmost left column
  ' cols    = width of the screen to manipulate
  ' howmany = number of colums to "open"  - maximum = cols
  ' bg$     = backgroundscreen (prepared in advance)
  ' curtn$  = param (returns screen array in order to
  '           enable a proper close)

  DEF SEG = ScrnSeg
  curtn$  = PEEK$(0, 4000)                            ' save screen
  DEF SEG
  DO
    CurtainDelay                                      ' pause
    INCR offs, 2                                      ' step 2 for offset
    FOR count = row TO row + rows - 1
      offset = (count - 1) * 160 + (col - 1) * 2 + 2  ' screen offset
      bgof = offset + cols - 1 - offs                 ' offset for backgr
      temp$  = MID$( curtn$, offset + offs + 1, 2 * (cols - 2 - offs) )
      length = LEN(temp$) \ 2
      DEF SEG = ScrnSeg
      POKE$ offset, LEFT$(temp$, length) + MID$(bg$, bgof, 2 * offs) + _
                    RIGHT$(temp$, length)
      DEF SEG
    NEXT
  LOOP UNTIL offs = howmany
END SUB

SUB CurtainDelay
  start! = TIMER
  DO
    now! = TIMER
    IF now! < start! THEN INCR now!, 86400   ' midnight pass
  LOOP UNTIL now! > start!                   ' smallest possible difference
END SUB

SUB CloseCurtain(row, col, rows, cols, howmany, curtn$)
  DO
    CurtainDelay
    FOR count = row TO row + rows - 1
      offset = (count - 1) * 160 + (col - 1) * 2
      temp$  = MID$(curtn$, offset + howmany + 1, 2 * (cols - howmany))
      length = LEN(temp$) \ 2
      rofset = offset + length + 2 * (howmany - 1)

      DEF SEG = ScrnSeg
      POKE$ offset + 2, LEFT$(temp$, length)
      POKE$ rofset, RIGHT$(temp$, length)
      DEF SEG
    NEXT
    DECR howmany, 2
  LOOP UNTIL howmany = 0
END SUB

SUB SetTimeMenu
  horiz = 1
  hour = VAL(LEFT$(TIME$, 2))
  mint = VAL(MID$(TIME$, 4, 2))
  secd = VAL(MID$(TIME$, 7))
  GOSUB EditTime

  DO
    arrow = GetKey
    SELECT CASE arrow
      CASE %UP
        SELECT CASE horiz
          CASE 1 : IF hour < 23 THEN INCR hour
          CASE 2 : IF mint < 59 THEN INCR mint
          CASE 3 : IF secd < 59 THEN INCR secd
        END SELECT
      CASE %DOWN
        SELECT CASE horiz
          CASE 1 : IF hour > 0 THEN DECR hour
          CASE 2 : IF mint > 0 THEN DECR mint
          CASE 3 : IF secd > 0 THEN DECR secd
        END SELECT
      CASE %LEFT
        DECR horiz
        IF horiz < 1 THEN horiz = 3
      CASE %RIGHT
        INCR horiz
        IF horiz > 3 THEN horiz = 1
      CASE 27 : EXIT SUB                        ' no change
    END SELECT
    GOSUB EditTime
  LOOP UNTIL arrow = 13
  TIME$ = hour$ + ":" + mint$ + ":" + secd$     ' default delimiter here
  EXIT SUB

EditTime:
  hour$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(hour))), 2)
  IF horiz = 1 THEN COLOR 0, 7 ELSE COLOR 7, 0
  LOCATE 13, 54 : PRINT hour$
  mint$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(mint))), 2)
  IF horiz = 2 THEN COLOR 0, 7 ELSE COLOR 7, 0
  LOCATE 13, 59 : PRINT mint$
  secd$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(secd))), 2)
  IF horiz = 3 THEN COLOR 0, 7 ELSE COLOR 7, 0
  LOCATE 13, 64 : PRINT secd$
  RETURN
END SUB

SUB SetDateMenu
  SplitDate DATE$, year, month, day
  CalendarDate& = Julian(year, month, day)
  DO
    OldDate& = CalendarDate&
    KeyIn = GetKey
    SELECT CASE KeyIn
      CASE %RIGHT : INCR CalendarDate&
      CASE %LEFT  : DECR CalendarDate&
      CASE %UP    : DECR CalendarDate&, 7
      CASE %DOWN  : INCR CalendarDate&, 7
      CASE %PGUP, %PGDN
        SplitDate JulToDate(CalendarDate&), year, month, day
        IF KeyIn = %PGUP THEN
          DECR month
          IF month < 1 THEN
            month = 12 : DECR year
          END IF
        ELSE
          INCR month
          IF month > 12 THEN
            month = 1 : INCR year
          END IF
        END IF
        CalendarDate& = Julian(year, month, day)
      CASE 27   : EXIT SUB
    END SELECT
    IF CalendarDate& > Julian(2099, 12, 31) OR _
       CalendarDate& < Julian(1980, 1, 1) THEN CalendarDate& = OldDate&
    NewDate$ = JulToDate(CalendarDate&)
    IF CalendarDate& <> OldDate& THEN RefreshCal NewDate$
  LOOP UNTIL KeyIn = 13
  DEF SEG = ScrnSeg
  DateScr = PEEK$(0, 4000)
  DEF SEG
  DATE$ = NewDate$
END SUB

SUB RefreshCal(InDate$)
  SplitDate InDate$, year, month, day
  IF ScrnSeg = &HB800 THEN bg = 4
  CleanArea 11, 50, 6, 20, bg
  COLOR 15, bg
  LOCATE  9, 52 : PRINT RIGHT$(SPACE$(2) + LTRIM$(RTRIM$(STR$(month))), 2)
  LOCATE  9, 55 : PRINT PrintedYear(year)
  col = (DayOfWeek(year, month, 1) - 1) * 3 + 50
  row  = 11
  FOR count = 1 TO DaysInMonth(month, year)
    IF count = day THEN COLOR bg, 7 ELSE COLOR 7, bg
    LOCATE row, col
    PRINT RIGHT$(SPACE$(2) + LTRIM$(RTRIM$(STR$(count))), 2)
    INCR col, 3
    IF col = 71 THEN
      col = 50 : INCR row
    END IF
  NEXT
END SUB

SUB box(row, col, rows, cols, fg, bg)
  COLOR fg, bg
  LOCATE row, col : PRINT CHR$(201); STRING$(cols - 2, 205); CHR$(187);
  FOR count = row + 1 TO row + rows - 2
    LOCATE count, col
    PRINT CHR$(186); SPACE$(cols - 2); CHR$(186);
  NEXT
  LOCATE row + rows - 1, col
  PRINT CHR$(200); STRING$(cols - 2, 205); CHR$(188);
END SUB

SUB CleanArea(row, col, rows, cols, backgr)
  COLOR , backgr
  FOR count = row TO row + rows - 1
    LOCATE count, col : PRINT SPACE$(cols);
  NEXT
END SUB

SUB LangMenu
  NewLang = lang
  DO
    modified = -1
    arrow = GetKey
    SELECT CASE arrow
      CASE %UP
        DECR NewLang
        IF NewLang < 1 THEN NewLang = 6
      CASE %DOWN
        INCR NewLang
        IF NewLang > 6 THEN NewLang = 1
      CASE 27   : EXIT SUB
      CASE ELSE : modified = 0
    END SELECT
    IF modified THEN RefreshLang NewLang
  LOOP UNTIL arrow = 13
  lang = NewLang
  DEF SEG = ScrnSeg
  LangScr = PEEK$(0, 4000)
  DEF SEG
END SUB

SUB RefreshLang(langue)
  REDIM language$(1 : 6)
  language$(1) = " Nederlands "
  language$(2) = " Fran" + CHR$(135) + "ais   "
  language$(3) = " Espa" + CHR$(164) + "ol    "
  language$(4) = " English    "
  language$(5) = " Deutsch    "
  language$(6) = " Svenska    "
  FOR row = 11 TO 16
    IF langue = row - 10 THEN COLOR 0, 7 ELSE COLOR 15, 0
    LOCATE row, 54 : PRINT language$(row - 10)
  NEXT
END SUB

' the above section is only ment to run this program adequately
' the following FUNCTIONS & SUBS maybe saved seperately as
' an $INCLUDE-file to fit in your own date & time programs

' ------------  CUT HERE FOR LIBRARY -------------------

SUB GetCountryInfo(country, format, buffer$)
  ' results depend on correct COUNTRY setting in CONFIG.SYS

  buffer$ = SPACE$(64)                ' information buffer
  REG 8, STRSEG(buffer$)              ' DS = segment of buffer
  REG 4, STRPTR(buffer$)              ' DX = offset of buffer
  REG 1, &H3800                       ' AX = service
  CALL INTERRUPT &H21                 ' fill buffer$
  format = ASC(buffer$)               ' date format (1 out of 3) = 1st byte
  country = REG(2)                    ' shared country flag
END SUB

FUNCTION CountrySpecificDate(BYVAL InDate$) AS STRING
  ' InDate$ as MM-DD-[-]YYYY (= default format)

  SplitDate InDate$, year, month, day
  IF year < 1 THEN                            ' year zero correction
    DECR year
    year = ABS(year)
    negative$ = "-"                           ' don't mixup with delimiter
  END IF
  yr$ = negative$ + _
        RIGHT$("0000" + LTRIM$(RTRIM$(STR$(year))), 4)
  mt$ = MID$(InDate$, 1, 2)
  da$ = MID$(InDate$, 4, 2)

  GetCountryInfo 0, form, buffer$
  dl$ = MID$(buffer$, 12, 1)                  ' delimiter = 12th byte
  SELECT CASE form
    CASE 0
      FUNCTION = mt$ + dl$ + da$ + dl$ + yr$  ' USA
    CASE 1
      FUNCTION = da$ + dl$ + mt$ + dl$ + yr$  ' EUR
    CASE 2
      FUNCTION = yr$ + dl$ + mt$ + dl$ + da$  ' JAP
  END SELECT
END FUNCTION

FUNCTION CountrySpecificTime AS STRING
  ' Are there countries anyway, NOT using the default delimiter
  ' in TIME$? Not sure! Did'nt find any, but you never can tell.

  t$ = TIME$
  GetCountryInfo 0, 0, buffer$
  REPLACE ":" WITH MID$(buffer$, 14, 1) IN t$  ' local time delimiter

  FUNCTION = t$
END FUNCTION

FUNCTION TwelveTime AS STRING
  hour = VAL(LEFT$(TIME$, 2))
  SELECT CASE hour
    CASE > 11
      IF hour > 12 THEN DECR hour, 12
      extension$ = "p"
    CASE ELSE
      IF hour = 0 THEN hour = 12
      extension$ = "a"
  END SELECT
  FUNCTION = LTRIM$(RTRIM$(STR$(hour))) + _
             MID$(CountrySpecificTime, 3, 3) + extension$    ' omit seconds
END FUNCTION

FUNCTION Julian(BYVAL year, BYVAL month, BYVAL day) AS LONG

  IF month < 3 THEN                      ' January or February?
    INCR month, 12                       ' 13th or 14th month ....
    DECR year                            ' .... of prev. year
  END IF

  Elapsed& = INT(365.25 * (year + 4712)) ' years elapsed

  DECR Elapsed&, INT(year / 100)         ' substract century leapdays
  INCR Elapsed&, INT(year / 400)         ' re-add the valid ones
  INCR Elapsed&, INT(30.6 * (month - 1) + .2) ' months elapsed + adjustm.

  FUNCTION = Elapsed& + day              ' days of final month
END FUNCTION

FUNCTION JulToDate (BYVAL Jul&) AS STRING
  ' converts a Julian number into a computational date ("MM-DD-[-]YYYY")

  INCR Jul&, 68569
  help& = 4 * Jul& \ 146097
  DECR Jul&, (146097 * help& + 3) \ 4
  TempYear& = 4000 * (Jul& + 1) \ 1461001
  DECR Jul&, 1461 * TempYear& \ 4
  INCR Jul&, 31
  TempMonth& = 80 * Jul& \ 2447

  day& = Jul& - (2447 * TempMonth& \ 80)
  day$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(day&))), 2)

  month& = TempMonth& + 2 - (12 * (TempMonth& \ 11))
  month$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(month&))), 2)

  year& = 100 * (help& - 49) + TempYear& + (TempMonth& \ 11)
  year$ = RIGHT$("0000" + LTRIM$(RTRIM$(STR$(ABS(year&)))), 4)
  IF year& < 0 THEN year$ = "-" + year$
  FUNCTION = month$ + "-" + day$ + "-" + year$
END FUNCTION

FUNCTION LeapYear(year)
  OutDate$ = JulToDate(Julian(year, 2, 28) + 1)        ' 28 Feb + 1 day
  IF LEFT$(OutDate$, 5) = "02-29" THEN
    FUNCTION = 1                                       ' 1 extra day for Feb
  ELSE
    FUNCTION = 0
  END IF
END FUNCTION

FUNCTION DayOfWeek(year, month, day) AS BYTE
  ' returns a number for each day of the week
  ' order: 1 = Monday ..... 7 = Sunday

  FUNCTION = Julian(year + 8000, month, day) MOD 7 + 1
END FUNCTION

SUB SplitDate(InDate$, year, month, day)
  year  = VAL(MID$(InDate$, 7))
  month = VAL(MID$(InDate$, 1, 2))
  day   = VAL(MID$(InDate$, 4, 2))
END SUB

FUNCTION WeekNum(year, month, day) AS BYTE
  ' get Julian for Monday of week 1
  Reference&  = Julian(year, 1, 1) - DayOfWeek(year, 1, 1) + 1

  ' get Julian for Monday of actual week
  LastMonday& = Julian(year, month, day) - _
                DayOfWeek(year, month, day) + 1
  week = (LastMonday& - Reference&) \ 7
  INCR week
  IF week = 53 THEN week = 1
  FUNCTION = week
END FUNCTION

FUNCTION DaysInMonth(mnth, yr) AS INTEGER
  dais = 31                                    ' most months have 31 days
  SELECT CASE mnth
    CASE 4, 6, 9, 11                           ' Apr/Jun/Sep/Nov
      DECR dais                                ' minus 1
    CASE 2                                     ' February
      dais = dais - 3 + LeapYear(yr)           ' 28 (+ 1 ?)
  END SELECT
  FUNCTION = dais
END FUNCTION

FUNCTION EasterSunday(year) AS LONG
  temp1 = ((8 * (year \ 100)) + 13) \ 25 : DECR temp1, 2
  leap  = (year \ 100) - (year \ 400) - 2
  temp2 = (15 + leap - temp1) MOD 30
  temp3 = (6 + leap) MOD 7
  days  = ( temp2 + 19 * (year MOD 19) ) MOD 30
  IF (days = 29) OR (days = 28 AND year MOD 19 >= 11) THEN DECR days
  factor = ( 2 * (year MOD 4) + 4 * (year MOD 7) + 6 * days + temp3 ) MOD 7
  INCR days, factor + 21
  FUNCTION = Julian(year, 3, 1) + days       ' 1 March + nbr of days
END FUNCTION

FUNCTION EasterMonday(year) AS LONG
  FUNCTION = EasterSunday(year) + 1
END FUNCTION

FUNCTION GoodFriday(year) AS LONG
  FUNCTION = EasterSunday(year) - 2
END FUNCTION

FUNCTION AscensionDay(year) AS LONG
  FUNCTION = EasterSunday(year) + 39
END FUNCTION

FUNCTION WhitSunday(year) AS LONG
  FUNCTION = EasterSunday(year) + 49
END FUNCTION

FUNCTION WhitMonday(year) AS LONG
  FUNCTION = EasterSunday(year) + 50
END FUNCTION