mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 17:26:38 +00:00
118 lines
3.1 KiB
QBasic
118 lines
3.1 KiB
QBasic
100' NAME--CALENDAR
|
||
110'
|
||
120' DESCRIPTION--DETERMINES THE DAY OF THE WEEK ON WHICH A
|
||
130' GIVEN DATE FALLS.
|
||
140'
|
||
150' SOURCE--UNKNOWN
|
||
160'
|
||
170' INSTRUCTIONS--TYPE "RUN" AND FOLLOW INSTRUCTIONS.
|
||
180'
|
||
190'
|
||
200' * * * * * * * MAIN PROGRAM * * * * * * * * *
|
||
210'
|
||
220 PRINT "THIS PROGRAM DETERMINES THE DAY OF THE WEEK"
|
||
230 PRINT "ON WHICH A GIVEN DATE FALLS."
|
||
240 DIM F(12), L(12)
|
||
250 MAT READ F
|
||
260 DATA 0, 3, 3, 6, 1, 4, 6, 2, 5, 0, 3, 5
|
||
270 MAT READ L
|
||
280 DATA 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
|
||
290 GOTO 960
|
||
300 IF Y < 1 THEN 470
|
||
310 IF M > 12 THEN 470
|
||
320 IF M < 1 THEN 470
|
||
330 IF D < 1 THEN 470
|
||
340 IF Y > 1752 THEN 540
|
||
350 IF Y < 1582 THEN 490
|
||
360 IF Y = 1752 THEN 430
|
||
370 IF Y = 1582 THEN 390
|
||
380 GO TO 510
|
||
390 IF M < 10 THEN 490
|
||
400 IF M > 10 THEN 510
|
||
410 IF D < 15 THEN 490
|
||
420 GO TO 510
|
||
430 IF M < 9 THEN 510
|
||
440 IF M > 9 THEN 540
|
||
450 IF D < 14 THEN 510
|
||
460 GO TO 540
|
||
470 PRINT "UNACCEPTABLE DATA -- TRY AGAIN."
|
||
480 GOTO 970
|
||
490 LET G1 = 0
|
||
500 GO TO 520
|
||
510 LET G1 = 1
|
||
520 LET J1 = 1
|
||
530 GO TO 560
|
||
540 LET G1 = 1
|
||
550 LET J1 = 0
|
||
560 IF J1 <> 1 THEN 740
|
||
570 LET L1 = 0
|
||
580 LET A = Y + INT((Y+3)/4)
|
||
590 IF Y <> INT(Y/4)*4 THEN 640
|
||
600 LET L1 = 1
|
||
610 IF M < 3 THEN 640
|
||
620 LET L = 1
|
||
630 GO TO 650
|
||
640 LET L = 0
|
||
650 LET Z = A + D + L + F(M) + 5
|
||
660 LET Z = Z - INT(Z/7)*7
|
||
670 LET Q = L(M)
|
||
680 IF M <> 2 THEN 700
|
||
690 LET Q = Q + L1
|
||
700 IF D > Q THEN 470
|
||
710 PRINT "OLD STYLE CALENDAR: ";
|
||
720 LET W=1
|
||
730 GOSUB 1110
|
||
740 IF G1<>1 THEN 970
|
||
750 LET L1 = 0
|
||
760 LET Y = Y - 400*INT(Y/400)
|
||
770 LET A = Y + INT((Y+3)/4) - INT((Y-1)/100)
|
||
780 IF Y <> INT(Y/4)*4 THEN 850
|
||
790 IF Y = 0 THEN 810
|
||
800 IF Y = 100*INT(Y/100) THEN 850
|
||
810 LET L1 = 1
|
||
820 IF M < 3 THEN 850
|
||
830 LET L = 1
|
||
840 GO TO 860
|
||
850 LET L =0
|
||
860 LET Z = A + D + L + F(M)
|
||
870 LET Z = Z - INT(Z/7)*7
|
||
880 LET Q = L(M)
|
||
890 IF M <> 2 THEN 910
|
||
900 LET Q = Q + L1
|
||
910 IF D > Q THEN 470
|
||
920 IF W=0 THEN 940
|
||
930 PRINT "NEW STYLE CALENDAR: ";
|
||
940 GOSUB 1110
|
||
950 GOTO 970
|
||
960 PRINT "ENTER MONTH NUMBER, DATE, AND YEAR."
|
||
970 PRINT
|
||
980 IF W1=0 THEN 1060
|
||
990 PRINT "IS THERE ANOTHER DATE YOU WANT TO KNOW";
|
||
1000 MAT INPUT A$
|
||
1010 IF A$(1)="NO" THEN 1260
|
||
1020 IF A$(1)="YES" THEN 1050
|
||
1030 PRINT "INCORRECT ANSWER. PLEASE TYPE 'YES' OR 'NO'."
|
||
1040 GOTO 1000
|
||
1050 PRINT
|
||
1060 PRINT "ENTER DATE: ";
|
||
1070 LET W=0
|
||
1080 LET W1=1
|
||
1090 INPUT M, D, Y
|
||
1100 GO TO 300
|
||
1110 ON Z+1 THEN 1120,1140,1160,1180,1200,1220,1240
|
||
1120 PRINT "FRIDAY"
|
||
1130 RETURN
|
||
1140 PRINT "SATURDAY"
|
||
1150 RETURN
|
||
1160 PRINT "SUNDAY"
|
||
1170 RETURN
|
||
1180 PRINT "MONDAY"
|
||
1190 RETURN
|
||
1200 PRINT "TUESDAY"
|
||
1210 RETURN
|
||
1220 PRINT "WEDNESDAY"
|
||
1230 RETURN
|
||
1240 PRINT "THURSDAY"
|
||
1250 RETURN
|
||
1260 END
|
||
|