Rosetta Code task: Calendar

[David Drake]

I created and posted the solution below for the Rosetta Code task Calendar (rosettacode.org/wiki/Calendar).  Here is the task: "Create a routine that will generate a text calendar for any year. Test the calendar by generating a calendar for the year 1969, on a device of the time. Choose one of the following devices:  A line printer with a width of 132 characters, or an IBM 3278 model 4 terminal (80×43 display with accented characters). Target formatting the months of the year to fit nicely across the 80 character width screen. Restrict number of lines in test output to 43."

I adapted this from the calendar.bas program included with the LB distribution.

I notice now, upon posting, that I have violated the test output line number restriction.

Please post comments and suggestions.


rem Adapted from LB examples included with software

[start]
   prompt "Enter year(yyyy)?";year
   if year<1900 then notice "1900 or later":goto [start]
   ax=1:gx=8:ay=3:gy=10
   locate 52,1:print year
   for mr = 0 to 3
       for mc = 0 to 2
           mt=mt+1
           aDate$ = str$(mt)+"/01/"+str$(year)
           px = ax+mc*gx
           py = ay+mr*gy
           gosub [printout]
       next mc
   next mr
   gosub [snoopy]
end

[printout]
   locate 4*px-3+int((30-len(monthname$(aDate$)))/2),py
   print monthname$(aDate$)
   FirstDay=date$(word$(aDate$,1,"/")+"/1/"+word$(aDate$,3,"/"))
   LastDay$=date$(date$(word$(date$(FirstDay+32),1,"/")+"/1/"+word$(date$(FirstDay+32),3,"/"))-1)
   dow=val(word$("3 4 5 x 6 7 x 1 2",int((FirstDay/7-int(FirstDay/7))*10)+1))
   locate px*4-3, py+1
   print " Su Mo  Tu  We  Th  Fr  Sa"
   for i=1 to val(mid$(LastDay$,4,2))
       y=int((i+dow-2)/7)
       x=px+(i+dow-2)-y*7
       x=4*x
       locate x-4,py+y+2
       print using("###",i)
   next i
return

[snoopy]
   locate ax, ay+4*gy
   print space$(4*gx);"           ,-~~-.___."
   print space$(4*gx);"          / ()=(()   \"
   print space$(4*gx);"         (   (        0"
   print space$(4*gx);"          \._\, ,----'"
   print space$(4*gx);"     ##XXXxxxxxxx"
   print space$(4*gx);"            /  ---'~;"
   print space$(4*gx);"           /    /~|-"
   print space$(4*gx);"    _____=(   ~~  |______ "
   print space$(4*gx);"   /_____________________\ "
   print space$(4*gx);"  /_______________________\"
   print space$(4*gx);" /_________________________\"
   print space$(4*gx);"/___________________________\"
   print space$(4*gx);"   |____________________|"
   print space$(4*gx);"   |____________________|"
   print space$(4*gx);"   |____________________|"
   print space$(4*gx);"   |                    |"
return



function monthname$(aDate$)

   month=val(aDate$)

   monthname$=word$("January February March April May June July August September October November December",month)

end function

[David Drake]

Before I post this to Rosetta Code, I welcome any comments or improvements from the community.

[David Drake]

I have posted the code to Rosetta Code.