home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / FOXPRO / CALNDR / CAL.PRG < prev    next >
Text File  |  1992-02-10  |  8KB  |  294 lines
  1. * cal.prg
  2. * last revision: Mon  02-10-1992  12:25:39
  3.  
  4. * GetADate displays a calendar and lets the user select a date by moving
  5. *  cursor keys.  Client should check lastkey() to see if user escaped
  6.  
  7. #define main_program
  8.  
  9. * NB Im not certain that IsLeapYear is completely correct.  There may be
  10. *  I don't have the rules for leap years handy and there may be some
  11. *  rules Ive forgotten
  12.  
  13. #include math.hdr
  14. #include io.hdr
  15. #include date.hdr
  16. #include system.hdr
  17. #include keys.hdr
  18. #include string.hdr
  19.  
  20. VARDEF EXTERN && from data.hdr
  21.     BYTE     __color_enhcd
  22.     BYTE     __color_std
  23.     LOGICAL  __cursor
  24. ENDDEF
  25.  
  26. VARDEF PRIVATE
  27.   uint ccol[7] = 11,16,21,26,31,36,41
  28.   uint rrow[6] =  5, 8,11,14,17,20
  29.   char(9) monthnames[12] = "January", "February", "March", "April", ;
  30.     "May", "June", "July", "August", "September", "October", ;
  31.     "November", "December"
  32.  
  33.   uint day1_offset  && what cell is the first day of the month in?
  34.   uint lastday      && last day of current month
  35. ENDDEF
  36.  
  37. procedure DrawSkeleton
  38.   fill(1,10,23,46,&double_box," ",__color_std,__color_std,6)
  39.  
  40.   *           day    1    2    3    4    5    6    7
  41.  
  42.   @  3,11 ??      "Sun  Mon  Tue  Wed  Thu  Fri  Sat "
  43.   @  4,10 ??      "╠════╦════╦════╦════╦════╦════╦════╣"
  44.   @  5,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  45.   @  6,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  46.   @  7,10 ??      "╠════╬════╬════╬════╬════╬════╬════╣"
  47.   @  8,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  48.   @  9,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  49.   @ 10,10 ??      "╠════╬════╬════╬════╬════╬════╬════╣"
  50.   @ 11,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  51.   @ 12,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  52.   @ 13,10 ??      "╠════╬════╬════╬════╬════╬════╬════╣"
  53.   @ 14,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  54.   @ 15,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  55.   @ 16,10 ??      "╠════╬════╬════╬════╬════╬════╬════╣"
  56.   @ 17,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  57.   @ 18,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  58.   @ 19,10 ??      "╠════╬════╬════╬════╬════╬════╬════╣"
  59.   @ 20,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  60.   @ 21,10 ??      "║    ║    ║    ║    ║    ║    ║    ║"
  61.   @ 22,10 ??      "╚════╩════╩════╩════╩════╩════╩════╝"
  62.  
  63. endpro && of proc DrawSkeleton
  64.  
  65.  
  66. procedure LightUpCell
  67.   parameters value uint cellno
  68.    * cellno is 1..42
  69.    vardef
  70.      uint r,c
  71.    enddef
  72.    r = i_trunc((cellno - 1) /7)
  73.    c = (cellno - 1) % 7
  74.  
  75.    *? "r = ", r
  76.    *? "c = ", c
  77.    curcolor(rrow[r],ccol[c],__color_enhcd,4)
  78.    curcolor(rrow[r]+1,ccol[c],__color_enhcd,4)
  79. endpro && of proc LightUpCell
  80.  
  81. procedure DimCell
  82.   parameters value uint cellno
  83.    * cellno is 1..42
  84.    vardef
  85.      uint r,c
  86.    enddef
  87.    r = i_trunc((cellno - 1) /7)
  88.    c = (cellno - 1) % 7
  89.  
  90.    *? "r = ", r
  91.    *? "c = ", c
  92.    curcolor(rrow[r],ccol[c], __color_std,4)
  93.    curcolor(rrow[r]+1,ccol[c], __color_std,4)
  94. endpro && of proc DimCell
  95.  
  96. * STUB!! Im not sure this is correct
  97. function logical IsLeapYear
  98.  parameters value uint yearval
  99.   return (((yearval %     4) = 0) .or. ;
  100.           ((yearval %    25) = 0) .or. ;
  101.           ((yearval %   400) = 0))
  102. endpro && of func IsLeapYear
  103.  
  104. function uint CalcLastDayOfMonth
  105.  parameters value uint yearval, value uint monthval
  106.   Do case
  107.     case (monthval =  4) .or. (monthval =  6) .or. ;
  108.          (monthval =  9) .or. (monthval = 11)
  109.       return 30
  110.     case (monthval = 2)
  111.       if IsLeapYear(yearval)
  112.         return 29
  113.       else
  114.         return 28
  115.       endif
  116.     otherwise
  117.       return 31
  118.   endcase
  119. endpro && of func CalcLastDayOfMonth
  120.  
  121. procedure FillCells
  122.  parameters value uint yearval, value uint monthval
  123.   * also sets day1_offset and lastday
  124.   vardef
  125.     uint dayno, startday
  126.     uint r,c
  127.   enddef
  128.  
  129.   @ 2,11 ?? "                                  " && clear the area
  130.   @ 2,11 ?? monthnames[monthval - 1] + " " +str(yearval,4,0)
  131.  
  132.   startday =  dow(itod(1,monthval,yearval))
  133.   day1_offset = startday - 1
  134.   lastday = CalcLastDayOfMonth(yearval,monthval)  && side effect
  135.  
  136.   *@ 5,48 ?? "itod        ",itod(1,monthval,yearval)
  137.   *@ 6,48 ?? "LastDay     ",lastday
  138.   *@ 7,48 ?? "Day1_Offset ",day1_offset
  139.   *@ 8,48 ?? "Startday    ",startday
  140.  
  141.   for dayno = 1 to startday - 1
  142.      r = i_trunc((dayno - 1) /7)
  143.      c = (dayno - 1) % 7
  144.      @ rrow[r]+1, ccol[c]+1 ?? "  "
  145.   next
  146.  
  147.   for dayno = startday to startday + lastday
  148.      r = i_trunc((dayno - 1) /7)
  149.      c = (dayno - 1) % 7
  150.      @ rrow[r]+1, ccol[c]+1 ?? (dayno - startday +1):2
  151.   next
  152.  
  153.   for dayno = (startday + lastday ) to 42
  154.      r = i_trunc((dayno - 1) /7)
  155.      c = (dayno - 1) % 7
  156.      @ rrow[r]+1, ccol[c]+1 ?? "  "
  157.   next
  158. endpro && of proc FillCells
  159.  
  160. function date GetADate
  161.  parameters value date begindate
  162.   vardef
  163.     uint k
  164.     uint cellno
  165.     date curdate
  166.     uint curmon, curday, curyear
  167.     uint utemp
  168.     logical OrigCursor
  169.   enddef
  170.  
  171.   OrigCursor = __cursor
  172.   cursor_off
  173. *{}*
  174.   Save_Area(1,10,23,46)
  175.   DrawSkeleton
  176.   curdate = begindate
  177.   fillcells(year(curdate),month(curdate))
  178.   cellno = day(curdate)+day1_offset
  179.   curmon  = month(curdate)
  180.   curyear = year(curdate)
  181.   curday  = day(curdate)
  182.   LightUpCell(cellno)
  183.  
  184.   * now let the user choose a date
  185.   repeat
  186.     k = get_key()
  187.     do case
  188.  
  189.       case k = &K_right
  190.         if curday = lastday
  191.           curmon = curmon + 1
  192.           curday = 1
  193.           if curmon > 12
  194.             curmon = 1
  195.             curyear = curyear + 1
  196.           endif
  197.           fillcells(curyear,curmon)
  198.         else
  199.           curday = curday + 1
  200.         endif
  201.  
  202.       case k = &K_left
  203.         if curday = 1
  204.           curmon = curmon - 1
  205.           if curmon < 1
  206.             curmon = 12
  207.             curyear = curyear - 1
  208.           endif
  209.           fillcells(curyear, curmon)
  210.           curday = lastday
  211.         else
  212.           curday = curday - 1
  213.         endif
  214.  
  215.       case k = &K_up
  216.         if curday < 8 && we are in the first week
  217.           utemp = curday
  218.           curmon = curmon - 1
  219.           if curmon < 1
  220.             curmon = 12
  221.             curyear = curyear - 1
  222.           endif
  223.           fillcells(curyear, curmon)
  224.           curday = lastday - (7 - utemp)
  225.         else
  226.           curday = curday - 7
  227.         endif
  228.  
  229.       case k = &K_down
  230.         curday = curday + 7
  231.         if curday > lastday
  232.           curday = curday - lastday
  233.           curmon = curmon + 1
  234.           if curmon > 12
  235.             curmon = 1
  236.             curyear = curyear + 1
  237.           endif
  238.           fillcells(curyear,curmon)
  239.         endif
  240.  
  241.       case k = &K_pg_down
  242.         curmon = curmon + 1
  243.           if curmon > 12
  244.             curmon = 1
  245.             curyear = curyear + 1
  246.           endif
  247.         fillcells(curyear,curmon)
  248.  
  249.       case k = &K_pg_up
  250.         curmon = curmon - 1
  251.           if curmon < 1
  252.             curmon = 12
  253.             curyear = curyear - 1
  254.           endif
  255.         fillcells(curyear,curmon)
  256.  
  257.       case k = &K_c_pg_down
  258.         curyear = curyear + 1
  259.         fillcells(curyear,curmon)
  260.  
  261.       case k = &K_c_pg_up
  262.         curyear = curyear - 1
  263.         fillcells(curyear,curmon)
  264.  
  265.     endcase
  266.     if (k <> &K_enter) .and. (k <> &K_esc)
  267.       curdate = itod(curday,curmon,curyear)
  268.       DimCell(cellno)
  269.       cellno = day(curdate)+day1_offset
  270.       LightUpCell(cellno)
  271.     endif
  272.   until (k = &K_esc) .or. (k = &K_enter)
  273.  
  274.   if (k = &K_enter)
  275.     if OrigCursor
  276.       cursor_on
  277.     else
  278.       cursor_off
  279.     endif
  280.     restore_area
  281.     return curdate
  282.   else
  283.     if OrigCursor
  284.       cursor_on
  285.     else
  286.       cursor_off
  287.     endif
  288.     restore_area
  289.     return itod(1,1,1)
  290.   endif
  291. endpro && of func GetADate
  292.  
  293. ** End of cal.prg
  294.