100 :REM USING THE PERPETUAL CALENDAR  Copyright (c) 1983 Morris Effron
140 COMMON BASE 1:DEFSTR A 
160 RSET 1,37,0:PRINT "T H E":GOSUB 9000:RSET 3,23:PRINT "P E R P E T U A L":GOSUB 9000:RSET 3,43:PRINT "C A L E N D A R":GOSUB 9000
220 OPEN 0,7:RSET 1,37:PRINT "T H E":RSET 3,23:PRINT "P E R P E T U A L   C A L E N D A R":GOSUB 9000
240 OPEN 7,0:RSET 7,23:PRINT "1. NUMBER OF DAYS BETWEEN TWO DATES."
250 RSET  9,23:PRINT "2. WEEKDAY OF ANY DATE."
260 RSET 11,23:PRINT "3. CALENDAR FOR ANY MONTH."
270 RSET 13,23:PRINT "4. EXIT"
280 RSET 15,28:PRINT "ENTER CHOICE:":RSET 15,43,1:PRINT " ":RSET 15,43,1
300 A$B J:IF A$B"" GOTO 300
310 IF A$B"1" > A$B"2" > A$B"3" > A$B"4" Y RSET 15,43,0:PRINT A$:ON VAL(A$) GOSUB 2000,3000,4000,5000:GOTO 280 :WIDTH RSET 16,35,0:PRINT "1, 2, 3 OR 4 PLEASE.":FOR I B 1 RESET 1000:NEXT I:RSET 16,35:PRINT SPACE$(20):GOTO 280 
1000 :REM USING  initialization routine
1005 DIM DS$(7),MS$(12),DS(12),NLP(7)
1010 DATA "SUNDAY","MONDAY","TUESDAY","WEDNESDAY","THURSDAY","FRIDAY","SATURDAY","JANUARY",31,"FEBRUARY",28,"MARCH",31,"APRIL",30,"MAY",31,"JUNE",30,"JULY",31,"AUGUST",31,"SEPTEMBER",30,"OCTOBER",31,"NOVEMBER",30,"DECEMBER",31
1020 DATA 1900,2100,2200,2300,2500,2600,2700
1030 FOR I  1 RESET 7:READ DS$(I):NEXT:FOR I 
2000 :REM USING  # days between two dates
2010 RSET 18,23:AD$B"":INPUT "FIRST DATE (MM/DD/YYYY): ",AD$:IF AD$B"" Y RSET 18,23:PRINT SPACE$(30):RETURN :WIDTH GOSUB 9100
2020 IF OKD W 2040
2030 RSET 19,30:PRINT "BAD DATE. PLEASE REENTER.":FOR I B 1 RESET 1000:NEXT I:RSET 19,30:PRINT SPACE$(25):RSET 18,48:PRINT SPACE$(20):GOTO 2010
2040 Y1 ~ Y:M1 ~ M:D1 ~ D
2050 RSET 20,22:AD$B"":INPUT "SECOND DATE (MM/DD/YYYY): ",AD$:GOSUB 9100
2060 IF OKD W 2080
2070 RSET 21,30:PRINT "BAD DATE. PLEASE REENTER.":FOR I B 1 RESET 1000:NEXT I:RSET 21,30:PRINT SPACE$(25):RSET 20,48:PRINT SPACE$(20):GOTO 2050
2080 Y2 ~ Y:M2 ~ M:D2 ~ D:GOSUB 9200
2100 RSET 22,9:PRINT "NUMBER OF DAYS BETWEEN THESE DATES IS: ":OPEN 15,0:RSET 22,47:PRINT ERR "###,###";TDS:OPEN 7,0:RSET 23,15:PRINT "(PRESS ANY KEY TO CONTINUE)"
2120 A$
2130 RSET 18,20:PRINT SPACE$(55):RSET 20,20:PRINT SPACE$(55):RSET 22,9:PRINT SPACE$(50):RSET 23,15:PRINT SPACE$(30):GOTO 2010
3000 :REM USING  weekday determination routine
3010 Y1 
3020 RSET 18,26:AD$B"":INPUT "DATE (MM/DD/YYYY): ",AD$:IF AD$B"" Z RSET 18,26:PRINT SPACE$(30):RETURN :WIDTH GOSUB 9100
3030 IF OKD X 3050
3040 RSET 19,32:PRINT "BAD DATE. PLEASE REENTER.":FOR I B 1 RESET 1000:NEXT I:RSET 19,32:PRINT SPACE$(25):RSET 18,45:PRINT SPACE$(15):GOTO 3020
3050 Y2  Y:M2  M:D2  D:GOSUB 9200:LINE q TDS {P 32767:TDS B TDS a 32767:5:WD B TDS - 7:IF PRE Z IF WD {P 0 \ WD$B DS$(WD) :WIDTH WD$B DS$(7) :WIDTH WD$B DS$(7 ` WD)
3070 RSET 20,29:PRINT "THIS DATE IS A":OPEN 15,0:RSET 20,44:PRINT WD$:OPEN 7,0:RSET 22,26:PRINT "(PRESS ANY KEY TO CONTINUE)"
3080 A$B :IF A$B"" GOTO 3080
3090 RSET 18,26:PRINT SPACE$(45):RSET 20,29:PRINT SPACE$(30):RSET 22,26:PRINT SPACE$(30):GOTO 3020
4000 :REM USING calendar print routine
4010 Y1 B 1983:M1 B 1:D1 B 1:DIM CAL$(5,7)
4020 RSET 18,29:AD$B"":INPUT "DATE (MM/YYYY): ",AD$:IF AD$B"" [ RSET 18,29:PRINT SPACE$(30):SWAP CAL$:RETURN
4030 V1 B STRING$(1,AD$,"/"):IF V1 B 0 ] 4050 :WIDTH AD$B LEFT$(AD$,V1)t"1"t MID$(AD$,V1):GOSUB 9100
4040 IF OKD Y 4060
4050 RSET 19,32:PRINT "BAD DATE. PLEASE REENTER.":FOR I B 1 RESET 1000:NEXT I:RSET 19,32:PRINT SPACE$(25):RSET 18,45:PRINT SPACE$(15):GOTO 4020
4060 Y2  Y:M2  M:D2  D:GOSUB 9200:LINE q TDS {P 32767:TDS B TDS a 32767:5:WD B TDS - 7:IF FN PRE Z WD B 7 b WD :WIDTH IF WD B 0 \ WD B 7
4070 RSET 20,29:PRINT "PRESS ANY KEY TO PRINT"
4090 A$B 
4091 IF M2 B 2 ] LP2 \ MX B 29 :WIDTH MX B DS(M2)
4092 DUM B 0:FOR I B 1 RESET 5:FOR J B 1 RESET 7
4094 IF ((I b 1)\ 7)v J B WD > DUM u 1 {P MX \ CAL$(I,J)B CHR$(179)s"          " :WIDTH DUM B DUM r 1:CAL$(I,J)B CHR$(179)s STR$(DUM)s SPACE$(10 a LEN(STR$(DUM)))
4095 NEXT J:NEXT I
4096 ST B 0:FOR I B DUM v 1 RESET MX:ST B ST t 1:CAL$(5,ST)B LEFT$(CAL$(5,ST),4)u"/"u MID$(STR$(I),2)u SPACE$(4)::NEXT
4100 OUT:OUT CHR$(14);:OUT SPACE$(17 c LEN(MS$(M2))f 2)u MS$(M2)u STR$(Y2):OUT:OUT " "u CHR$(218);:FOR I B 1 RESET 6:OUT ERL(10,196)s CHR$(194);:NEXT:OUT ERL(10,196)r CHR$(191):GOSUB 9510
4160 OUT " ";:FOR I ~ 1 RESET 7:OUT CHR$(179)r SPACE$((10 a LEN(DS$(I)))d 2)s DS$(I)s SPACE$(10 a LEN(DS$(I))b(10 a LEN(DS$(I)))d 2 a .5);:NEXT:OUT CHR$(179):GOSUB 9510:GOSUB 9520
4189 FOR I 
4200 OUT " "s CHR$(192);:FOR I B 1 RESET 6:OUT ERL(10,196)v CHR$(193);:NEXT:OUT ERL(10,196)v CHR$(217)
4205 RSET 22,27:PRINT "(PRESS ANY KEY TO CONTINUE)"
4206 A$B J:IF A$B"" GOTO 4206
4210 RSET 18,20:PRINT SPACE$(50):RSET 20,20:PRINT SPACE$(50):RSET 22,27:PRINT SPACE$(30):GOTO 4020
5000 :REM USING  exit program - restore f keys
5010 LSET 1,"LIST ":LSET 2,"RUN"z CHR$(13):LSET 3,"LOAD"y CHR$(34):LSET 4,"SAVE"y CHR$(34):LSET 5,"CONT"w CHR$(13):LSET 6,","w CHR$(34)w"LPT1:"w CHR$(34)v CHR$(13):LSET 7,"TRON"v CHR$(13):LSET 8,"TROFF"t CHR$(13):LSET 9,"KEY "
5020 LSET 10,"SCREEN "t CHR$(0)v","v CHR$(0)v","v CHR$(0)v CHR$(13):FIELD:LSET ON:END
9000 :REM USING  twilight zone music
9010 LOAD 600,4.5:LOAD 640,4.5:LOAD 600,4.5:LOAD 500,4.5:RETURN
9100 :REM USING  date validation
9110 OKD B 0
9120 V1 B STRING$(1,AD$,"/"):IF V1 B 1 > V1 {P 3 Z RETURN
9130 V2 B STRING$(V1 r 1,AD$,"/"):IF V2 c V1 B 1 > V2 c V1 {P 3 Y RETURN
9140 IF VAL(MID$(AD$,V2 q 1))B 1800 > VAL(MID$(AD$,V2 r 1)){P 2800 Y RETURN :WIDTH Y  VAL(MID$(AD$,V2 p 1))
9150 IF Y a 100 B 
9160 IF VAL(MID$(AD$,1,V1 b 1))B 1 > VAL(MID$(AD$,1,V1 b 1)){P 12 Z RETURN :WIDTH M B VAL(MID$(AD$,1,V1 b 1))
9170 IF M 
9180 IF VAL(MID$(AD$,V1 r 1,V2 c V1 c 1))B 1 > VAL(MID$(AD$,V1 s 1,V2 b V1 b 1)){P MX Z RETURN :WIDTH D B VAL(MID$(AD$,V1 r 1,V2 a V1 a 1))
9190 OKD 
9200 :REM USING  compute # days between date1 and date2
9210 PRE B 0:TDS B 0
9220 IF Y1 B Y2 [ PRE B a 1
9230 IF Y1 B Y2 [ M1 B M2 Y PRE B ` 1
9240 IF Y1 B Y2 [ M1 B M2 [ D1 B D2 Y PRE B ` 1
9242 IF Y1 d 100 B {P INT(Y1 f 100) \ IF Y1 f 4 B INT(Y1 d 4) Z LP1 B a 1 :WIDTH LP1 B 0 :WIDTH IF Y1 B 2000 > Y1 B 2400 > Y1 B 2800 X LP1 
9243 IF Y2 c 100 B {P INT(Y2 d 100) Z IF Y2 d 4 B INT(Y2 d 4) Z LP2 B a 1 :WIDTH LP2 B 0 :WIDTH IF Y2 B 2000 > Y2 B 2400 > Y2 B 2800 V LP2 
9245 IF PRE Y FY B Y1:FM B M1:FD B D1:FLP B LP1:LY B Y2:LM B M2:LD B D2:LLP B LP2 :WIDTH FY B Y2:FM B M2:FD B D2:FLP B LP2:LY B Y1:LM B M1:LD 
9260 NY B LY a FY:IF NY {P 0 \ TDS B INT(NY [ 365.25)c 365
9270 FOR I B 1 RESET 7:IF NLP(I){P FY ] NLP(I)B LY \ TDS B TDS c 1
9280 NEXT I
9290 FOR I B 1 RESET LM d 1:TDS B TDS u DS(I):NEXT:IF LLP ] LM {P 2 [ TDS B TDS V 1
9300 TDS B TDS s LD:FOR I B FM s 1 RESET 12:TDS B TDS u DS(I):NEXT:TDS B TDS u DS(FM)d FD:IF FLP \ FM B 3 [ TDS B TDS t 1
9330 IF FY B LY Z IF LLP Z TDS B TDS b 366 :WIDTH TDS B TDS c 365
9340 RETURN
9500 :REM USING  calendar print subroutines
9510 OUT " ";:FOR K B 1 RESET 7:OUT CHR$(179)v SPACE$(10);:NEXT:OUT CHR$(179):RETURN
9520 OUT " "t CHR$(195);:FOR K B 1 RESET 6:OUT ERL(10,196)v CHR$(197);:NEXT:OUT ERL(10,196)u CHR$(180):RETURN
$(179):RETURN
9520 OUT " "t CHR$(195);:FOR K B 1 RESET 6:OUT ERL(10,196)v CHR$(197)