100 REM Base Conversion Program
101 REM By Walid Maalouli
102 REM August 2004
103 PRINT "CTL +: B=BIN D=DEC H=HEX T=2's Comp F=FLT R=RDX C=CLR":PAUSE
110 N=0:N$="":BASE$="DEC":DIM BN$(16)
111 FOR C=1 TO 6:READ HX$(C):NEXT C
112 FOR C=0 TO 15:READ BN$(C):NEXT C
120 DISPLAY ERASE ALL,BASE$;": ";N
130 CALL KEY(K,S)
140 IF S=0 THEN 130
150 IF K=2 AND BASE$="DEC"THEN GOSUB 1500:GOTO 130
151 IF K=2 AND BASE$="HEX"THEN GOSUB 2500:GOTO 130
152 IF K=4 AND BASE$="HEX"THEN GOSUB 1000:GOTO 130
153 IF K=4 AND BASE$="BIN"THEN GOSUB 2000:GOTO 130
154 IF K=4 AND BASE$="FLT"THEN GOSUB 4500:GOTO 130
155 IF K=8 AND BASE$="DEC"THEN GOSUB 500:GOTO 130
160 IF K=8 AND BASE$="BIN"THEN GOSUB 3000:GOTO 130
161 IF K=6 AND BASE$="RDX"THEN DPFLAG=0:GOSUB 3500:GOTO 130
162 IF K=6 AND BASE$="DEC"THEN DPFLAG=0:GOSUB 5000:GOTO 130
163 IF K=18 AND BASE$="FLT"THEN GOSUB 4000:GOTO 130
164 IF K=3 AND BASE$="FLT"THEN DISPLAY AT(1),BASE$;":  ";"0.0" ELSE 166
165 N=0:N$="":GOTO 130
166 IF K=3 THEN N$="":N=0:DISPLAY ERASE ALL,BASE$;": ";N:GOTO 130
167 IF K=20 AND (BASE$="HEX"OR BASE$="BIN")THEN GOSUB 5500:GOTO 130
170 IF BASE$="HEX"AND ((K<97 OR K>102)AND (K<48 OR K>57))THEN 130
175 IF BASE$="HEX"AND LEN(N$)=6 THEN 130
176 IF K=45 AND N$=""AND (BASE$="DEC"OR BASE$="FLT")THEN 210
180 IF BASE$="DEC"AND (K<48 OR K>57)THEN 130
190 IF BASE$="BIN"AND ((K<48 OR K>49)OR LEN(N$)=24)THEN 130
200 IF BASE$="FLT"AND (K<48 OR K>57)AND K<>46 THEN 130
201 IF BASE$="RDX"AND ((K<97 OR K>102)AND (K<48 OR K>57))THEN 130
202 IF BASE$="RDX"AND LEN(N$)>16 THEN 130
205 IF K=46 THEN IF DPFLAG=1 THEN 130 ELSE DPFLAG=1
210 N$=N$&CHR$(K)
211 IF N$="-"OR N$="."THEN 220
215 IF BASE$="DEC"THEN N=VAL(N$)
220 DISPLAY ERASE ALL,BASE$;":  ";N$
230 GOTO 130
490 DATA "A","B","C","D","E","F"
495 DATA "0000","0001","0010","0011","0100","0101","0110"
496 DATA "0111","1000","1001","1010","1011","1100","1101","1110","1111"
500 REM Dec to Hex Routine
501 FLAG=0
505 IF N$=""THEN BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
510 IF BASE$="HEX"THEN RETURN
520 IF BASE$="BIN"THEN GOSUB 2000
521 N1=N
525 IF ABS(N)>=16777216 THEN DISPLAY AT(1),"Overflow!":PAUSE ELSE 527
526 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
527 IF N<0 THEN NFLAG=1:N$=SEG$(N$,2,LEN(N$)-1)
530 RESTORE 900
540 IF N$=""THEN N=0 ELSE N=VAL(N$)
545 READ HB
546 N$=""
560 IF N>=HB THEN RETURN
570 FOR C=1 TO 6:READ HB
580 IF N<HB AND FLAG=0 THEN 620
581 IF N<HB THEN N$=N$&"0":GOTO 620
585 FLAG=1
590 I=INT(N/HB)
600 IF I<10 THEN N$=N$&STR$(I) ELSE N$=N$&HX$(I-9)
610 N=N-(I*HB)
620 NEXT C
625 N=N1
645 IF K=2 THEN GOSUB 2500:RETURN
646 IF K=8 AND NFLAG=1 THEN 647 ELSE 650
647 CFLAG=1:GOSUB 2500:GOSUB 3000
650 IF CFLAG=1 THEN 660 ELSE BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";N$
660 RETURN
900 DATA 16777216,1048576,65536,4096,256,16,1
1000 REM Hex to Dec Routine
1010 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
1020 IF (SEG$(N$,1,1)="f"OR SEG$(N$,1,1)="F")AND LEN(N$)=6 THEN 1030 ELSE 1040
1030 NFLAG=1:DNEG=1:CFLAG=1:GOSUB 2500:GOSUB 3000:CFLAG=0
1040 T=0
1050 IF DNEG=1 THEN N1$="-" ELSE N1$=""
1060 FOR C=1 TO LEN(N$)
1070 H$=SEG$(N$,C,1):IF ASC(H$)<58 THEN D=VAL(H$):GOTO 1100
1075 IF ASC(H$)>70 THEN H$=CHR$(ASC(H$)-32)
1080 FOR I=1 TO 6
1090 IF HX$(I)=H$THEN D=I+9:GOTO 1100 ELSE NEXT I
1100 T=T+D*16^(LEN(N$)-C):NEXT C
1110 IF DNEG=1 THEN N=-T ELSE N=T
1120 N$=N1$&STR$(T):DNEG=0
1130 IF CFLAG=1 THEN 1140 ELSE BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";N$
1140 RETURN
1500 REM Dec to Bin Routine
1505 IF N$=""THEN BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
1510 GOSUB 500:RETURN
2000 REM Bin to Dec Routine
2010 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
2020 CFLAG=1:GOSUB 3000:CFLAG=0:GOSUB 1000:RETURN
2500 REM Hex to Bin Routine
2501 IF N$=""THEN BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
2505 N1$=""
2510 FOR C=1 TO LEN(N$)
2520 HN$=SEG$(N$,C,1)
2530 IF ASC(HN$)<58 THEN HN=VAL(HN$):GOTO 2550
2540 IF ASC(HN$)<97 THEN HN=ASC(HN$)-55 ELSE HN=ASC(HN$)-87
2550 N1$=N1$&BN$(HN)
2560 NEXT C
2570 IF NFLAG=1 THEN NFLAG=0:GOTO 2585
2575 IF CFLAG=1 THEN N$=N1$:RETURN
2580 N$=N1$:BASE$="BIN":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
2585 N$=""
2590 FOR C=1 TO 24-LEN(N1$)
2600 N$=N$&"0":NEXT C
2610 N1$=N$&N1$:N$=""
2620 FOR C=1 TO LEN(N1$)
2720 B$=SEG$(N1$,C,1)
2730 IF B$="1"THEN B$="0" ELSE B$="1"
2740 N$=N$&B$
2750 NEXT C
2760 IF B$="0"THEN N$=SEG$(N$,1,23)&"1":N1$=N$:GOTO 2820
2765 N1$="":CARRY=1
2770 FOR C=24 TO 1 STEP -1
2780 B$=SEG$(N$,C,1)
2790 IF B$="1"AND CARRY=1 THEN B$="0":GOTO 2810
2800 IF B$="0"AND CARRY=1 THEN B$="1":CARRY=0
2810 N1$=B$&N1$:NEXT C
2820 IF CFLAG=1 THEN N$=N1$:RETURN ELSE 2580
3000 REM BIN to HEX Routine
3001 IF N$=""THEN BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
3005 N1$="":IF LEN(N$)<24 THEN N$=RPT$("0",24-LEN(N$))&N$
3010 FOR C=1 TO 24 STEP 4
3020 B$=SEG$(N$,C,4)
3030 FOR I=0 TO 15
3040 IF BN$(I)=B$THEN 3050 ELSE NEXT I
3050 IF I<10 THEN N1$=N1$&STR$(I) ELSE N1$=N1$&HX$(I-9)
3055 T$=N1$
3060 NEXT C
3061 FOR C=1 TO 6:B$=SEG$(T$,C,1)
3062 IF B$="0"THEN N1$=SEG$(T$,C+1,6-C) ELSE 3065
3063 NEXT C
3065 N$=N1$:IF CFLAG=1 THEN RETURN
3070 BASE$="HEX":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
3500 REM RDX to FLT Routine
3505 N1$="":NEGRDX=0:FRACT$=""
3510 IF SEG$(N$,1,1)=">"THEN 3520 ELSE 3530
3520 FOR C=1 TO 22 STEP 3:N1$=N1$&SEG$(N$,C+1,2):NEXT C:N$=N1$
3530 IF ASC(SEG$(N$,1,1))>57 THEN NFLAG=1:NEGRDX=1
3540 PREFIX$=SEG$(N$,1,4):N2$=N$:CFLAG=1
3550 IF NFLAG=1 THEN K=8:N$=PREFIX$:GOSUB 646:PREFIX$=SEG$(N$,3,4)
3560 N$=SEG$(PREFIX$,1,2):GOSUB 1000:MULT=VAL(N$)
3570 N$=SEG$(PREFIX$,3,2):GOSUB 1000:INTEG$=N$
3580 FOR X=5 TO 15 STEP 2:N$=SEG$(N2$,X,2):GOSUB 1000:FRACT$=FRACT$&N$:NEXT X
3590 N=VAL(INTEG$&"."&FRACT$)*(100^(MULT-64)):CFLAG=0
3595 N$=STR$(N):IF SEG$(N$,1,1)="."THEN N$="0"&N$
3600 IF NEGRDX=1 THEN N=-1*N:N$="-"&N$
3610 BASE$="FLT":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
4000 REM FLT to RDX Routine
4005 NEGFLT=0
4010 IF N$=""THEN BASE$="RDX":DISPLAY AT(1),BASE$;":  ";RPT$(">00",8):RETURN
4020 IF SEG$(N$,1,1)="."THEN N$="0"&SEG$(N$,1,LEN(N$)-1)
4025 N1=VAL(N$)
4030 IF SEG$(N$,1,1)="-"THEN NEGFLT=1:N$=SEG$(N$,2,LEN(N$)-1)
4040 IF LEN(N$)>15 THEN 4050 ELSE 4070
4050 DISPLAY AT(1),"Overflow!":PAUSE:DISPLAY ERASE ALL,BASE$;":  ";N$
4055 RETURN
4070 P=0:N1$="":ZFLAG=0:P1=POS(N$,".",1):IF P1=0 THEN 4075 ELSE 4079
4075 DISPLAY AT(1),"Not a float number!":PAUSE
4076 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
4079 IF LEN(N$)<15 THEN N$=N$&RPT$("0",15-LEN(N$))
4080 IF SEG$(N$,1,1)="0"THEN C=3:ZFLAG=1:P=P-1:GOTO 4090 ELSE 4100
4090 IF SEG$(N$,C,1)="0"THEN P=P-1:C=C+1:GOTO 4090 ELSE 4110
4100 IF SEG$(N$,2,1)<>"."AND P1<>3 THEN P=P1-2 ELSE P=0
4110 IF INT(P/2)<>P/2 THEN P=P-1
4120 D=P/2:R$=STR$(64+D)
4130 N2$=N$:N$=R$:CFLAG=1:GOSUB 500:N1$=N$:N$=N2$
4135 IF ZFLAG=1 THEN P2=P1-P ELSE P2=P1-P-1
4140 N$=SEG$(N$,1,P1-1)&SEG$(N$,P1+1,LEN(N$)-P1):N2$=N$
4145 IF P1<P2 THEN P2=P2-1
4160 IF P2=1 THEN R$=SEG$(N$,1,1) ELSE R$=SEG$(N$,P2-1,2)
4170 N$=R$:GOSUB 500:IF LEN(N$)=1 THEN N$="0"&N$
4175 N1$=N1$&N$
4180 IF NEGFLT=1 THEN NFLAG=1:N$=N1$:GOSUB 2500:GOSUB 3000:N1$=SEG$(N$,3,4)
4195 N1$=">"&N1$:N1$=SEG$(N1$,1,3)&">"&SEG$(N1$,4,2)
4200 FOR L=P2+1 TO 14 STEP 2
4205 IF L>=14 THEN 4225
4210 R$=SEG$(N2$,L,2):N$=R$:IF R$="00"THEN 4220 ELSE GOSUB 500
4220 N1$=N1$&">"&N$:N$=N2$
4225 NEXT L
4226 N=N1
4227 N$=N1$:IF LEN(N$)<24 THEN N$=N$&">00"
4230 CFLAG=0:BASE$="RDX":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
4500 REM FLT to DEC Routine
4510 IF N$=""THEN BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";"0":RETURN
4520 N=VAL(N$):N$=STR$(INT(N))
4530 BASE$="DEC":DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
5000 REM DEC to FLT Routine
5010 IF N$=""THEN BASE$="FLT":DISPLAY ERASE ALL,BASE$;":  ";"0.0":RETURN
5020 IF LEN(N$)>12 THEN 4050
5030 N$=N$&".0":N=VAL(N$):BASE$="FLT"
5040 DISPLAY ERASE ALL,BASE$;":  ";N$:RETURN
5500 REM Two's Complement Routine
5510 IF BASE$="BIN"THEN NFLAG=1:N1$=N$:GOSUB 2570:RETURN
5520 NFLAG=1:CFLAG=1:GOSUB 2500:CFLAG=0:GOSUB 3000:RETURN