Day of the week calculator

[geecee]

This programme computes the day of the week (e.g., Monday) from the date entered.  The year entered must be later than 1752 due to changes involving the switch-over from the Julian to the Gregorian Calendar.               
                 
NOTE: Leap years occur in years exactly divisible by four, except that years ending in 00 are leap years only if they are divisible by 400.

So, 1700, 1800, 1900, 2100, and 2200 are not leap years - but 1600, 2000, and 2400 are leap years.

Code Select Expand

remstart
  ============================================================

                   DAY OF THE WEEK CALCULATOR
                    ***********************

                         Author: geecee
               Written for Play Basic - March 2009

                    ***********************
                   
   This programme computes the day of the week (e.g., Monday)
   from the date entered.  The year entered must be later than
   1752 due to changes involving the switch-over from the
   Julian to the Gregorian Calendar.               
                 
   NOTE: Leap years occur in years exactly divisible by four,
   except that years ending in 00 are leap years only if they
   are divisible by 400.

   So, 1700, 1800, 1900, 2100, and 2200 are not leap years -
   but 1600, 2000, and 2400 are leap years.

  ============================================================
remend

` Start of programme
start:

` Get current day, month and year from the computer
thisday$=currentday$():thismonth$=currentmonth$():thisyear$=currentyear$()

` Tell PB to include the input support library 
#include "Input"

` Set down coordinate
down=30

` Set text style and size
loadfont "arial bold",1,30,0

` Set new ink colour
ink rgb(255,217,128)

` Title
title$="DAY OF THE WEEK CALCULATOR"

`Write title to screen
centertext 400,down,title$

` A short wait before proceeding
sync
wait 1000

` Set text style and size
loadfont "arial bold",1,20,0

` Determine text height
height=gettextheight("arial bold")

` Declare array/s
dim message$(4)

` Define message/s
message$(1)="This programme computes the day of the week (e.g., Monday) from"
message$(2)="the date entered.  The year entered must be later than 1752 due to"
message$(3)="changes involving the switch-over from the Julian to the Gregorian"
message$(4)="Calendar."

` Determine width of message/s
width=gettextwidth(message$(1))

` Write message/s to screen
for a=1 to 4
  text 400-width/2,down+(height*a)+height,message$(a)
next

` If rerun required come to here
restart:

` A short wait before proceeding
sync
wait 1000

` Set cursor position and enter the desired day
setcursor 100,down+height*8
select_a_day$=staticinput("Enter the day as a two-digit number > ")

` A short wait before proceeding
sync
wait 100

` Set cursor position and enter the desired month
setcursor 100,down+height*10
select_a_month$=staticinput("Enter the month in full (e.g January) > ")

` Ensure first letter of the month is upper case and others
` are lower case
select_a_month$=AutoCaps$(select_a_month$)

` A short wait before proceeding
sync
wait 100

  ` Until year entered is greater than 1752
  repeat
 
    ` Set ink colour and draw a box to hide previous text at location
    ink rgb(0,0,0)
    box 10,down+height*12,790,down+height*15,1

    ` Set new ink colour
    ink rgb(255,217,128)

    ` Set cursor position and enter the desired year.  Must be later than 1752
    ` due to changes involving the switch-over from the Julian to the Gregorian
    ` Calendar
    setcursor 100,down+height*12
    select_a_year$=staticinput("Enter the year as a four-digit number > ")
   
    ` If year entered is before 1753
    if val(select_a_year$)<1753
    setcursor 100,down+height*14
    print "Year must be later than 1752 ... Try again"
   
    ` A short wait before proceeding
    sync
    wait 1000
    endif

  until val(select_a_year$)>1752

` A short wait before proceeding
sync
wait 100

` Go to subroutine to determine century
gosub check_century

` Go to subroutine to determine leap/non-leap year
` 0 return is non-leap year ... 1 return is a leap year
gosub check_leap_year

` Go to subroutine to check formula
gosub check_formula

` Go to subroutine to determine the day of the week
gosub check_day_of_the_week

` Padding message of blank characters
x$="                                                             "

  ` Until the desired result is achieved
  repeat

    ` Set ink colour and draw a box to hide previous text at location
    ink rgb(0,0,0)
    box 10,479,790,500,1

    ` Set new ink colour
    ink rgb(255,217,128)

    ` Set cursor position
    setcursor 0,480

    ` Decide if to try another
    answer$=staticinput(x$+"Try another [Y] or [N] > ")

  until answer$="Y" or answer$="y" or answer$="N" or answer$="n" 

` A short wait before proceeding
sync
wait 100

  if answer$="Y" or answer$="y"

    ` Set ink colour and draw a box to hide previous text at location
    ink rgb(0,0,0)
    box 10,140,790,590,1

    ` Set new ink colour
    ink rgb(255,217,128)

    ` A short wait before proceeding
    sync
    wait 3000

    ` Restart programme
    gosub restart

  else

    ` Set ink colour and draw a box to hide previous text at location
    ink rgb(0,0,0)
    box 10,60,790,590,1

    ` Set new ink colour
    ink rgb(255,217,128)
 
    ` Set text style and size
    loadfont "arial bold",1,40,0

    ` Write message to screen
    centertext 400,300,"BYE!   THANKS FOR PLAYING"
 
    ` Set text style and size
    loadfont "arial bold",1,20,0

    ` A short wait before proceeding
    sync
    wait 3000

    ` End programme
    end
  endif

` ============================================================
` Subroutine to determine century
` ============================================================
check_century:

` Convert string variable to non-string variable
year=val(Select_a_year$)

if year>=1701 and year <=1800 then century =18
if year>=1801 and year <=1900 then century =19
if year>=1901 and year <=2000 then century =20
if year>=2001 and year <=2100 then century =21
if year>=2101 and year <=2200 then century =22
if year>=2201 and year <=2300 then century =23

return

` ============================================================
` Subroutine to determine if year is a leap year
` ============================================================
check_leap_year:

` If the year, when divided by four, has a remainder
` then the year is not a leap year
if mod(year,4)<>0 then thisyear=0

  ` If the year, when divided by four, has no remainder
  ` then the year is a leap year. However if the year,
  ` when divided by 400, does have a remainder then it
  ` it is NOT a leap year
  if mod(year,4)=0
    if mod(year,400)<>0
     thisyear=0
    else
      thisyear=1
    endif
  endif
 
return

` ============================================================
` Subroutine to check formula
` ============================================================
check_formula:

` FORMULA
` STEP 1 - Begin with the last two digits of the year and add to the total
first=val(right$(select_a_year$,2))
` STEP 2 - Next add one quarter of this number, disregarding any remainder
second=first/4
` STEP 3 - Now add the date in the month
third=val(select_a_day$)
` STEP 4 - Now add a number according to the selected month
if select_a_month$="January"
  if thisyear=0
  fourth=0
  else
  fourth=1
  endif
endif
if select_a_month$="February"
  if thisyear=0
  fourth=3
  else
    fourth=4
  endif
endif
if select_a_month$="March" or select_a_month$="November" then fourth=4
if select_a_month$="April" or select_a_month$="July" then fourth=0
if select_a_month$="May" then fourth=2
if select_a_month$="June" then fourth=5
if select_a_month$="August" then fourth=3
if select_a_month$="September" or select_a_month$="December" then fourth=6
if select_a_month$="October" then fourth=1
` STEP 5 - Now add a number according to the century
if century=18 then fifth=4
if century=19 then fifth=2
if century=20 then fifth=0
if century=21 then fifth=6
` Step 6 - Add together all these numbers
total=first+second+third+fourth+fifth
` STEP 7 - Divide the total by 7 and check remainder which indicates the day
` of the week
weekday=mod(total,7)

` Determine weekday
if weekday=1 then Day_of_the_week$ = "Sunday"
if weekday=2 then Day_of_the_week$ = "Monday"
if weekday=3 then Day_of_the_week$ = "Tuesday"
if weekday=4 then Day_of_the_week$ = "Wednesday"
if weekday=5 then Day_of_the_week$ = "Thursday"
if weekday=6 then Day_of_the_week$ = "Friday"
if weekday=0 then Day_of_the_week$ = "Saturday"

return

` ============================================================
` Subroutine to determine day of the week
` ============================================================
check_day_of_the_week:

` Check whether selected year equals current year and
` determine if day was, is, or will be
if val(select_a_year$)<val(thisyear$) then is_was_willbe$="was a "
if val(select_a_year$)>val(thisyear$) then is_was_willbe$="will be a "
if val(select_a_year$)=val(thisyear$)
  if left$(select_a_month$,3)=thismonth$
  if select_a_day$=thisday$ then is_was_willbe$="is today "
    if select_a_day$>thisday$ then is_was_willbe$="will be a "
    if select_a_day$<thisday$ then is_was_willbe$="was a "
  endif
  if left$(select_a_month$,3)<>thismonth$
  ` Go to subroutine to determine a value for selected month
  ` and current month
  gosub check_for_value
  ` If value for current month is greater than value for selected month
  if tm>sam then is_was_willbe$="was a "
  ` If value for current month is lesser than value for selected month
  if tm<sam then is_was_willbe$="will be a "
  endif   
endif

centertext 400,450, "Day of the week "+is_was_willbe$+Day_of_the_week$

return

` ============================================================
` Subroutine to determine a value for selected month and
` current month
` ============================================================
check_for_value:

if left$(select_a_month$,3)="Jan" then sam=1
if thismonth$="Jan" then tm=1
if left$(select_a_month$,3)="Feb" then sam=2
if thismonth$="Feb" then tm=2
if left$(select_a_month$,3)="Mar" then sam=3
if thismonth$="Mar" then tm=3
if left$(select_a_month$,3)="Apr" then sam=4
if thismonth$="Apr" then tm=4
if left$(select_a_month$,3)="May" then sam=5
if thismonth$="May" then tm=5
if left$(select_a_month$,3)="Jun" then sam=6
if thismonth$="Jun" then tm=6
if left$(select_a_month$,3)="Jul" then sam=7
if thismonth$="Jul" then tm=7
if left$(select_a_month$,3)="Aug" then sam=8
if thismonth$="Aug" then tm=8
if left$(select_a_month$,3)="Sep" then sam=9
if thismonth$="Sep" then tm=9
if left$(select_a_month$,3)="Oct" then sam=10
if thismonth$="Oct" then tm=10
if left$(select_a_month$,3)="Nov" then sam=11
if thismonth$="Nov" then tm=11
if left$(select_a_month$,3)="Dec" then sam=12
if thismonth$="Dec" then tm=12

return

As always, comments constructive or otherwise appreciated.

:)
Enjoy!
geecee

[micky4fun]

Hi geecee

neat little program , i was born on a tuesday , first time i ever knew that ,
card magic was good to ,
you are doing some nice little programs here keep it up

mick :)