Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Solar Calendar
#1
Here's a project I've been working on,(one of many), and I'd like to finish. I've sent it to moneo, but it doesn't seem to arrive there, so I've decided to post it here.
It's a Solar Calendar based on the rotation of the Earth around the sun,(solar cycle), as opposed to the lunar cycle, which is what our current calendars are based upon. The only thing left to do, is add some code so it can switch between months, both Forwards and back. Like what you see on a planner. The days of the month and season, year end, ...etc, are not what you'd expect;(i,e: 30 days in Feb. as opposed to 28 or 29, in the case of a leap year.)
You'll notice the other differences as you go along. If anyone is interested, please feel free to have fun. The only thing I ask is that you do not use DEFINT, Type(s), Subs, sprites, or call routines.
As these are not needed in this type of program.
Have Fun !






' REM DEC. 21ST STANDARD CALENDAR = DEC. 31ST SOLAR ORBIT CALENDAR (S.O.C.)
' REM DEC. 22ND STANDARD CALENDAR = JAN. 1ST (S.O.C.)
' REM FEB. 4TH @ 12:00:00pm (MIDNIGHT) - WINTER ENDS (S.O.C.)
' REM FEB 5TH @ 12:00:01am ( AFTER (PAST) MIDNIGHT) - SPRING BEGINS (S.O.C.)
' REM MARCH 23RD @ 12:00:01PM - 2ND HALF OF SPRING BEGINS (S.O.C.)
' REM MAY 7TH @ 12:00:00pm - SPRING ENDS (S.O.C.)
' REM MAY 8TH @ 12:00:01pm ( AFTER (PAST) MIDNIGHT) - SUMMER BEGINS (S.O.C.)
' REM JUNE 21ST @ 12:00:01PM - 2ND HALF OF SUMMER BEGINS (S.O.C.)
' REM AUG. 7TH @ 12:00:00pm - 2ND HALF OF SUMMER ENDS (S.O.C.)
' REM AUG. 8TH @ 12:00:01am - FALL BEGINS (S.O.C.)
' REM SEPT. 21ST @ 12:00:01 - 2ND HALF OF FALL BEGINS (S.O.C.)
' REM NOV. 4TH @ 12:00:00pm - FALL ENDS (S.O.C.)
' REM NOV. 5TH @ 12:00:01pm - WINTER BEGINS (S.O.C.)
' REM DEC. 21ST @ 12:00:01pm - 2ND HALF OF WINTER BEGINS (S.O.C.)

ON ERROR GOTO ERREND
CLS : SCREEN 0: WIDTH 80: CLS : R = 6: C = 7
COLOR 12, 7: VIEW PRINT 2 TO 24: CLS
FOR R = 2 TO 22
LOCATE R, 6: PRINT STRING$(70, 32): NEXT: R = 6: C = 10: CLS
DIM M$(12): DIM NUM(14, 14): DIM F(6, 32): DIM S(6, 32)
FOR M = 1 TO 12
READ M$(M): READ NUM(M, 1), NUM(M, 2): NEXT: LY = 0
YEAR: FOR I = 0 TO 2525
GOSUB REFRESH
COLOR 15, 7: COL1 = 15: COL2 = 7
MONTH: FOR P = 1 TO 12
LOCATE 2, 11: PRINT STRING$(40, 32); : LOCATE 2, 11: PRINT I
LOCATE 2, 25: PRINT M$(P), NUM(P, 1); "/"; NUM(P, 2)
IF LY = 4 THEN LOCATE 2, 55: PRINT "LEAPYEAR"
DAY: D = D + 1
CD$ = MID$(DATE$, 4, 2): CD = VAL(CD$)
IF D > NUM(P, 1) THEN GOTO DNEXT ELSE
IF D = CD THEN COLOR 15, 2 ELSE
COLOR COL1, COL2
ON P GOTO P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12
GOTO SHOWIT

P1: COLOR 15, 7
IF D > 20 THEN D2 = D2 + 1: COL1 = 15: COL2 = 7 ELSE
IF D2 >= 5 THEN COL1 = 1: COL2 = 7 ELSE
COLOR 15, 7: IF D = NUM(P, 1) THEN GOTO PRNTMESS1 ELSE
GOTO SHOWIT

PRNTMESS1:
LOCATE 18, 9: COLOR 15, 7
PRINT "FEB.4TH @ 12:00:00pm (MIDNIGHT) - WINTER ENDS ";
COLOR 1, 7: PRINT "/ AND SPRING BEGINS!"
COLOR 15, 7: GOTO SHOWIT

P2: IF D > 19 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS2 ELSE
COLOR 1, 7: GOTO SHOWIT

PRNTMESS2:
COLOR 1, 7
LOCATE 18, 31: PRINT "IT'S SPRING TIME!"
COLOR 1, 7: COL1 = 1: COL2 = 7: GOTO SHOWIT

P3: IF D >= 22 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS3 ELSE
COLOR 1, 7: GOTO SHOWIT

PRNTMESS3:
LOCATE 18, 13
PRINT "BY MARCH 23RD AT 12:00 NOON, SPRING WILL BE HALF SPRUNG...."
GOTO SHOWIT

P4: IF D >= 22 THEN D2 = D2 + 1
IF D2 >= 8 THEN COL1 = 14: COL2 = 7 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS4 ELSE
COLOR 1, 7: GOTO SHOWIT

PRNTMESS4:
COLOR 1, 7: LOCATE 18, 10
PRINT "MAY 7TH @ 12:00:00 (MIDNIGHT), SPRING ENDS ";
COLOR 14, 7: PRINT "/ AND SUMMER BEGINS!"
COLOR 1, 7: GOTO SHOWIT

P5: IF D >= 22 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS5 ELSE
DCOL1 = 14: DCOL2 = 7: COLOR DCOL1, DCOL2: GOTO SHOWIT

PRNTMESS5:
COLOR 14, 7: LOCATE 18, 34: PRINT "IT'S SUMMER!"
GOTO SHOWIT

P6: IF P = 6 AND D >= 22 THEN D2 = D2 + 1
IF D = NUM(P, 1) THEN GOTO PRNTMESS6 ELSE
GOTO SHOWIT

PRNTMESS6:
LOCATE 18, 30: PRINT "WARM ENOUGH FOR YOU?"
GOTO SHOWIT

P7: IF D >= 23 THEN D2 = D2 + 1 ELSE
IF D2 >= 8 THEN COL1 = 6: COL2 = 7 ELSE
COLOR DCOL1, DCOL2
IF D = NUM(P, 1) THEN GOTO PRNTMESS7 ELSE
GOTO SHOWIT

PRNTMESS7:
LOCATE 18, 8
PRINT " ON JULY 30TH @ 12:00:00 (MIDNIGHT) SUMMER ENDS ";
COLOR 6, 7: PRINT "/ AND FALL BEGINS...": COLOR 14, 7
GOTO SHOWIT

P8: DCOL1 = 6: DCOL2 = 7: COLOR DCOL1, DCOL2
IF D >= 23 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS8 ELSE
GOTO SHOWIT

PRNTMESS8:
LOCATE 18, 18: PRINT "DON'T SWEAT IT...COOLER WEATHER IS ON IT'S WAY!"
GOTO SHOWIT

P9: IF D >= 23 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS9 ELSE
GOTO SHOWIT

PRNTMESS9:
LOCATE 18, 29: COLOR 6, 7: PRINT "AHHHH, THIS IS NICE..."
GOTO SHOWIT

P10: IF D >= 23 THEN D2 = D2 + 1
IF D2 >= 5 THEN COL1 = 15: COL2 = 7 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS10 ELSE
COLOR 6, 7: GOTO SHOWIT

PRNTMESS10:
COLOR 6, 7: LOCATE 18, 10
PRINT " AT 12:00:00 (MIDNIGHT) NOV.4TH, FALL ENDS ";
COLOR 15, 7: PRINT "/ AND WINTER BEGINS..."
COLOR 6, 7: GOTO SHOWIT

P11: IF D = 5 THEN COLOR 15, 7 ELSE
IF D > 21 THEN D2 = D2 + 1: COL1 = 15: COL2 = 7 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS11 ELSE
GOTO SHOWIT

PRNTMESS11:
COLOR 15, 7: LOCATE 18, 6
PRINT "THIS THANKSGIVING, BE SURE TO GIVE GOD THANKS FOR ALL OF YOUR";
PRINT " BLESSINGS": COLOR 15, 7
GOTO SHOWIT

P12: IF D > 21 THEN D2 = D2 + 1 ELSE
IF D = NUM(P, 1) THEN GOTO PRNTMESS12 ELSE
GOTO SHOWIT

PRNTMESS12:
LOCATE 18, 26: COLOR 6, 11
PRINT " CHRISTMAS TIMES A COME'N "
COLOR 15, 7

SHOWIT:
LOCATE R, C: IF D = CD THEN NUC = 1: COL1 = COL1 + 16: COLOR COL1, 7 ELSE
PRINT D;
IF NUC = 1 THEN COL1 = COL1 - 16: NUC = 0 ELSE
COLOR COL1, 7: PRINT "/";
IF D2 >= 1 AND D2 <> CD THEN COLOR COL1, COL2: PRINT D2: GOTO SHOWIT2 ELSE
IF D2 = CD THEN NUC = 1: COL1 = COL1 + 16: COLOR COL1, COL2: PRINT D2 ELSE
IF NUC = 1 THEN COL1 = COL1 - 16: NUC = 0 ELSE
COLOR COL1, COL2
SHOWIT2:
IF LY = 4 AND P = 1 THEN LOCATE 2, 55: COLOR 15, 7: PRINT "LEAPYEAR" ELSE
COLOR COL1, COL2
IF LY = 4 AND P = 5 AND D = 30 THEN LOCATE R, C: GOSUB LEAPYEAR ELSE
C = C + 9
IF C >= 70 THEN R = R + 2: C = 10
IF R > 20 THEN R = 6
GOTO DAY:
DNEXT:
A$ = ""
DO WHILE A$ = ""
A$ = INKEY$
LOOP
L = LEN(A$): IF L = 2 THEN GOTO DNEXT
A = ASC(A$)
IF A = &H1B THEN END ELSE
IF A = &HD THEN GOSUB NEWMONTH ELSE GOTO DNEXT
NEXT
LY = LY + 1: IF LY > 4 THEN LY = 1 ELSE
NEXT

NEWMONTH:
LOCATE R, C: C1 = C
FOR R = 6 TO 18
LOCATE R, 6: PRINT STRING$(72, 32): NEXT
D = D2: D2 = 0: R = 6: LOCATE R, C
RETURN

REFRESH:
COLOR 0, 7
LOCATE 2, 55: PRINT STRING$(10, 32)
COLOR 1, 7: LOCATE 2, 5: PRINT " YEAR ";
LOCATE 4, 10: PRINT " SUNDAY "; " MONDAY "; " TUESDAY "; " WEDNESDAY ";
PRINT " THURSDAY "; " FRIDAY "; " SATURDAY "; : COLOR 15, 7
LOCATE 21, 26: PRINT "WINTER "; : COLOR 1, 7: PRINT " SPRING ";
COLOR 14, 7: PRINT " SUMMER "; : COLOR 6, 7: PRINT " FALL ";
COLOR 0, 7: LOCATE 23, 15
PRINT " OLD CALENDAR MONTH & DAY/NEW CALENDAR MONTH & DAY ";
RETURN

LEAPYEAR:
D = D + 1: D2 = D2 + 1: C = C + 9
IF C >= 70 THEN R = R + 2: C = 10 ELSE
LOCATE R, C: PRINT D; "/";
COLOR COL1, COL2: PRINT D2
R = R + 2: IF R > 14 THEN R = 6 ELSE
RETURN

ERREND: SCREEN , 0, 0: PRINT ERR, ERL
RESUME ERRNXT
ERRNXT: END

DATA JANUARY/FEBURARY,31,30
DATA FEBURARY/MARCH,30,31, MARCH/APRIL,31,30, APRIL/MAY,30,30, MAY/JUNE,30,30
DATA JUNE/JULY,30,31, JULY/AUGUST,31,31, AUGUST/SEPTEMBER,31,30
DATA SEPTEMBER/OCTOBER,30,31, OCTOBER/NOVEMBER,31,30, NOVEMBER/DECEMBER,30,31
DATA DECEMBER/JANUARY,31,31
adsherm
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)