home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0210 - 0219 / ibm0210-0219 / ibm0213.tar / ibm0213 / HAM_W32.ZIP / SAMPLES / CALENDAR.CSH < prev    next >
Encoding:
Text File  |  1994-05-12  |  2.7 KB  |  92 lines
  1. #    Print a calendar for the specified month, highlighting today's date.
  2. #    Based on algorithms published in Computer Language magazine,
  3. #    December, 1990.  Used with permission.
  4.  
  5. proc day(jdate)
  6.     # Calculate the day of the month corresponding to a Julian day number.
  7.     local a, b, c, d, e, z, alpha
  8.     @ z = jdate + 1
  9.     # Cope with the Gregorian calendar reform.
  10.     if (z < 2299161) then
  11.         @ a = z
  12.     else
  13.         @ alpha = (z - 1867216.25)//36524.25
  14.         @ a = z + 1 + alpha - alpha//4
  15.     end
  16.     @ b = a + 1524
  17.     @ c = (b - 122.1)//365.25
  18.     @ d = floor(365.25 * c)
  19.     @ e = (b - d)//30.6001
  20.     return b - d - floor(30.6001 * e)
  21. end
  22.  
  23. proc dayofweek(jdate)
  24.     return (jdate + 2) % 7
  25. end
  26.  
  27. proc calendar(month, year)
  28.     # Print a calendar for the specified month
  29.     local b_date, e_date, c_date, day, c_day, c_month, c_year, Month, week
  30.     local m, d, y, i, today
  31.     set Month = January February March April May June ^
  32.         July August September October November December
  33.     set dt = `dt`
  34.     set m = $dt:1
  35.     set d = $dt:2
  36.     set y = $dt:3
  37.     for i = 0 to 11 do
  38.         if (m == substr(Month[i], 1, 3)) break
  39.     end
  40.     @ m = i + 1
  41.     @ today = `julian $m $d $y`
  42.     if (year == '') then
  43.         @ year = y
  44.         if (month == '') @ month = m
  45.     end
  46.     if (month !~ '[0-9]*') then
  47.         @ m = "$lower(month)*"
  48.         for i = 0 to 11 do
  49.             if (lower(Month[i]) =~ m) break
  50.         end
  51.         @ month = i + 1
  52.     end
  53.     # Calculate Julian day numbers for the first and last days of the month
  54.     if ((b_date = julian(month, 1, year)) == -1) return
  55.     @ e_date = (month < 12 ? ^
  56.             julian(month + 1, 1, year) : ^
  57.             julian(1, 1, year == -1 ? 1 : year + 1)) - 1
  58.     echo $Month[month - 1] $year
  59.     @ week = "^r^nSun Mon Tue Wed Thu Fri Sat^r^n"
  60.     # Put the first day of the month under the correct day column
  61.     for i = 0 to day = dayofweek(b_date) - 1 do
  62.         @ week = concat(week, "    ")
  63.     end
  64.     # Print all the days
  65.     @ i = 1
  66.     if (b_date == 2299156) then
  67.         #    In October 1582, the Julian calendar was replaced with the
  68.         #    Gregorian calendar and Oct 4 was immediately followed by Oct 15
  69.         #    by decree of Pope Gregory XIII.  However, be aware that Britain
  70.         #    did not adopt the Gregorian calendar until Sept 2, 1752 (which
  71.         #    was followed by Sept 14.)  This routine prints a calendar according
  72.         #    to Pope Gregory's decree.
  73.         for c_date = b_date to e_date do
  74.             @ week = concat(week, printf("%3d ", i++))
  75.             if (i == 5) @ i = 15
  76.             if (c_date != e_date && ++day % 7 == 6) @ week = concat(week, "^r^n")
  77.         end
  78.     else
  79.         for c_date = b_date to e_date do
  80.             @ week = (today == c_date) ?                ^
  81.                 concat(week, ansi("bright yellow"),    ^
  82.                     printf("%3d ", i++), ansi()) :    ^
  83.                 concat(week, printf("%3d ", i++))
  84.             if (c_date != e_date && ++day % 7 == 6) @ week = concat(week, "^r^n")
  85.         end
  86.     end
  87.     calc week
  88.     echo
  89. end
  90.  
  91. calendar $argv
  92.