10 'cal 59618-62812
20 U=63843
30 X=U+1:Y=60797:IFPEEK(U-1)<192THEN70
40 GOSUB1050:GOSUB1270
50 IFX=U+6THENUU=U-1:U=PEEK(U+1)*256+PEEK(U):N=U:GOTO90
60 IFPEEK(X)=PEEK(Y)THEN40
70 U=U+11:IFU=64140THEN120
80 GOTO30
90 IFPEEK(N)=26THENW=N:GOTO120
100 GOSUB1280:GOTO90
120 MD=PEEK(63788):G=PEEK(63790)*10+PEEK(63789):H=PEEK(63786)*10+PEEK(63785)
130 CALL16945:GOSUB1320:QQ=1:FF=0
140 PRINT" ";
150 K=17
160 POKE62875,MD-2:V=G
170 Z=0:GOSUB1420:POKE62875,PEEK(62875)+1
180 GOSUB1240
190 POKE62876,PEEK(62875)+1
200 GOSUB1310
210 DD=PEEK(62874+N):J=(4*DD+23)\10:B=V+1900
220 IFDD<3THENJ=0:B=B-1
230 L=365*V+31*(DD-1)+1+B\4-J
235 IFN=1THENT=L
240 GOSUB1280:IFN<3THEN210
250 P=L-T:T=T-841:L=(T-(T\7)*7)*10\7
280 GOSUB1310
290 IFPEEK(62879+L)=N THEN310
300 GOSUB1280:IFN<8THEN290
310 O=N:PRINT"   ";
320 L=PEEK(62875)*3:N=L-3
330 PRINTCHR$(PEEK(23273+N));
340 GOSUB1280:IFN<LTHEN330
350 PRINTV+1900;:WW=8:L=10
360 GOSUB1430:IFL<24THEN360
370 L=1:GOSUB1420:WW=15:GOSUB1370
380 GOSUB1310
390 IF Z THEN420
400 IFN>O-1THEN420
410 X=X+8:GOTO480
420 IFPEEK(62875)=MD THENIFL=H THENR=X:S=WW
430 GOSUB1459:IF DD THENGOSUB1330:GOSUB930:GOTO450
440 GOSUB960
450 GOSUB1320
460 IFL=P THEN520
470 GOSUB1450
480 GOSUB1050
490 GOSUB1280:IFN<8THEN390
500 GOSUB1420
510 WW=WW+7:Z=1:GOTO380
520 K=K+72
530 IFQQ<3THENPOKE62876+QQ,L:QQ=QQ+1:GOTO170
540 POKE62875,MD:GOSUB1370
550 GOSUB1460:IF DD THENGOSUB1330:GOSUB1340:GOTO570
560 GOSUB1320:CALL21274
570 GOSUB920
580 IF FF THEN610
590 GOSUB1460:IF DD THENGOSUB1170:GOSUB1300:GOTO610
600 GOSUB1290:PRINT"Prev Next ToDo Appt";G+1899;"NOTE";G+1901;"Menu";:GOSUB1300
610 I=PEEK(65446):IFI<44THEN850
620 POKE65446,0:ONI-43GOTO630,650,670,690,850,850,850,850,850,850,850,850,750,760,770,790,810,830,820,840
630 H=H-1:R=R-9:IFR=80THENR=143:GOTO680
640 GOTO710
650 H=H+1:R=R+9:IFR=152THENR=89:GOTO700
660 GOTO710
670 H=H-7
680 S=S-7:GOTO710
690 H=H+7
700 S=S+7
710 FF=0
720 IFH>PEEK(62878)THENH=H-PEEK(62878):GOTO760
730 IFH<1THENH=PEEK(62877)+H:GOTO750
740 GOTO550
750 MD=MD-1:GOTO880
760 MD=MD+1:GOTO880
770 IF OT THENHH=OT:GOSUB1180:GOSUB1300:Q=OT:OT=0:GOSUB1110:IF OT=0 THENGOSUB1060
780 GOTO850
790 GOSUB1460:IF DD THEN Q=DD:POKEPT,0:POKEPT+1,0:GOSUB1110:GOTO900
800 GOTO850
810 G=G-1:GOTO130
820 G=G+1:GOTO130
830 IF UU THENCALL22848,192,UU
840 POKE65450,0:CALL22423
850 GOSUB1460:IF DD THENGOSUB1320:GOSUB1340:GOTO870
860 GOSUB1330:CALL21274
870 GOSUB920:GOTO550
880 POKE62875,MD:V=G:GOSUB1240
890 MD=PEEK(62875):G=V:GOTO130
900 GOSUB1460:IF DD=0 THENGOSUB1060
910 GOSUB1170:GOTO550
920 X=R:WW=S:L=H
930 Y=WW-1
940 LINE(X-1,Y)-(X+7,Y),C
950 GOSUB1270:IFY<WW+6THEN940
960 IF L<10THENA=L:X=X+4:GOTO990
970 A=L\10:GOSUB990
980 A=L-A*10
990 RR=62888
1000 BB=PEEK(A*3+RR):RR=RR+1
1010 E=1:Y=WW
1020 IFE ANDBB THENLINE(X,Y)-(X,Y),C+1
1030 GOSUB1270:IFE<BB THENE=E+E:GOTO1020
1040 GOSUB1050:IFRR<62891THEN1000
1050 X=X+1:RETURN
1060 Q=U
1070 IFPEEK(Q)<58THEN1100
1080 IFOT=0THENOT=Q
1090 GOTO1110
1100 GOSUB1160:IFFQ=PEEK(62875)THENGOSUB1160:IFFQ<32THEN1140
1110 IFQ>W-1THENRETURN
1120 Q=Q+1:IFPEEK(Q-1)=10THEN1070
1130 GOTO1110
1140 GOSUB1458:IF DD=0THENPOKEPT+1,Q/256:POKEPT,Q-(Q/256)*256
1150 GOTO1110
1160 FQ=(PEEK(Q)-48)*10+PEEK(Q+1)-48:Q=Q+3:RETURN
1170 GOSUB1460:HH=DD
1180 GOSUB1290
1190 HT=HH+39
1200 PP=PEEK(HH)
1210 IFHH=HT THENRETURN
1220 HH=HH+1:IFPP<27THENCALL16989:RETURN
1230 PRINTCHR$(PP);:GOTO1200
1240 IFPEEK(62875)=13THENPOKE62875,1:V=V+1
1250 IFPEEK(62875)=0THENPOKE62875,12:V=V-1
1260 RETURN
1270 Y=Y+1:RETURN
1280 N=N+1:RETURN
1290 POKE63033,8:POKE63034,1:RETURN
1300 FF=1:RETURN
1310 N=1:RETURN
1320 C=0:RETURN
1330 C=1:RETURN
1340 N=-2000
1350 GOSUB1280:IF N THEN1350
1360 RETURN
1370 GOSUB1310
1380 POKE62812+N,0
1390 GOSUB1280:IFN<63THEN1380
1400 IF W THENGOSUB1060
1410 RETURN
1420 X=K:RETURN
1430 GOSUB1440:GOSUB1440:GOTO1050
1440 A=0:GOSUB980
1450 L=L+1:RETURN
1458 TD=FQ:GOTO1470
1459 TD=L:GOTO1470
1460 TD=H
1470 PT=62811+TD*2
1480 DD=PEEK(PT+1)*256+PEEK(PT):RETURN
  
Technical
 
  The first part of CAl was compiled with TCOMP.121 from 59618 - 62812. The data for the character set is stored from 62813 to 62959
at three bytes each. I have included the program that creates the data I used. Let me be a litte more clear here. Cal.Src has TWO 
programs in it. You do not need Cal.Src unless you want to make some changes, or you whould like add some of my ideas to your own 
program. Since there are no FOR-NEXT loops Change LINE 7071 in Tcomp to read:
     :VT=VT+2: 
 Lines:
  10 -  80 File search
  90 - 100 Find EOF of File
 100 - 120 Get Date and Year
 130 - 310 Make calndar
 320 - 350 Print month and year
 360 - 510 Draw month
 520 - 530 Next Month
 540       Set current year - wait
 550 - 570 Flash cursor
 580 - 600 Print label line if not Flag
 610 - 620 Keyboard input
 630 - 640 Left
 650 - 660 Right
 670 - 680 Up
 690 - 700 Down
 710       Move, Set Flag to Print
 720 - 730 Still valid day
 740       Do again
 750 - 760 Change month
 770 - 780 Check for ToDo
 790 - 800 Check for Appointment
 810 - 820 Change year
 830       Goto NOTE
 840       Goto MENU
 850 - 870 Flash cursor
 880 - 890 Check for valid month
 900 - 910 Get next Appointment
 920 -1050 Draw character
1060 -1160 Search NOTE
1170 -1230 Print character
1240 -1260 Check for vaild month Sub
1270 -1480 Support routines
 
 BELOW ----- *** Data Statements not to be compliled. Creates M/L program to be added to the end of part 1 of Cal.CO
 
 If you have any problems send me E-mail.
 
 Fred Edelkamp
  [70506,223]
 
2000 CLEAR256,59510
2002 FORX=62813TO62878:POKEX,0:NEXT
2010 FORX=62879 TO 62959:READ D:POKEX,D:NEXT
2020 SAVEM"Caldat",62813,62959
2030 DATA 3,4,5,0,6,7,0,1,2
2048 DATA 31,17,31:'0
2049 DATA 18,31,16:'1
2050 DATA 29,21,23:'2
2051 DATA 17,21,31:'3
2052 DATA 6,4,31  :'4
2053 DATA 23,21,29:'5
2054 DATA 31,21,29:'6
2055 DATA 1,29,3  :'7
2056 DATA 31,21,31:'8
2057 DATA 7,5,31  :'9
2058 DATA 23,21,29:'S
2059 DATA 31,16,31:'U
2060 DATA 31,6,31 :'M
2061 DATA 31,17,31:'O
2062 DATA 1,31,1  :'T
2063 DATA 31,16,31:'U
2064 DATA 31,12,31:'W
2065 DATA 31,21,17:'E
2066 DATA 1,31,1  :'T
2067 DATA 31,4,31 :'H
2068 DATA 31,5,1  :'F
2069 DATA 31,9,22 :'R
2070 DATA 23,21,29:'S
2071 DATA 30,5,30 :'A