10 IPL "TILDE.BA"
20 KEY 6,"Sleep"+CHR$(13)
50 DEFDBL A,O:DEFINT Y,M,W,D,X,N,P-S
60 A=RND(-VAL(LEFT$(TIME$,2)+MID$(TIME$,4,2)+RIGHT$(TIME$,2)))
70 DIM D(100)
90 P=1
100 PRINT "Tilde date converter"
110 INPUT "Format";F$
130 IF F$="e" OR F$="elf" THEN GOSUB 300:GOSUB 500:GOSUB 600
140 IF F$="c" OR F$="com" THEN GOSUB 200:GOSUB 500:GOSUB 600
150 IF VAL(LEFT$(F$,1))<>0 THEN GOSUB 700
160 IF F$="Menu" THEN IPL:MENU
170 IF F$="Sleep" THEN POWER OFF
190 GOTO 110
200 INPUT "Year,month,week,day";Y,M,W,D
210 A=(Y\8)*291*8:Y=Y MOD 8
220 IF Y>1 THEN A=A+8
222 IF Y>3 THEN A=A+8
224 IF Y>5 THEN A=A+8
226 IF (Y=1 OR Y=3 OR Y=5) AND M>5 THEN A=A+8
230 A=A+ (D-1) + (W-1)*8 + (M-1)*24 + Y*288
290 RETURN
300 INPUT "Year,month,day";Y,M,D
310 A=0
320 IF (Y>99) THEN A=A+28809:Y=Y-100:GOTO 320
330 A=A+(Y-1)*297 + (M-1)*33 + (D-1)
340 IF (Y>5) THEN A=A- ((Y-6)\5)*33
350 RETURN
500 O=A:M=1:W=0
510 Y=INT(O/(291*8))*8:O=O-Y*291
520 D=(O MOD 8)+1:O=O\8
525 Q=0
530 IF Q=1 OR Q=3 OR Q=5 THEN L=1 ELSE L=0
540 IF O>=36+L THEN Y=Y+1:O=O-36-L:Q=Q+1:GOTO 530
550 IF M=5 AND L<>0 THEN Q=4 ELSE Q=3
560 IF (O>=Q) THEN O=O-Q:M=M+1:GOTO 550
570 W=O+1
590 IF P THEN PRINT USING "Day: ###### Common: #### ##/##/##";A,Y,M,W,D
595 RETURN
600 O=A:Y=0:M=0:D=0
605 IF O>=28809 THEN O=O-28809:Y=Y+100:GOTO 605
610 IF O>=1485 THEN O=O-1485:Y=Y+5
620 X=INT(O/1452):Y=Y+X*5:O=O-X*1452
630 D=O MOD 33:O=O\33
640 M=O MOD 9:O=O\9
660 Y=Y+O
680 Y=Y+1:M=M+1:D=D+1
690 IF P THEN PRINT USING "Day: ###### Elf: Century ##: ##/##/##";A,Y\100+1,Y MOD 100,M,D
699 RETURN
700 M=0
705 X=INSTR(F$,"s"):IF X<>0 THEN FOR Y=0 TO 100:D(Y)=0:NEXT Y:M=1:GOTO 720
710 X=INSTR(F$,"d"):IF X=0 THEN RETURN
720 N=VAL(LEFT$(F$,X-1))
730 F$=MID$(F$,X+1)
740 S=VAL(F$):IF S<1 THEN RETURN
750 P=0
760 IF (S=10) OR (S=100) THEN L=0 ELSE L=1
770 X=INSTR(F$,"b"):IF X<>0 THEN L=VAL(MID$(F$,X+1))
780 IF M=1 AND L+S>101 THEN PRINT"Scale can not exceed 100.":RETURN
800 FOR X=1 TO N
810 IF M=0 AND X MOD 6=1 AND X>1 THEN PRINT
820 R=INT(RND(1)*S)+L
825 IF M THEN D(R)=D(R)+1
830 P=P+R
840 IF M=0 THEN PRINT USING "###   ";R;
845 NEXT X
850 IF M=0 THEN 880
855 Y=0:FOR X=0 TO N
860 IF Y MOD 4=0 AND Y THEN PRINT:Y=Y+1
865 IF D(X) THEN PRINT USING "###(##)  ";X;D(X);:Y=Y+1
870 NEXT X
880 PRINT:PRINT USING "Sum: ####   Average: ##.#";P,P/N
890 RETURN
900 ' Unit test for date routines
910 DEFDBL A,O:DEFINT Y,M,W,D,X
920 DEFDBL B,P:DEFINT I,J,K,L
925 A=62744:F=101
930 CLS
940 PRINT@0,A
950 B=A:GOSUB 500:I=Y:J=M:K=W:L=D
955 PRINT@40,Y;M;W;D;"        "
960 GOSUB 210:IF A<>B THEN PRINT @280,B;" failed common - got";A:A=B:BEEP
970 GOSUB 600:I=Y:J=M:K=D
975 PRINT@80,Y;M;D;"        "
980 GOSUB 310:IF A<>B THEN PRINT @280,A;" failed elf - got";A:A=B:BEEP
990 A=A+F:GOTO 940