1 GOTO910
2 REM ** ML STOP KEY DISABLE **
3 PRINT"
4 PRINT""
5 PRINT""
6 REM ** 4 - POP ML SUBROUTINE **
10 REM **GENERAL INPUT ROUTINE **
15 :
30 :
35 REM +++ INPUT SECTION +++
40 POKEU0,0:UR$="":UI$=""
42 IFUL=0THENUL=80
45 POKEUC,0
50 GETUI$:IFUI$=""THEN50
55 IFUI$=CHR$(13)ANDLEN(UR$)>=1THENPOKEUC,1:PRINT"";:GOTO85
60 IFUI$=CHR$(20)THEN105
62 IF LEN(UR$)=>ULTHEN50
65 GOSUB120:REM CHECK FOR VALID CHARACTER
70 UR$=UR$+UI$
75 PRINTUI$;
80 GOTO50
85 REM +++ CHECK FOR HELP REQUEST +++
90 IFUR$=UX$THEN195:REM EXIT TO HELP ROUTINE
95 IFUF=1THENGOSUB240
100 UF=0:PRINT:RETURN
102 REM ++ CHECK DELETE ++
105 IFLEN(UR$)<1THEN50
110 UR$=LEFT$(UR$,LEN(UR$)−1)
115 PRINT"";:GOTO50
120 REM ++ CHECK FOR VALID CHARACTERS ++
125 IFLEN(US$)=0THEN150
130 FORUS=1TOLEN(US$)
135 IFUI$=MID$(US$,US,1)THENRETURN
140 NEXT
145 UI$="":RETURN
150 REM ** STANDARD INPUT **
152 IFASC(UI$)=46THENRETURN
155 IFUI$=CHR$(32)THENRETURN
160 IFASC(UI$)<48ORASC(UI$)>57THEN170
165 RETURN
170 IFASC(UI$)<65ORASC(UI$)>90THEN180
175 RETURN
180 IFASC(UI$)<193ORASC(UI$)>218THENUI$="":RETURN
185 IFPEEK(UT)=UU%THENUI$=CHR$(ASC(UI$)−128):RETURN
187 RETURN
190 UI$="":RETURN
195 UF=1:REM +++ HELP ROUTINE EXIT +++
197 GOSUB250
200 GOSUB245
205 FORUQ=UBTO(U2%*256+U1%+U3%−2)
210 UQ%(UQ−UB)=PEEK(UQ):NEXT:PRINT""
215 UZ=1:UV%=PEEK(UT)
216 GOTO300
217 UZ=0:US$=UJ$:UG$=UK$:UP=UJ:UL=UK:IFPEEK(50003)=0THENPOKE53281,6:POKE53280,14
220 UT$=UL$:PRINT"";:POKEUT,UV%:FORUQ=UBTO(U2%*256+U1%+U3%−3)
225 POKEUQ,UQ%(UQ−UB):NEXT
230 POKEU1,U1%
232 POKEU2,U2%
233 POKEU4,U4%
234 POKEU3,U3%−1
235 GOTO35
240 UD%=((U2%*256+U1%+U3%)−UB)/40:PRINTLEFT$(UD$,UD%+1):RETURN
245 PRINTLEFT$(UD$,24);"":RETURN
250 U1%=PEEK(U1):U2%=PEEK(U2):U3%=PEEK(U3):U4%=PEEK(U4)
251 UJ$=US$:UK$=UG$:UL$=UT$:UJ=UP:UK=UL
255 RETURN
300 REM ** MENU **
301 :
302 PRINT"":POKEUT,UU%:IFPEEK(50003)=0THENPOKE53281,9:POKE53280,8
303 :
305 PRINT""
310 PRINT""
315 PRINT""
320 PRINT""
335 PRINT""
340 PRINT""
345 PRINT"";
350 UL=1:US$="":GOSUB35:REM INPUT ROUTINE
352 US$=""
355 ONVAL(UR$)GOSUB1000,400,396
360 GOTO300
395 REM ** RE-ENABLE STOP KEY AND END **
396 IFPEEK(50003)<>1ANDPEEK(50003)<>160ANDPEEK(50003)<>0THEN399
397 SYSUU+71:IFPEEK(50003)=0THENPOKE53281,6:POKE53280,14
398 PRINT"":END
399 GOSUB875:RETURN
400 REM ** STUDENT INSTRUCTIONS **
405 PRINT"":POKEUT,UL%
410 UG$="":UP=0:GOSUB850
433 PRINT""
435 PRINT""
437 PRINT""
439 PRINT""
440 PRINT""
441 PRINT""
442 PRINT""
443 PRINT""
444 PRINT""
445 GOSUB835:GOSUB850
451 PRINT"";"";
453 PRINT"";
455 PRINT"";"";
457 PRINT"";
459 PRINT"";"";
461 PRINT"";
463 PRINT"";"";
465 PRINT"";
467 PRINT"";"";
469 PRINT"";
471 PRINT"";"";
473 PRINT"";
477 PRINT""
479 PRINT""
481 PRINT""
482 PRINT""
485 GOSUB835:GOSUB850
500 PRINT""
502 PRINT""
503 PRINT""
505 PRINT""
510 GOSUB835:GOSUB850
530 PRINT""
532 PRINT""
534 PRINT""
536 PRINT""
538 PRINT""
540 PRINT"
542 PRINT""
544 PRINT""
546 PRINT""
548 GOSUB 835:GOSUB 850
550 PRINT"
552 PRINT"
554 PRINT"
556 PRINT"
558 PRINT"
560 PRINT"
562 PRINT"
564 PRINT"
566 GOSUB835
590 IFUZ=1THENSYS1115:GOTO217
599 RETURN
700 REM ** TO USE 8032 LOAD CBM4032 **
710 PRINT"
720 PRINT""
730 SYSUU+71
740 END
800 REM ** T I T L E P A G E **
802 PRINT"";:POKEUT,UU%:IFPEEK(50003)=0THENPOKE53280,14:POKE53281,6
804 FORI=1TO38:PRINT"";:NEXT
806 FORI=1TO22:PRINT"";:NEXT
808 FORI=1TO37:PRINT"";:NEXT
810 FORI=1TO22:PRINT"";:NEXT
812 PRINT"
814 PRINT"
816 PRINT"
818 PRINT"
820 PRINT"
822 PRINT"
824 PRINT"
826 REM ** COMMODORE LOGO **
827 PRINTLEFT$(UD$,24);"":I=0
828 GETA$:IFA$<>""THENI=I+1:IFI<250THEN828
830 T1$="":T2$="":T3$="":T4$="":I=0
832 GOTO300
835 REM ** SPACE BAR PRESS **
840 POKEUO,0:PRINTLEFT$(UD$,24);""
844 GETUI$:IFUI$<>""THEN844
846 RETURN
850 REM ** PAGE DESIGN ROUTINE **
852 UP=UP+1
855 PRINT""LEFT$(UT$+UP$,21);RIGHT$(UP$+UG$,18)
860 PRINT""
864 IFUH<>0THEN870
865 PRINTLEFT$(UD$,24);LEFT$(UP$,7);""
870 UH=0:PRINT"":RETURN
875 REM ** PLEASE WAIT REMARK **
880 PRINTLEFT$(UD$,24);""
885 RETURN
900 REM ** SET UP VARIABLES **
901 UX$="":DIMUQ%(1000):UB=32768:U1=196:U2=197:U3=198:U4=216:UC=167:UU=1024
902 UT=59468:UU%=12:UL%=14:UP%=1146:UM=32768:UO=158:POKE 50003,0
903 IFPEEK(50003)=0THENUB=1024:U1=209:U2=210:U3=211:U4=214:UC=204:UU=2048
904 IFPEEK(50003)=0THENUT=53272:UU%=21:UL%=23:UP%=2139:UM=1024:UO=198
905 UD$=""
906 UP$=""
907 UT$="":REM PLACE PROGRAM TITLE HERE !!!!!!!!!!!!!!!!!***
908 RETURN
910 REM ** SET VARIABLES **
915 GOSUB900
920 REM ** CHECK FOR 8032 **
925 PRINT"":PRINT"":REM SHIFTED SPACE
930 IFPEEK(UB+40)<>96THENGOSUB700
931 REM ** MEMORY CHECK **
932 IF FRE(0)>2000THEN937
933 PRINT""
934 PRINT""
935 SYSUU+71
936 END
937 PRINT"":IFPEEK(50003)=0THEN962
940 REM ** BASIC 2.0 OR 4.0 OR C-64 SETUP **
941 POKE1075,133:POKE1076,144:POKE1077,234:POKE1079,4:POKE1080,133:POKE1081,145
942 POKE1091,155:POKE1098,133:POKE1099,144:POKE1100,234:POKE1103,133
943 POKE1104,145:POKE1105,234:POKE1082,234
945 IFPEEK(50003)<>160THEN955
950 POKE1093,88:POKE1094,228:POKE1097,85:POKE1102,228:GOTO965
955 IFPEEK(50003)<>1THEN990
960 POKE1093,49:POKE1094,230:POKE1097,46:POKE1102,230:GOTO965
962 POKE2099,141:POKE2100,20:POKE2101,3:POKE2103,8:POKE2104,141:POKE2105,21
963 POKE2106,3:POKE2115,145:POKE2117,52:POKE2118,234:POKE2121,49:POKE2122,141
964 POKE2123,20:POKE2124,3:POKE2126,234:POKE2127,141:POKE2128,21:POKE2129,3
965 SYSUU+48:REM DISABLE STOP KEY
970 GOSUB800:REM TITLE
980 GOTO300:REM MENU
990 PRINT"":END
1000 IFUZ=1THENSYSUP%:SYSUP%:UZ=0:REM ** PROGRAM STARTS HERE **
1001 PRINT"";:RESTORE:IFPEEK(50003)=0THENPOKE53281,6:POKE53280,14
1020 REM COPYRIGHT OSCAR NAOYUKI NAMEKI
1030 REM CALENDAR
1040 REM COLUMBIA COLLEGE
1050 REM 1619 W10 AVE VANCOUVER BC
1060 POKEUT,UL%:W=1:UG$="":UP=1:GOSUB850:PRINT"":GOSUB2030
1070 PRINT"";
1080 PRINT "":GOSUB835
1100 UH=1:UP=UP+1:GOSUB850
1120 PRINT"";
1125 US$="":UL=4:GOSUB35:A=VAL(UR$)
1126 IF A<1752 THEN 1120
1130 B=(A/100):C=INT(A/100):D=B−C
1140 REM--CALCULATION OF LEAP YEAR
1150 IF D=0 THEN 1190
1160 B=(A/4):C=INT(A/4):D=B−C
1170 IF D=0 THEN 1230
1180 GOTO 1250
1190 B=(A/400):C=INT(A/400):D=B−C
1200 IF D=0 THEN 1230
1210 GOTO 1250
1230 PRINT""
1240 X=1:GOTO 1260
1250 X=0
1260 F=INT(A/4):G=INT(A/400):H=INT(A/100)
1270 J=F+G−H
1280 L=(A+J)/7:M=INT((A+J)/7):Q=(L−M)*7:O=INT(Q):R=Q−O
1290 IF R>0.9 THEN O=O+1
1300 O=O−X
1310 IF O<0 THEN O=O+7
1330 PRINT"";
1335 US$="":UL=8:GOSUB35:B$=UR$
1350 GOSUB2520
1360 PRINTCHR$(147)
1370 IF B$="" THEN A$=""
1380 IF B$="" OR B$="" OR A$="" THEN GOSUB 1900
1390 IF B$=""OR B$="" OR A$="" THEN GOSUB 1910
1400 IF B$="" OR B$="" OR A$="" THEN GOSUB 1920
1410 IF B$="" OR B$="" OR A$="" THEN GOSUB 1930
1420 IF B$="" OR B$="" OR A$="" THEN GOSUB 1940
1430 IF B$="" OR B$="" OR A$="" THEN GOSUB 1950
1440 IF B$="" OR B$="" OR A$="" THEN GOSUB 1960
1450 IF B$="" OR B$="" OR A$="" THEN GOSUB 1970
1460 IF B$=""OR B$="" OR A$="" THEN GOSUB 1980
1470 IF B$="" OR B$="" OR A$="" THEN GOSUB 1990
1480 IF B$="" OR B$="" OR A$="" THEN GOSUB 2000
1490 IF B$="" OR B$="" OR A$="" THEN GOSUB 2010
1500 UH=1:UG$="":UP=UP+1:GOSUB850
1510 PRINT"";
1520 US$="":UL=1:GOSUB35:C$=UR$
1540 IF C$=""THEN UP=0:GOTO1100
1550 CLR:GOSUB900:GOSUB300
1560 END
1570 IF Z>6 THEN Z=Z−7
1580 IF Z<0 THEN Z=Z+7
1620 REM WRITING CALENDAR
1630 W=20:GOSUB2020
1640 PRINT"";"";
1650 A=INT(A)
1660 PRINT TAB(3);B$,TAB(20);A
1670 PRINT"";TAB(3);""
1680 PRINT"";
1690 FOR K=0 TO 5
1700 L=(K*7)+1:M=L+6
1710 FOR N=L TO M
1720 P=N−Z
1730 IF P<=0 THEN 1820
1740 IF N>7 THEN Z1=N−(7*K):GOTO 1760
1750 Z1=N
1760 IF P>9 THEN 1780
1770 I=(5*Z1)−2:GOTO 1790
1780 I=(5*Z1)−3
1790 IF P>Y THEN 1860
1800 IF P=Q THEN PRINT TAB(I);"";P:PRINT:PRINT "":GOTO 1820
1810 PRINT TAB(I);P;
1820 NEXT N
1830 PRINT
1840 PRINT
1850 NEXT K
1860 PRINT
1870 GOSUB835:RETURN
1900 Z=O :Y=31 :B$="" :GOSUB 1570:RETURN
1910 Z=O+3 :Y=28+X :B$="" :GOSUB 1570:RETURN
1920 Z=O+3+X :Y=31 :B$="" :GOSUB 1570:RETURN
1930 Z=O−1+X :Y=30 :B$="" :GOSUB 1570:RETURN
1940 Z=O+1+X :Y=31 :B$="" :GOSUB 1570:RETURN
1950 Z=O+4+X :Y=30 :B$="" :GOSUB 1570:RETURN
1960 Z=O−1+X :Y=31 :B$="" :GOSUB 1570:RETURN
1970 Z=O+2+X :Y=31 :B$="" :GOSUB 1570:RETURN
1980 Z=O+5+X :Y=30 :B$="" :GOSUB 1570:RETURN
1990 Z=O+X :Y=31 :B$="" :GOSUB 1570:RETURN
2000 Z=O+3+X :Y=30 :B$="" :GOSUB 1570:RETURN
2010 Z=O+5+X :Y=31 :B$="" :GOSUB 1570:RETURN
2020 PRINT""
2030 PRINT"";
2040 FOR C=1 TO 35
2050 PRINT "";
2060 NEXT C
2070 PRINT""
2080 FOR C=1 TO W
2090 PRINT TAB(0);"";TAB(38);""
2100 NEXT C
2110 PRINT "";
2120 FOR C=1 TO 35
2130 PRINT "";
2140 NEXT C
2150 PRINT ""
2160 RETURN
2520 PRINT"";
2530 US$="":UL=1:GOSUB35:V$=UR$
2550 IFV$="" THEN GOTO2620
2560 PRINT"";
2570 US$="":UL=2:GOSUB35:Q=VAL(UR$)
2620 RETURN
READY.
