home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / AP / JED / JED097-1.TAR / jed / lib / cal.sl < prev    next >
Encoding:
Text File  |  1994-12-12  |  4.4 KB  |  189 lines
  1. %
  2. %  calender for JED
  3. %
  4. %  It was written to test a mixture of S-Lang RPN and infix notation.
  5. %
  6. %  It pops up a buffer like:
  7.  
  8. %     Jun 1993              Jul 1993               Aug 1993
  9. % S  M Tu  W Th  F  S      S  M Tu  W Th  F  S       S  M Tu  W Th  F  S
  10. %       1  2  3  4  5               1  *  3        1  2  3  4  5  6  7 
  11. % 6  7  8  9 10 11 12       4  5  6  7  8  9 10        8  9 10 11 12 13 14 
  12. %13 14 15 16 17 18 19      11 12 13 14 15 16 17       15 16 17 18 19 20 21 
  13. %20 21 22 23 24 25 26      18 19 20 21 22 23 24       22 23 24 25 26 27 28 
  14. %27 28 29 30          25 26 27 28 29 30 31       29 30 31 
  15. %
  16. %  The asterix denotes the current day.  
  17. %  The actual computational part of the code presented here is a 
  18. %  translation of cal.el included with the GNU Emacs distribution.
  19. %  (suitably modified to work with 16 bit integers)
  20. %----------------------------------------------------------------------
  21.  
  22.  
  23.  
  24. % parse date
  25. define cal_convert_month(month, type)
  26. {
  27.   variable lis, m, mnth;
  28.   lis =  "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec";
  29.   if (type == 0) return (extract_element(lis, month - 1, ' '));
  30.   for (m = 0; m < 12; ++m)
  31.     { 
  32.       mnth = extract_element(lis, m, ' ');
  33.       if (0 == strcmp(month, mnth)) return (m + 1);
  34.     }
  35. }
  36.  
  37.  
  38. define leap_year_p (year)
  39. {
  40.    if ( not(year mod 4) and (year mod 100)) return (1);
  41.    not (year mod 400);
  42. }
  43.  
  44. define cal_day_number(month, day, year)
  45. {
  46.    variable d;
  47.    d = 31 * ( month - 1 ) + day;
  48.    if (month > 2)
  49.      {
  50.     d = d - (month * 4 + 23) / 10;
  51.     if (leap_year_p (year)) { ++d }
  52.      } 
  53.    d;
  54. }
  55.  
  56.  
  57. define cal_day_of_week(month, day, year)
  58. {
  59.    variable c, delta, n, a, b;
  60.    
  61.    n = cal_day_number(month, day, year);
  62.    --year;
  63.    
  64.   a = n + year + year/4;
  65.   c = year/100 * 3; b = 0;
  66.   if (c mod 4) b = 1;
  67.  
  68.    return (a - (b + c/4)) mod 7;
  69. }
  70.  
  71.  
  72. define make_month(month year indent day)
  73. {
  74.    variable first, nm, ny, max, i, istr, m;
  75.  
  76.    m = cal_convert_month(month, 1);
  77.    
  78.    first = cal_day_of_week(m, 1, year);
  79.    nm = m + 1; ny = year;
  80.    if (nm == 13) max = 31;
  81.    else max = cal_day_number(nm, 1, ny) - cal_day_number(m, 1, year);
  82.    
  83.    ++indent;
  84.    
  85.    bob; goto_column(indent);
  86.    insert("     "); insert(month); insert_single_space; insert(string(year));
  87.    if (1 != down(1)) newline();
  88.    goto_column(indent);
  89.    
  90.    insert(" S  M Tu  W Th  F  S");
  91.    if (1 != down(1)) newline;
  92.    goto_column(first * 3 + indent);
  93.    
  94.    for (i = 1; i <= max; ++i)
  95.      { 
  96.     if (first == 7)
  97.       {
  98.          if (down(1) != 1) {eol; newline}
  99.          goto_column(indent); first = 0;
  100.       }
  101.     
  102.     istr = string(i);
  103.     if (strlen(istr) == 1) insert_single_space();
  104.     if (day == i) push_spot();
  105.     insert(istr); insert_single_space();
  106.     ++first;
  107.      } 
  108. }
  109.  
  110. %%% strcaps-- returns capitalized string
  111. define strcaps(str)
  112. {
  113.    str = strlow(str);
  114.    strsub(str, 1, int (strup(char(int(str)))));
  115. }
  116.  
  117.     
  118. define calendar ()
  119. {
  120.    
  121.   variable month, day, year, t, m, nlines, wlines, obuf, default, n;
  122.  
  123.   n = 0;
  124.   obuf = whatbuf;
  125.   t = time;
  126.   month = extract_element(t, 1, ' ');
  127.   day = extract_element(t, 2, ' ');
  128.  
  129.    % Some systems display the time as: Tue Jul 06 16:31:18 1993
  130.    % while others use Tue Jul 06 16:31:18 1993
  131.    % this silly bit is a result.
  132.    
  133.    if (strlen(day) == 0)
  134.      { 
  135.        day = extract_element(t, 3, ' ');
  136.        n = 1
  137.      } 
  138.   day = integer(day);
  139.  
  140.   year = extract_element(t, 4 + n, ' ');
  141.  
  142.   default = strcat(month, strcat(" ", string(year)));
  143.   t = read_mini("Month Year:", default, Null_String);
  144.   t = strtrim(t);
  145.   month = strcaps(substr(extract_element(t, 0, ' '), 1, 3));
  146.   year = integer(extract_element(t, 1, ' '));
  147.   m = cal_convert_month(month, 1);
  148.    
  149.   pop2buf("*calendar*"); set_readonly(0); erase_buffer();
  150.   --m; if (0 == m) {m = 12; --year}
  151.   cal_convert_month(m, 0); make_month(year, 0, 0);
  152.   ++m; if (m == 13) {m = 1; ++year}
  153.   cal_convert_month(m, 0);  make_month(year, 25, day);
  154.   ++m;  if (m == 13) {m = 1; ++year} 
  155.   cal_convert_month(m, 0);  make_month(year, 50, 0);
  156.    %
  157.    % fix window size
  158.    %
  159.    if (nwindows == 2)
  160.      {
  161.     eob();  bskip_chars("\n\t ");
  162.     nlines = whatline - window_info('r');
  163.     
  164.     if (nlines > 0)
  165.       {
  166.          loop (nlines) {call("enlarge_window") }
  167.       }
  168.     else
  169.       {
  170.          call("other_window");
  171.          loop(- nlines) {call("enlarge_window")}
  172.          call("other_window");
  173.       } 
  174.      bob();
  175.      } 
  176.      
  177.    % find current day
  178.    pop_spot();
  179.    del(); insert_char('*');
  180.    if (isdigit(what_char())) {del(); insert_char('*')}
  181.  
  182.    set_readonly(1); set_buffer_modified_flag(0);
  183.    bob(); pop2buf(obuf);
  184.    %
  185.    %  what the heck, give current time
  186.    %
  187.    message(time)
  188. }
  189.