set date british
set bell off
   clear typeahead
   store wselect() to mwsel
   wset window calendar to 2,1,20,78 double color 'GR+/B', 'N/W', 'W/N'
   wselect 51
   wuse calendar title 'Calendar'
   @ 0,0
   store 0 to mmonth
   store 0 to myear
   store 'G' to mwhich
   @ 1,0 say 'Enter month number (1-12) ' get mmonth picture '@Z 99' &&\ valid mmonth > 0 .and. mmonth < 13
   @ 3,0 say 'Enter year                ' get myear picture '@Z 9999'
   read
   if myear < 1753
      store 'J' to mwhich
      if myear > 1581
         @ 5,0 say 'Please note that in 1582 Pope Gregory ruled that the 5th October was really'
         @ 6,0 say '15th October and all dates should be revised retrospectively by adding'
         @ 7,0 say '10 days to whatever date was being examined. He further ruled that'
         @ 8,0 say 'the years 1700, 1800 and 1900 would not be leap years and that'
         @ 9,0 say 'New Years Day would fall on 1st January, not on 25th March as it had been.'
         @ 10,0 say 'This method of dating became known as the New Style (N.S) or Gregorian'
         @ 11,0 say 'Calendar as opposed to the Old Style (O.S.) or Julian Calendar.'
         @ 12,0 say 'All countries gradually converted. The British Government (with its American'
         @ 13,0 say 'colonies) did not convert until 1752 when 3rd September became'
         @ 14,0 say '14th September.'
         @ 16,0 say 'Which Calendar Julian or Gregorian  J/G ' get mwhich picture '!'  &&\ valid mwhich $ 'JG'
         read
      endif
   endif
   do while .t.
      if myear < 1582 .and. mwhich = 'G'
         store 'J' to mwhich
      endif
      if myear > 1752 .and. mwhich = 'J'
         store 'G' to mwhich
      endif
      wdisplay
      if myear < -1
         @ 1,15 say 'January, 2 BC is as early as this calendar goes'
         store myear+1 to myear
      endif
      store ctod('01/'+right('0'+ltrim(str(mmonth,2)),2)+'/'+str(myear,4)) to mdmonth
      @ 4,0 say '  Sunday    Monday    Tuesday    Wednesday    Thursday    Friday   Saturday'
      do case
      case mmonth = 1 .or. mmonth = 3 .or. mmonth = 5 .or. mmonth = 7 .or. mmonth = 8 .or. mmonth = 10 .or. mmonth = 12
         store 31 to mlim
      case mmonth = 4 .or. mmonth = 6 .or. mmonth = 9 .or. mmonth = 11
         store 30 to mlim
      case mmonth = 2 .and. myear/4 = int(myear/4) .and. myear # 1900 .and. myear # 1800 .and. myear # 1700 .and. myear # 2100 .and. mwhich = 'G'
         store 29 to mlim
      case mmonth = 2 .and. myear/4 = int(myear/4) .and. myear # 0 .and. mwhich = 'J'
         store 29 to mlim
      otherwise
         store 28 to mlim
      endcase
      store 6 to mrow
      store dow(mdmonth) to mdw
      if mdmonth < ctod('01/03/1900')
         store mdw + 1 to mdw
         if mdw = 8
            store 1 to mdw
         endif
      endif
      if mdmonth < ctod('01/03/1800')
         store mdw + 1 to mdw
         if mdw = 8
            store 1 to mdw
         endif
      endif
      if mdmonth < ctod('01/03/1700') .or. myear < 1700
         store mdw + 1 to mdw
         if mdw = 8
            store 1 to mdw
         endif
      endif
      if mwhich = 'J'
         store mdw + 3 to mdw
         if mdmonth >= ctod('01/03/1700') .and. myear > 1699
            store mdw + 1 to mdw
         endif
         if mdw > 7
            store mdw - 7 to mdw
         endif
      endif
      if myear < 0
         store cmonth(ctod('01/'+right('0'+ltrim(str(mmonth,2)),2)+'/'+str(abs(myear),4))) to mcmonth
      else
         store cmonth(mdmonth) to mcmonth
      endif
      if myear < 1
         store ltrim(str(abs(myear-1),4))+' BC' to mcyear
      else
         store ltrim(str(myear,4)) to mcyear
      endif
      if mdmonth = ctod('01/12/1899')
         store 6 to mdw
         @ 2,32 say 'December, 1899'
      else
         @ 2,0 say center(mcmonth+', '+iif(mwhich = 'J' .and. myear > 1154 .and. mmonth < 4,str(myear-1,4)+'/'+str(myear,4),mcyear)+iif(myear<1753,iif(mwhich='J','  Julian','  Gregorian')+' Calendar',''),76)
      endif
      store ((mdw-1)*11)+4 to mcol
      store 1 to mcount
      do while mcount <= mlim
         @ mrow,mcol say str(mcount,2)
         store mcol+11 to mcol
         if mcol > 77
            store mrow + 2 to mrow
            store 4 to mcol
         endif
         store mcount + 1 to mcount
      enddo
      store ' ' to mx
      @ 17,0 say 'Enter P for previous month,N for next month,L for last year,Y for next year' get mx picture '!'
      @ 18,0 say 'Enter any other character to return'
      read
      do case
      case mx = 'P'
         store mmonth - 1 to mmonth
      case mx = 'N'
         store mmonth + 1 to mmonth
      case mx = 'L'
         store myear -1 to myear
      case mx = 'Y'
         store myear +1 to myear
      otherwise
         exit
      endcase
      if mmonth < 1
         store myear-1 to myear
      endif
      if mmonth > 12
         store myear+1 to myear
      endif
      if mmonth < 1
         store 12 to mmonth
      endif
      if mmonth > 12
         store 1 to mmonth
      endif
   enddo
   wselect mwsel
   wclose 51
quit