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