home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
DATABASE
/
DATAMAGE.ZIP
/
CODE.ZIP
/
MAILLIB.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-11-18
|
21KB
|
910 lines
COMMON SHARED K%(), FTOT%(), HDG$(), MC%, BYTES%
DECLARE SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
DECLARE SUB DECODER (TT1$, IS$)
DECLARE SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
DECLARE SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
DECLARE SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
DECLARE SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
DECLARE FUNCTION GET.CHOICE (LIMIT%, PMPT$())
SUB CNTRSTRP (PTL%, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
TT1$ = RTRIM$(CR1$)
IF LEN(TT1$) = 0 THEN GOTO 4920
4915 CR$ = TT1$ + " "
IF WFG9% = 1 THEN CR$ = CR$ + " ": GOTO 4940
4920 TT2$ = RTRIM$(CR2$)
IF LEN(TT2$) = 0 THEN GOTO 4950
4940 CR$ = CR$ + TT2$
KKK% = LEN(CR$): ZZZ% = KKK% MOD 2
IF ZZZ% = 1 AND LEN(TT1$) > 0 THEN WFG9% = 1: GOTO 4915
CNTR% = ((80 - KKK%) / 2) + 1
4950 IF PTL% THEN LOCATE PTL%, CNTR%: PRINT CR$;
4965 END SUB
SUB DECODER (TT1$, IS$)
IS$ = ""
FOR M% = 1 TO LEN(TT1$)
B$ = MID$(TT1$, M%, 1): Y% = ASC(B$)
IF M% = 1 THEN GOTO 7640
C$ = MID$(TT1$, M% - 1, 1): IF C$ = B$ THEN GOTO 7650
7640 IF Y% > 96 AND Y% < 123 THEN Y% = Y% - 32: GOTO 7645
IF Y% > 64 AND Y% < 91 OR Y% > 47 AND Y% < 58 THEN GOTO 7645
GOTO 7650
7645 IS$ = IS$ + CHR$(Y%)
7650 NEXT M%
END SUB
FUNCTION GET.CHOICE (LIMIT%, PMPT$())
REDIM START%(10)
CR1$ = PMPT$(0): CR2$ = ""
FOR D% = 1 TO LIMIT%
START%(D%) = LEN(CR2$)
CR2$ = CR2$ + PMPT$(D%) + " "
NEXT
CALL WW(ATTR%, 23, 78, 21, 1, 0, 7)
CALL CNTRSTRP(23, CNTR%, CR1$, CR2$, TT1$, TT2$, CR$)
X% = CNTR% + INSTR(CR$, PMPT$(1)) - 1
FOR D% = 1 TO LIMIT%: START%(D%) = START%(D%) + X%: NEXT
X% = 1
LOCATE 23, START%(X%)
COLOR 0, 7: PRINT PMPT$(X%)
WHILE WFG% = 0
I$ = ""
WHILE I$ = "": I$ = INKEY$: WEND
IF LEN(I$) = 1 THEN
A% = VAL(I$)
IF A% AND A% <= LIMIT% THEN
GET.CHOICE = A%: WFG% = 1
GOTO END.LOOP
END IF
IF ASC(I$) = 13 THEN
GET.CHOICE = X%: WFG% = 1
GOTO END.LOOP
END IF
BEEP: GOTO END.LOOP
END IF
SELECT CASE ASC(MID$(I$, 2, 1))
CASE 75:
LOCATE 23, START%(X%)
COLOR MC%, 0: PRINT PMPT$(X%)
IF X% > 1 THEN X% = X% - 1 ELSE X% = LIMIT%
LOCATE 23, START%(X%)
COLOR 0, 7: PRINT PMPT$(X%)
CASE 77:
LOCATE 23, START%(X%)
COLOR MC%, 0: PRINT PMPT$(X%)
IF X% < LIMIT% THEN X% = X% + 1 ELSE X% = 1
LOCATE 23, START%(X%)
COLOR 0, 7: PRINT PMPT$(X%)
CASE ELSE: BEEP
END SELECT
END.LOOP:
WEND
COLOR MC%, 0
EXIT FUNCTION
END FUNCTION
100 SUB INPT (MAX%, MC%, SEEDSW%, CTRL$, X$)
IF MC% < 8 THEN MC1% = MC% + 8 ELSE MC1% = MC%
CL% = CSRLIN: CC% = POS(X)
110 CHIN% = 0: CCC% = CC%: INST% = 0
COLOR 12: A% = CC% + MAX%
LOCATE CL%, A%: PRINT CHR$(186);
LOCATE CL% - 1, A%: PRINT CHR$(187);
LOCATE CL% + 1, A%: PRINT CHR$(188);
A% = A% - 1
FOR B% = A% TO CC% STEP -1
LOCATE CL% - 1, B%: PRINT CHR$(205);
LOCATE CL% + 1, B%: PRINT CHR$(205);
NEXT
A% = CC% - 1
LOCATE CL%, A%: PRINT CHR$(186);
LOCATE CL% - 1, A%: PRINT CHR$(201);
LOCATE CL% + 1, A%: PRINT CHR$(200);
LOCATE CL%, CC%: COLOR MC1%
IF SEEDSW% = 1 THEN
A$ = RTRIM$(X$)
X$ = SPACE$(MAX%)
LSET X$ = A$
CHIN% = LEN(A$)
PRINT X$: SEEDSW% = 0
CCC% = CC% + CHIN%
LOCATE CL%, CCC%
B% = INSTR(X$, ".")
IF B% THEN POINTSW% = 1
ELSE X$ = SPACE$(MAX%)
END IF
WFG% = 0
WHILE WFG% = 0
IF INST% = 0 THEN GOSUB 420 ELSE GOSUB 430
A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
IF LEN(A$) = 2 THEN
B$ = RIGHT$(A$, 1): IA% = ASC(B$)
220 SELECT CASE IA%
CASE 71:
CCC% = CC%
CASE 82:
IF INST% = 0 THEN INST% = 1 ELSE INST% = 0
CASE 75:
IF CCC% > CC% THEN
CCC% = CCC% - 1
ELSE BEEP
END IF
CASE 77:
IF (CCC% - CC%) < CHIN% THEN
CCC% = CCC% + 1
ELSE BEEP
END IF
CASE 79:
CCC% = CC% + CHIN%
CASE 83:
IC% = POS(X): A$ = MID$(X$, CCC% - CC% + 1, 1)
IF CHIN% = 0 OR CCC% > MAX% + CC% OR CCC% - CC% > CHIN% - 1 THEN BEEP: GOTO 405
FOR D5% = (CCC% - CC% + 1) TO MAX% - 1
MID$(X$, D5%, 1) = MID$(X$, (D5% + 1), 1)
NEXT
MID$(X$, CHIN%, 1) = " "
CHIN% = CHIN% - 1
PRINT MID$(X$, CCC% - CC% + 1);
LOCATE CL%, IC%
IF A$ = "." THEN POINTSW% = 0
CASE ELSE:
BEEP
END SELECT
LOCATE CL%, CCC%
GOTO 405
END IF
IX% = ASC(A$)
SELECT CASE IX%
CASE 13: ' RETURN - EXIT
WFG% = 2
CASE 34: BEEP
CASE 27: ' ESCAPE - RESTART
BEEP: LOCATE CL%, CC%
PRINT STRING$(MAX%, " "); : LOCATE CL%, CC%
WFG% = 1
CASE 8: ' DELETE
IF CCC% > CC% THEN
CCC% = CCC% - 1
LOCATE CL%, CCC%
IA% = 83
GOTO 220
ELSE BEEP
END IF
CASE ELSE: GOTO 320
END SELECT
GOTO 405
320 IF CTRL$ = "S" THEN
IF IX% < 32 OR IX% > 125 THEN BEEP: GOTO 405
ELSE
SELECT CASE IX%
CASE 45:
IF CCC% <> CC% OR INST% = 1 AND MID$(X$, 1, 1) = "-" THEN BEEP: GOTO 405
CASE 46:
IF POINTSW% = 0 THEN
POINTSW% = 1
ELSE
IF MID$(X$, CCC% - CC% + 1, 1) <> "." THEN BEEP: GOTO 405
END IF
CASE ELSE:
IF IX% < 48 OR IX% > 57 THEN BEEP: GOTO 405
END SELECT
END IF
IF INST% = 0 THEN
Y% = CCC% - CC% + 1
IF Y% > MAX% THEN BEEP: GOTO 405
IF Y% > CHIN% THEN CHIN% = CHIN% + 1
IF MID$(X$, Y%, 1) = "." AND A$ <> "." THEN POINTSW% = 0
MID$(X$, Y%, 1) = A$: CCC% = CCC% + 1
PRINT A$;
ELSE
IF CHIN% = MAX% THEN BEEP: GOTO 405
IC% = (CCC% - CC% + 1): CHIN% = CHIN% + 1
IF IC% > CHIN% - 1 THEN INST% = 0
FOR Y% = MAX% TO IC% + 1 STEP -1
MID$(X$, Y%, 1) = MID$(X$, Y% - 1, 1)
NEXT
MID$(X$, IC%, 1) = CHR$(IX%)
LOCATE CL%, CC%: PRINT X$;
CCC% = CCC% + 1
END IF
LOCATE CL%, CCC%
405 WEND
IF WFG% = 1 THEN WFG% = 0: POINTSW% = 0: GOTO 110
WFG% = 0
COLOR MC%: POINTSW% = 0: GOSUB 440
A$ = RTRIM$(X$): X$ = A$
GOTO 455
420 CALL WW(0, 0, 0, 6, 7, 0, 1): RETURN
430 CALL WW(0, 0, 0, 0, 7, 0, 1): RETURN
440 CALL WW(0, 0, 0, 32, 0, 0, 1): RETURN
455 END SUB
SUB MINPUT (CPTY%, X%, MAX%, ISRSW%, MISW%, ATTR%, CTRL$, PASS$, X$)
IF MC% < 8 THEN MC1% = MC% + 8 ELSE MC1% = MC%
CL% = CSRLIN: CC% = POS(X)
RESTART:
CHIN% = 0: INST% = 0: CCC% = CC%: POINTSW% = 0: GOSUB 8550
IF PASS$ = SPACE$(LEN(PASS$)) OR PASS$ = STRING$(MAX%, CHR$(0)) THEN PASS$ = ""
IF LEN(PASS$) THEN
IF CTRL$ = "N" THEN
IF VAL(PASS$) = 0 THEN PASS$ = ""
B% = INSTR(PASS$, ".")
IF B% THEN POINTSW% = 1
END IF
IF LEN(PASS$) > MAX% THEN A$ = PASS$: PASS$ = MID$(A$, 1, MAX%)
LSET X$ = PASS$: CHIN% = LEN(PASS$): PASS$ = ""
ELSE X$ = SPACE$(MAX%)
END IF
IF ISRSW% = 0 THEN GOSUB 8580
IF MISW% = 1 THEN BC% = 12 ELSE BC% = 6
BSRSW% = 1: GOSUB 8320: COLOR MC1%
LOCATE CL%, CC% + CHIN%: CCC% = POS(X)
IF ISRSW% = 1 THEN ISRSW% = 0: GOTO 8350
WFG% = 0
WHILE WFG% = 0
8065 IF INST% = 0 THEN GOSUB 8550 ELSE GOSUB 8560
A$ = "": WHILE A$ = "": A$ = INKEY$: WEND
IF LEN(A$) = 2 THEN
B$ = RIGHT$(A$, 1): IA% = ASC(B$)
8155 SELECT CASE IA%
CASE 71:
CCC% = CC%
CASE 82:
IF INST% = 0 THEN INST% = 1 ELSE INST% = 0
CASE 75:
IF CCC% > CC% THEN
CCC% = CCC% - 1
ELSE BEEP: GOTO 8065
END IF
CASE 77:
IF (CCC% - CC%) < CHIN% THEN
CCC% = CCC% + 1
ELSE BEEP: GOTO 8065
END IF
CASE 79:
CCC% = CC% + CHIN%: INST% = 0
CASE 83:
IC% = POS(X): A$ = MID$(X$, CCC% - CC% + 1, 1)
IF CHIN% = 0 OR CCC% > MAX% + CC% OR CCC% - CC% > CHIN% - 1 THEN BEEP: GOTO 8270
FOR D5% = (CCC% - CC% + 1) TO MAX% - 1
MID$(X$, D5%, 1) = MID$(X$, (D5% + 1), 1)
NEXT
MID$(X$, CHIN%, 1) = " "
CHIN% = CHIN% - 1
PRINT MID$(X$, CCC% - CC% + 1);
LOCATE CL%, IC%
IF A$ = "." THEN POINTSW% = 0
CASE ELSE: BEEP
END SELECT
LOCATE CL%, CCC%
GOTO 8270
END IF
IX% = ASC(A$)
SELECT CASE IX%
CASE 13:
WFG% = 1
GOTO 8270
CASE 34:
BEEP: GOTO 8065
CASE 27:
BEEP: WFG% = 2
GOTO 8270
CASE 8:
IF CCC% > CC% THEN
IA% = 83
CCC% = CCC% - 1
LOCATE CL%, CCC%
GOTO 8155
END IF
CASE ELSE:
GOTO 8185
END SELECT
GOTO 8270
8185 IF CTRL$ = "S" THEN
IF IX% < 32 OR IX% > 125 THEN BEEP: GOTO 8270
ELSE
Z% = 0
8200 SELECT CASE IX%
CASE 45:
IF CCC% <> CC% OR INST% = 1 OR MID$(X$, 1, 1) = "-" THEN BEEP: GOTO 8270
CASE 46:
IF POINTSW% = 0 THEN
POINTSW% = 1
ELSE
IF MID$(X$, CCC% - CC% + 1, 1) <> "." THEN BEEP: GOTO 8270
END IF
CASE 65, 97: Z% = 1: T$ = "ADDED,"
CASE 83, 115: Z% = 2: T$ = "SUBTRACTED,"
CASE 77, 109: Z% = 3: T$ = "MULTIPLY,"
CASE 68, 100: Z% = 4: T$ = "DIVIDE,"
CASE ELSE:
IF IX% < 48 OR IX% > 57 THEN BEEP: GOTO 8270
END SELECT
END IF
IF Z% THEN GOSUB 8500: GOTO 8270
IF INST% = 0 THEN
Y% = CCC% - CC% + 1
IF Y% > MAX% THEN BEEP: GOTO 8270
IF Y% > CHIN% THEN CHIN% = CHIN% + 1
IF MID$(X$, Y%, 1) = "." AND A$ <> "." THEN POINTSW% = 0
MID$(X$, Y%, 1) = A$: CCC% = CCC% + 1
PRINT A$;
ELSE
IF CHIN% = MAX% THEN BEEP: GOTO 8270
IC% = (CCC% - CC% + 1): CHIN% = CHIN% + 1
IF IC% > CHIN% - 1 THEN INST% = 0
FOR Y% = MAX% TO IC% + 1 STEP -1
MID$(X$, Y%, 1) = MID$(X$, Y% - 1, 1)
NEXT
MID$(X$, IC%, 1) = CHR$(IX%)
LOCATE CL%, CC%: PRINT X$;
CCC% = CCC% + 1
END IF
LOCATE CL%, CCC%
8270 WEND
IF WFG% = 2 THEN GOTO RESTART
POINTSW% = 0: GOSUB 8565
IF MISW% = 0 THEN GOTO 8345
BC% = 6: A$ = X$: X$ = MID$(A$, 1, CHIN%)
IF CTRL$ = "N" THEN
Y% = INSTR(X$, ".")
IF Y% = 0 THEN GOTO 8320
DECS% = K%(X%, 3): RIN# = VAL(X$)
CALL ROUNDOFF(DECS%, RIN#, ROUT#, ROUT$)
X$ = SPACE$(MAX%): LSET X$ = ROUT$
END IF
8320 IA% = CC% + MAX%: COLOR BC%
IX% = SCREEN(CL% - 2, IA%): LOCATE CL% - 1, IA%
IF IX% = 186 THEN PRINT CHR$(185); : GOTO 8323
IX% = SCREEN(CL% - 1, IA% + 1)
IF IX% = 205 OR IX% = 188 THEN PRINT CHR$(203); ELSE PRINT CHR$(187);
8323 LOCATE CL%, IA%: PRINT CHR$(186);
IX% = SCREEN(CL% + 2, IA%): LOCATE CL% + 1, IA%
IF IX% = 186 THEN PRINT CHR$(185); : GOTO 8330
IX% = SCREEN(CL% + 1, IA% + 1)
IF IX% = 205 OR X% = 187 THEN PRINT CHR$(202); ELSE PRINT CHR$(188);
8330 IA% = IA% - 1
FOR B% = IA% TO CC% STEP -1
IX% = SCREEN(CL% - 2, B%): IY% = SCREEN(CL% + 2, B%)
LOCATE CL% - 1, B%: COLOR BC%
IF IX% = 186 THEN PRINT CHR$(202); ELSE PRINT CHR$(205);
IF BC% = 12 THEN COLOR MC1% ELSE COLOR MC%
LOCATE CL%, B%: PRINT MID$(X$, (B% - CC% + 1), 1);
LOCATE CL% + 1, B%: COLOR BC%
IF IY% = 186 THEN PRINT CHR$(203) ELSE PRINT CHR$(205);
NEXT
IA% = CC% - 1
IX% = SCREEN(CL% - 2, IA%): LOCATE CL% - 1, IA%
IF IX% = 186 THEN PRINT CHR$(204); ELSE PRINT CHR$(201);
LOCATE CL%, IA%: PRINT CHR$(186);
IX% = SCREEN(CL% + 2, IA%): LOCATE CL% + 1, IA%
IF IX% = 186 THEN PRINT CHR$(204); ELSE PRINT CHR$(200);
IF BSRSW% = 1 THEN BSRSW% = 0: RETURN
8345 POINTSW% = 0: MISW% = 0
IF K%(X%, 1) <> 0 OR LEN(X$) = 0 THEN GOTO 8350
DT$ = X$: CALL PARSE.DATE(K%(X%, 3), WFG%, DT$, T1$, T2$, TT1$, TT2$, DC#)
IF WFG% > 0 THEN
BEEP: PASS$ = X$: MISW% = 1
GOTO RESTART
END IF
8350 EXIT SUB
8500 IF Z% = 1 OR Z% = 2 THEN CR1$ = "ENTER VALUE TO BE " ELSE CR1$ = "ENTER VALUE BY WHICH TO "
CR1$ = CR1$ + T$: CR1$ = CR1$ + " OR 0 TO ABORT: "
T$ = MID$(X$, 1, CHIN%): OV# = VAL(T$)
8510 COLOR MC%: GOSUB 8567
LOCATE 23, 8: PRINT CR1$;
MAX% = 18: CTRL$ = "N": GOSUB 8575
A# = VAL(X$)
IF A# THEN
SELECT CASE Z%
CASE 1: B# = OV# + A#
CASE 2: B# = OV# - A#
CASE 3: B# = OV# * A#
CASE 4: B# = OV# / A#
END SELECT
ELSE B# = OV#
END IF
RIN# = B#: DECS% = K%(X%, 3)
CALL ROUNDOFF(DECS%, RIN#, ROUT#, ROUT$)
LOCATE CL%, CC%: COLOR MC1%: PRINT SPACE$(MAX%)
LOCATE CL%, CC%: PRINT ROUT$;
IF A# <> 0 AND Z% < 3 THEN OV# = B#: GOTO 8510
8530 GOSUB 8580: X$ = SPACE$(MAX%): LSET X$ = ROUT$
MAX% = 22: CHIN% = LEN(ROUT$): CCC% = CC% + CHIN%: LOCATE CL%, CCC%
Z% = INSTR(ROUT$, ".")
IF Z% THEN POINTSW% = 1 ELSE POINTSW% = 0
COLOR MC1%: RETURN
8550 CALL WW(ATTR%, 0, 0, 6, 7, 0, 1): RETURN
8560 CALL WW(ATTR%, 0, 0, 0, 7, 0, 1): RETURN
8565 CALL WW(ATTR%, 0, 0, 32, 0, 0, 1): RETURN
8567 CALL WW(ATTR%, 23, 78, 21, 1, 0, 7): RETURN
8575 CALL INPT(MAX%, MC%, SEEDSW%, CTRL$, X$): COLOR MC%: RETURN
8580 A$ = STR$(X%) + ". " + HDG$(X%)
T$ = A$ + SPACE$(42 - LEN(A$))
IF K%(X%, 1) = 0 THEN
T$ = T$ + "DATE FIELD: "
IF K%(X%, 3) = 1 THEN T$ = T$ + "MM/DD/YY" ELSE T$ = T$ + "DD/MM/YY"
GOTO 8590
END IF
IF K%(X%, 1) = 1 THEN
T$ = T$ + "STRING: "
IF K%(X%, 3) = 1 THEN T$ = T$ + "INDEXED UNIQUE"
IF K%(X%, 3) = 2 THEN T$ = T$ + "INDEXED"
IF K%(X%, 3) = 3 THEN T$ = T$ + "CROSS-INDEXED"
GOTO 8590
END IF
T$ = T$ + "NUMERIC:"
IF K%(X%, 1) > 2 THEN T$ = T$ + " DOLLAR FMT": GOTO 8590
IF K%(X%, 3) = 9 THEN T$ = T$ + " FLOATING POINT": GOTO 8590
T$ = T$ + STR$(K%(X%, 3)) + " DECIMALS"
8590 T$ = T$ + SPACE$(67 - LEN(T$)): T$ = T$ + " BYTES:"
T$ = T$ + STR$(K%(X%, 2))
GOSUB 8567: COLOR MC%: LOCATE 22, 2: PRINT T$
COLOR 6: LOCATE , 7: PRINT "MOVEMENT KEYS: "; CHR$(27); " "; CHR$(26); " Home End. PRESS RETURN TO RECORD ENTRY"
LOCATE , 7: PRINT "FUNCTION KEYS: Esc (BLANK) Inst Del BckSp ";
IF K%(X%, 1) > 1 THEN PRINT "Add Subt Mult Div";
RETURN
END SUB
SUB PARSE.DATE (REV%, WFG%, DC$, T1$, T2$, TT1$, TT2$, DC#)
5850 WFG% = 0: IF LEN(DC$) < 8 THEN WFG% = 1: GOTO 5870
FOR M% = 1 TO 8
IF M% = 3 OR M% = 6 THEN GOTO 5855
X% = ASC(MID$(DC$, M%, 1))
IF X% < 48 OR X% > 57 THEN WFG% = 1
5855 NEXT: IF WFG% = 1 THEN GOTO 5870
T1$ = MID$(DC$, 1, 2): T2$ = MID$(DC$, 4, 2): TT1$ = MID$(DC$, 7, LEN(DC$))
IF REV% = 1 THEN M% = VAL(T1$) ELSE M% = VAL(T2$)
IF M% < 1 OR M% > 12 THEN WFG% = 1: GOTO 5870
IF REV% = 2 THEN M% = VAL(T1$) ELSE M% = VAL(T2$)
IF M% < 1 OR M% > 31 THEN WFG% = 1: GOTO 5870
M% = VAL(TT1$): IF M% < 100 THEN TT2$ = "19" + TT1$: TT1$ = TT2$
TT2$ = TT1$: IF REV% = 1 THEN TT2$ = TT2$ + T1$ + T2$ ELSE TT2$ = TT2$ + T2$ + T1$
DC# = VAL(TT2$)
5870 END SUB
SUB ROUNDOFF (DECS%, RIN#, ROUT#, ROUT$)
IF RIN# < 0 THEN RT$ = STR$(RIN#) ELSE RT$ = MID$(STR$(RIN#), 2)
OS$ = RT$: RX% = INSTR(RT$, ".")
IF RX% = 0 THEN ROUT# = RIN#: ROUT$ = RT$: EXIT SUB
RZ% = INSTR(RT$, "D")
IF RZ% = 0 THEN GOTO 2204
RTT$ = MID$(RT$, RZ% + 2, 2): RN% = VAL(RTT$)
RTT$ = MID$(RT$, RZ% + 1, 1)
IF RTT$ = "+" THEN GOTO 2200
RTT$ = "." + STRING$(RN% - 1, "0") + MID$(RT$, 1, RX% - 1) + MID$(RT$, RX% + 1, RZ% - 1)
RT$ = RTT$: RX% = 1: GOTO 2204
2200 RTT$ = MID$(RT$, 1, RZ% - 1): RT$ = RTT$
RZ% = LEN(RTT$) - RX%
IF RZ% < RN% THEN RT$ = RT$ + STRING$(RN% + 1 - RZ%, "0")
FOR RD% = RX% TO RX% + RN%
MID$(RT$, RD%, 1) = MID$(RT$, RD% + 1, 1)
NEXT
MID$(RT$, RD% - 1, 1) = ".": RX% = RD%
2204 IF MID$(RT$, 1, 1) = "." OR MID$(RT$, 1, 1) = "9" THEN RTT$ = "0" + RT$: RT$ = RTT$: RX% = RX% + 1
RTT$ = MID$(RT$, RX% + 1)
IF LEN(RTT$) <= DECS% THEN T$ = OS$: GOTO 2225
2210 WFG% = 0: RWFG% = 0: RD% = LEN(RT$) + 1: RZ% = RX% + DECS%
WHILE WFG% = 0 AND RD% > 1
RD% = RD% - 1: RTT$ = MID$(RT$, RD%, 1)
IF RTT$ = "." THEN GOTO 2220
RY% = VAL(RTT$)
IF RWFG% = 1 THEN RWFG% = 0: RY% = RY% + 1
IF RY% > 4 THEN RWFG% = 1
IF RY% = 10 THEN RY% = 0: XWFG% = 1 ELSE XWFG% = 0
MID$(RT$, RD%, 1) = MID$(STR$(RY%), 2)
IF RD% <= RZ% AND XWFG% = 0 THEN WFG% = 1
2220 WEND
IF MID$(RT$, 1, 1) = "0" THEN
RTT$ = MID$(RT$, 2): RT$ = RTT$
RZ% = RZ% - 1
END IF
T$ = MID$(RT$, 1, RZ%)
2225 D% = LEN(T$) + 1: WFG% = 0
WHILE WFG% = 0 AND D% > 1
D% = D% - 1: RTT$ = MID$(T$, D%, 1)
IF RTT$ <> "0" THEN WFG% = D%
IF RTT$ = "." THEN WFG% = D% - 1
WEND
IF WFG% = 0 THEN WFG% = 1
ROUT$ = MID$(T$, 1, WFG%)
ROUT# = VAL(ROUT$)
END SUB