Compucolor.org – Virtual Media

Listing of file='CALEND.BAS;01' on disk='vmedia/chip_62-sector.ccvf'

10 REM   *******  ADAPTED FOR CUVIC - APRIL, 1982 ******
20 REM
30 REM            KEITH OCHILTREE
40 REM            1/1049 BURKE RD,
50 REM            EAST HAWTHORN,
60 REM            VIC.       3123.
70 REM            AUSTRALIA.
80 REM
90 CLEAR 2000
100 DIM A$(15)
110 HE$= "===================="
120 HE$= HE$+ HE$
130 HE$= HE$+ HE$
140 HDR$= "                    CUVIC'S CALENDAR"
150 REM  1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
160 D$= "             1 2 3 4 5 6 7 8 910111213141516171819"
170 D$= D$+ "202122232425262728293031               "
180 HW$= "     SUN  MON  TUE  WED  THU  FRI  SAT"
190 REM  1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7
200 GOSUB 1580
210 PLOT 12,14,22,3,0,2
220 PRINT LEFT$ (HE$,63)
230 PRINT
240 PRINT HDR$
250 PRINT
260 PRINT LEFT$ (HE$,63)
270 PRINT
280 INPUT "               INPUT YEAR OF CALENDAR 19";Y
290 PLOT 15
300 GOSUB 1060
310 FOR MB= 1TO 12STEP 2
320 MC= MB
330 YC= Y
340 GOSUB 830
350 W1= W
360 MC= MB+ 1
370 YC= Y
380 GOSUB 830
390 W2= W
400 MC= MB
410 GOSUB 1010
420 M1$= MY$
430 MC= MB+ 1
440 GOSUB 1010
450 M2$= MY$
460 GOSUB 1520
470 PRINT "  "
480 ML$= "               "+ M1$+ "  "+ STR$ (Y)
490 ML$= ML$+ "                        "+ M2$+ "  "+ STR$ (Y)
500 PRINT ML$
510 PRINT
520 GOSUB 1580
530 PLOT 18,3,15,18+ MB:PRINT M1$;Y
540 PLOT 18,3,36,18+ MB:PRINT M2$;Y
550 GOSUB 1520
560 PRINT HW$;HW$
570 MC= MB
580 GOSUB 930
590 D1= DM
600 MC= MB+ 1
610 GOSUB 930
620 D2= DM
630 FOR I= 1TO 6
640 DL$= "   "
650 FOR J= 1TO 7
660 E1= ((I- 1)* 7+ J+ 6- W1)* 2- 1
670 DY$= "  "
680 IF ((I- 1)* 7+ J)= < D1+ W1THEN DY$= MID$ (D$,E1,2)
690 DL$= DL$+ "   "+ DY$
700 NEXT J
710 DL$= DL$+ "   "
720 FOR J= 1TO 7
730 E2= ((I- 1)* 7+ J+ 6- W2)* 2- 1
740 DY$= "  "
750 IF ((I- 1)* 7+ J)= < D2+ W2THEN DY$= MID$ (D$,E2,2)
760 DL$= DL$+ "   "+ DY$
770 NEXT J
780 PRINT DL$
790 NEXT I
800 NEXT MB
810 GOTO 200
820 REM  ***** WORK OUT STARTING POINT *********
830 IF MC> 2THEN 860
840 MC= MC+ 12
850 YC= YC- 1
860 W= 1+ 2* MC+ INT (.6* (MC+ 1))+ YC+ INT (YC/ 4)- INT (YC/ 100)+ INT (YC/ 400)+ 2
870 W= W- INT (W/ 7)* 7
880 W= W+ 6
890 W= W- INT (W/ 7)* 7
900 W= W+ 1
910 IF W= 7THEN W= 0
920 RETURN
930 IF MC< > 2THEN 970
940 LP= 0
950 IF (Y- INT (Y/ 4)* 4)< > 0GOTO 970
960 IF ((Y- INT (Y/ 100)* 100)= 0)AND ((Y- INT (Y/ 400))< > 0)THEN LP= 1
970 M$= "312831303130313130313031"
980 DM= VAL (MID$ (M$,2* MC- 1,2))
990 IF MC= 2THEN DM= DM+ LP
1000 RETURN
1010 MN$= "JANUARY  FEBRUARY MARCH    APRIL    "
1020 MN$= MN$+ "MAY      JUNE     JULY     AUGUST   "
1030 MN$= MN$+ "SEPTEMBEROCTOBER  NOVEMBER DECEMBER "
1040 MY$= MID$ (MN$,(MC- 1)* 9+ 1,9)
1050 RETURN
1060 GOSUB 1520
1070 PLOT 12
1080 PRINT HE$
1090 PRINT
1100 PRINT "                           C     U     V     I     C"
1110 PRINT
1120 Y$= RIGHT$ (STR$ (Y),2)
1130 PRINT "                                      19"Y$
1140 PRINT
1150 PRINT HE$
1160 PRINT
1170 GOSUB 1580
1180 GOSUB 1350
1190 GOSUB 1520
1200 FOR I= 1TO 14
1210 FOR K= 1TO 4
1220 PL$= "         "
1230 FOR J= 1TO 12
1240 J$= MID$ (A$(I),J,1)
1250 IF J$< > "0"THEN GOTO 1270
1260 PL$= PL$+ B$:GOTO 1280
1270 PL$= PL$+ A$
1280 NEXT J
1290 PRINT PL$
1300 NEXT K
1310 NEXT I
1320 PRINT :PRINT :PRINT
1330 RETURN
1340 GOSUB 1580
1350 A$= "CUVIC"
1360 B$= "     "
1370 A$(1)= "000010010000"
1380 A$(2)= A$(1)
1390 A$(3)= "000111111000"
1400 A$(4)= "001101101100"
1410 A$(5)= "001110011100"
1420 A$(6)= "000011110000"
1430 A$(7)= "001111111100"
1440 A$(8)= "011011110110"
1450 A$(9)= "110011110110"
1460 A$(10)= "011011110110"
1470 A$(11)= "001110010011"
1480 A$(12)= "000010010000"
1490 A$(13)= A$(12)
1500 A$(14)= "011110011110"
1510 RETURN
1520 REM
1530 REM  ***** PRINTER ON *****
1540 REM
1550 POKE 33289,80
1560 PLOT 27,18,3,27,13
1570 RETURN
1580 REM
1590 REM  ***** PRINTER OFF *****
1600 REM
1610 POKE 33289,64
1620 POKE 33265,0
1630 RETURN