'factorial_Kaze.bas

HowMany = 10000
REDIM Factorial$(1 TO HowMany)
Factorial$(1) = "1"
Factorial$(2) = "2"
Factorial$(3) = "6"
FactorialMy$ = Factorial$(3)
beginT! = TIMER
FOR fi = 4 TO HowMany
    FactorialMy$ = MUL$(FactorialMy$, LTRIM$(STR$(fi)))
NEXT
PRINT FactorialMy$
PRINT "The length is"; LEN(FactorialMy$); "digits."
PRINT "Done in"; TIMER - beginT!; "seconds."
END

' RTHMTC.TMR - simulating the four arithmetic operations via strings, written back in 90's by Kaze, (sanmayce@sanmayce.com)

'DECLARE SUB DelNull (Result&(), Tiller$, DimLength%)
'DECLARE SUB DelLeftNull (Result&(), Tiller$, StrLength%, DimLength%, PointPos%)
'DECLARE SUB DelRightNull (Result&(), Tiller$, StrLength%, PointPos%)
'DECLARE SUB Convert (Array&(), Number$, Length%, Flag%, PointPos%)
'DECLARE FUNCTION FindIntegerPart$ (Dividend$, Divisor$)
'DECLARE FUNCTION DIV$ (Dividend$, Divisor$, Exactness%)
'DECLARE FUNCTION ADD$ (FirstAddend$, SecondAddend$)
'DECLARE FUNCTION SUBqb$ (Minuend$, Subtrahend$)
'DECLARE FUNCTION MUL$ (Multiplicand$, Multiplier$)
'DECLARE FUNCTION Compare% (Firum$, Secum$)
'DECLARE FUNCTION ResultFilter$ (Result&(), Code$, DimLength%, PointPos%, Sign%)

' Examples [
'PRINT ADD$("123.89", "3")
'PRINT SUBqb$("-3", "3")
'PRINT MUL$("-0.4", "222222222222222222222222222222222222")
'PRINT DIV$("22.7", "-3", 10)
' Examples ]

DEFLNG A-Z
FUNCTION ADD$ (FirstAddend$, SecondAddend$)
    FiradLength = LEN(FirstAddend$)
    SecadLength = LEN(SecondAddend$)
    FirstSign$ = MID$(FirstAddend$, 1, 1)
    SecondSign$ = MID$(SecondAddend$, 1, 1)
    IF FirstSign$ <> "-" AND SecondSign$ = "-" THEN
        Mediator$ = RIGHT$(SecondAddend$, SecadLength - 1)
        ADD$ = SUBqb$(FirstAddend$, Mediator$)
        EXIT FUNCTION
    END IF
    IF FirstSign$ = "-" AND SecondSign$ <> "-" THEN
        Mediator$ = RIGHT$(FirstAddend$, FiradLength - 1)
        ADD$ = SUBqb$(SecondAddend$, Mediator$)
        EXIT FUNCTION
    END IF
    IF FirstSign$ = "-" AND SecondSign$ = "-" THEN
        Sign = 1
        FiradLength = FiradLength - 1
        SecadLength = SecadLength - 1
        FirstAddend$ = RIGHT$(FirstAddend$, FiradLength)
        SecondAddend$ = RIGHT$(SecondAddend$, SecadLength)
    END IF
    REDIM Firad&(1 TO FiradLength)
    REDIM Secad&(1 TO SecadLength)
    CALL Convert(Firad&(), FirstAddend$, FiradLength, FiradFlag, FiradPointPos)
    FiradTrueLength = FiradLength - FiradPointPos
    CALL Convert(Secad&(), SecondAddend$, SecadLength, SecadFlag, SecadPointPos)
    SecadTrueLength = SecadLength - SecadPointPos
    IF SecadTrueLength > FiradTrueLength THEN
        BigLength = SecadTrueLength
    ELSE
        BigLength = FiradTrueLength
    END IF
    IF FiradPointPos > SecadPointPos THEN
        BigPointPos = FiradPointPos
        TrueBigPointPos = BigPointPos - FiradFlag
        SubSecad = SecadPointPos - SecadFlag - TrueBigPointPos
    ELSE
        BigPointPos = SecadPointPos
        TrueBigPointPos = BigPointPos - SecadFlag
        SubFirad = FiradPointPos - FiradFlag - TrueBigPointPos
    END IF
    DimSum = BigLength + TrueBigPointPos + 1
    REDIM Result&(1 TO DimSum)
    FOR SF = 1 TO BigLength + BigPointPos
        FiradDim = 0
        SecadDim = 0
        SubFirad = SubFirad + 1
        SubSecad = SubSecad + 1
        IF SubFirad > 0 AND SubFirad <= FiradLength THEN FiradDim = Firad&(SubFirad)
        IF SubSecad > 0 AND SubSecad <= SecadLength THEN SecadDim = Secad&(SubSecad)
        Result&(SF) = FiradDim + SecadDim + Result&(SF)
        IF Result&(SF) >= 10 THEN
            Result&(SF + 1) = 1
            Result&(SF) = Result(SF) - 10
        END IF
    NEXT SF
    ADD$ = ResultFilter$(Result&(), "ADD", DimSum, BigPointPos, Sign)
END FUNCTION

FUNCTION Compare& (Firum$, Secum$)
    FirLeftPart = INSTR(Firum$, ".")
    SecLeftPart = INSTR(Secum$, ".")
    IF FirLeftPart = 0 THEN
        FirLeftPart = LEN(Firum$)
    ELSE
        FirLeftPart = FirLeftPart - 1
        FirRightPart = LEN(Firum$) - FirLeftPart
    END IF
    IF SecLeftPart = 0 THEN
        SecLeftPart = LEN(Secum$)
    ELSE
        SecLeftPart = SecLeftPart - 1
        SecRightPart = LEN(Secum$) - SecLeftPart
    END IF
    IF SecRightPart > FirRightPart THEN
        MainRightPart = FirRightPart
    ELSE
        MainRightPart = SecRightPart
    END IF
    IF SecLeftPart > FirLeftPart THEN
        CompareCode = -1
        MainLeftPart = SecLeftPart
    ELSE
        CompareCode = 1
        MainLeftPart = FirLeftPart
    END IF
    IF SecLeftPart = FirLeftPart THEN
        CompareCode = 0
        DO
            Counter = Counter + 1
            FirumPart = VAL(MID$(Firum$, Counter, 1))
            SecumPart = VAL(MID$(Secum$, Counter, 1))
            IF FirumPart > SecumPart THEN CompareCode = 1
            IF FirumPart < SecumPart THEN CompareCode = -1
        LOOP WHILE Counter < MainLeftPart AND FirumPart = SecumPart
        IF CompareCode = 0 THEN
            MainLength = MainLeftPart + MainRightPart
            IF MainRightPart > 0 THEN
                Counter = Counter + 1
                DO
                    Counter = Counter + 1
                    FirumPart = VAL(MID$(Firum$, Counter, 1))
                    SecumPart = VAL(MID$(Secum$, Counter, 1))
                    IF FirumPart > SecumPart THEN CycleFlag = 1: CompareCode = 1
                    IF FirumPart < SecumPart THEN CycleFlag = 1: CompareCode = -1
                LOOP WHILE Counter < MainLength AND FirumPart = SecumPart
            END IF
            IF Counter = MainLength AND CycleFlag = 0 THEN
                IF FirRightPart < SecRightPart THEN CompareCode = -1
                IF FirRightPart > SecRightPart THEN CompareCode = 1
            END IF
        END IF
    END IF
    Compare& = CompareCode
END FUNCTION

SUB Convert (Array&(), Number$, Length, Flag, PointPos)
    FOR Counter = 1 TO Length
        Shoot$ = MID$(Number$, Length - Counter + 1, 1)
        IF Shoot$ = "." THEN
            Flag = 1
            PointPos = Counter
            Counter = Counter + 1
            Shoot$ = MID$(Number$, Length - Counter + 1, 1)
        END IF
        Array&(Counter - Flag) = VAL(Shoot$)
    NEXT Counter
END SUB

SUB DelLeftNull (Result&(), Tiller$, StrLength, DimLength, PointPos)
    Counter = DimLength
    DeviPart = DimLength + 1 - StrLength
    DO WHILE PointPos + 1 <= Counter - DeviPart AND Result&(Counter) = 0
        StrLength = StrLength - 1
        Tiller$ = RIGHT$(Tiller$, StrLength)
        Counter = Counter - 1
    LOOP
END SUB

SUB DelNull (Result&(), Tiller$, DimLength)
    Counter = DimLength
    DO WHILE Result&(Counter) = 0 AND Counter >= 2
        Tiller$ = RIGHT$(Tiller$, Counter - 1)
        Counter = Counter - 1
    LOOP
END SUB

SUB DelRightNull (Result&(), Tiller$, StrLength, PointPos)
    Counter = 1
    NewPointPos = PointPos
    DO WHILE PointPos - 2 >= Counter AND Result&(Counter) = 0
        StrLength = StrLength - 1
        Tiller$ = LEFT$(Tiller$, StrLength)
        Counter = Counter + 1
        NewPointPos = NewPointPos - 1
    LOOP
    PointPos = NewPointPos
END SUB

FUNCTION DIV$ (Dividend$, Divisor$, Exactness)
    DendSign$ = MID$(Dividend$, 1, 1)
    SorSign$ = MID$(Divisor$, 1, 1)
    IF DendSign$ = "-" AND SorSign$ <> "-" THEN
        Sign = 1
        Dividend$ = RIGHT$(Dividend$, LEN(Dividend$) - 1)
    END IF
    IF DendSign$ <> "-" AND SorSign$ = "-" THEN
        Sign = 1
        Divisor$ = RIGHT$(Divisor$, LEN(Divisor$) - 1)
    END IF
    IF DendSign$ = "-" AND SorSign$ = "-" THEN
        Divisor$ = RIGHT$(Divisor$, LEN(Divisor$) - 1)
        Dividend$ = RIGHT$(Dividend$, LEN(Dividend$) - 1)
    END IF
    DendPointPos = INSTR(Dividend$, ".")
    SorPointPos = INSTR(Divisor$, ".")
    IF DendPointPos <> 0 THEN
        DendRightPart = LEN(Dividend$) - DendPointPos
        DendRightPart$ = RIGHT$(Dividend$, DendRightPart)
        Dividend$ = LEFT$(Dividend$, DendPointPos - 1) + DendRightPart$
    END IF
    IF SorPointPos <> 0 THEN
        SorRightPart = LEN(Divisor$) - SorPointPos
        SorRightPart$ = RIGHT$(Divisor$, SorRightPart)
        Divisor$ = LEFT$(Divisor$, SorPointPos - 1) + SorRightPart$
    END IF
    DO WHILE MID$(Dividend$, 1, 1) = "0" AND LEN(Dividend$) <> 1
        Dividend$ = RIGHT$(Dividend$, LEN(Dividend$) - 1)
    LOOP
    DO WHILE MID$(Divisor$, 1, 1) = "0" AND LEN(Divisor$) <> 1
        Divisor$ = RIGHT$(Divisor$, LEN(Divisor$) - 1)
    LOOP
    IF Divisor$ = "0" THEN ERROR 11
    DendLength = LEN(Dividend$)
    SorLength = LEN(Divisor$)
    IF DendLength <= SorLength THEN
        Tiller$ = Dividend$
        Mediator$ = FindIntegerPart$(Dividend$, Divisor$)
        IntegerPart$ = Mediator$
    ELSE
        Pointer = SorLength
        Tiller$ = MID$(Dividend$, 1, Pointer)
        IF FindIntegerPart$(Tiller$, Divisor$) = "0" THEN
            Pointer = SorLength + 1
            Tiller$ = MID$(Dividend$, 1, Pointer)
        END IF
        DO WHILE Pointer < DendLength
            Mediator$ = FindIntegerPart$(Tiller$, Divisor$)
            IntegerPart$ = IntegerPart$ + Mediator$
            Pointer = Pointer + 1
            Shoot$ = MUL$(Mediator$, Divisor$)
            Deviation$ = SUBqb$(Tiller$, Shoot$)
            IF Deviation$ = "0" THEN
                Tiller$ = MID$(Dividend$, Pointer, 1)
            ELSE
                Tiller$ = Deviation$ + MID$(Dividend$, Pointer, 1)
            END IF
        LOOP
        Mediator$ = FindIntegerPart$(Tiller$, Divisor$)
        IntegerPart$ = IntegerPart$ + Mediator$
    END IF
    Result$ = IntegerPart$
    RelativePosition = DendRightPart - SorRightPart
    MiddlePosition = LEN(IntegerPart$) - RelativePosition
    CycleLength = Exactness - RelativePosition
    IF CycleLength > 0 THEN
        FOR I = 1 TO CycleLength
            Shoot$ = MUL$(Mediator$, Divisor$)
            Deviation$ = SUBqb$(Tiller$, Shoot$)
            IF Deviation$ = "0" THEN Tiller$ = "0" ELSE Tiller$ = Deviation$ + "0"
            Mediator$ = FindIntegerPart$(Tiller$, Divisor$)
            FractionalPart$ = FractionalPart$ + Mediator$
        NEXT I
        Result$ = Result$ + FractionalPart$
    END IF
    IF MiddlePosition > 0 THEN
        LeftPart$ = LEFT$(Result$, MiddlePosition)
        IF Exactness = 0 THEN
            Result$ = LeftPart$
        ELSE
            RightPart$ = RIGHT$(Result$, LEN(Result$) - MiddlePosition)
            Result$ = LeftPart$ + "." + RightPart$
        END IF
        IF DendLength <= SorLength THEN
            'Below lines for what captain.
            'NullNumber = SorLength - DendLength + 1 'Bug appears here
            '                                        'because +1 or +0 must.
            'IF MiddlePosition > NullNumber THEN
            'DelLength = NullNumber
            'ELSEIF MiddlePosition = NullNumber THEN
            'DelLength = NullNumber - 1
            'ELSEIF MiddlePosition > 1 THEN
            'DelLength = MiddlePosition - 1
            'END IF
            'Result$ = RIGHT$(Result$, LEN(Result$) - DelLength)
            DO WHILE LEN(Result$) >= 2
                IF LEFT$(Result$, 1) = "0" AND MID$(Result$, 2, 1) <> "." THEN
                    Result$ = RIGHT$(Result$, LEN(Result$) - 1)
                ELSE
                    EXIT DO
                END IF
            LOOP
        END IF
    ELSE
        IF MiddlePosition = 0 THEN
            Result$ = "0." + Result$
        ELSE
            Result$ = "0." + STRING$(ABS(MiddlePosition), "0") + Result$
        END IF
        IF Exactness = 0 THEN
            Result$ = "0"
        ELSEIF CycleLength < 0 THEN
            Result$ = LEFT$(Result$, 2 + Exactness)
        END IF
    END IF
    IF Sign = 1 THEN DIV$ = "-" + Result$ ELSE DIV$ = Result$
END FUNCTION

FUNCTION FindIntegerPart$ (Dividend$, Divisor$)
    DO
        Counter = Counter + 1
        Digit$ = LTRIM$(STR$(Counter))
        Tiller$ = MUL$(Digit$, Divisor$)
        CompareCode = Compare&(Tiller$, Dividend$)
    LOOP WHILE Counter <= 9 AND CompareCode = -1
    FindIntegerPart$ = LTRIM$(STR$(Counter - CompareCode))
END FUNCTION

FUNCTION MUL$ (Multiplicand$, Multiplier$)
    CandSign$ = MID$(Multiplicand$, 1, 1)
    ErSign$ = MID$(Multiplier$, 1, 1)
    CandLength = LEN(Multiplicand$)
    ErLength = LEN(Multiplier$)
    IF CandSign$ = "-" AND ErSign$ <> "-" THEN
        Sign = 1
        CandLength = CandLength - 1
        Multiplicand$ = RIGHT$(Multiplicand$, CandLength)
    END IF
    IF CandSign$ <> "-" AND ErSign$ = "-" THEN
        Sign = 1
        ErLength = ErLength - 1
        Multiplier$ = RIGHT$(Multiplier$, ErLength)
    END IF
    IF CandSign$ = "-" AND ErSign$ = "-" THEN
        ErLength = ErLength - 1
        CandLength = CandLength - 1
        Multiplier$ = RIGHT$(Multiplier$, ErLength)
        Multiplicand$ = RIGHT$(Multiplicand$, CandLength)
    END IF
    REDIM Cand&(1 TO CandLength)
    REDIM Er&(1 TO ErLength)
    CALL Convert(Cand&(), Multiplicand$, CandLength, CandFlag, CandPointPos)
    CALL Convert(Er&(), Multiplier$, ErLength, ErFlag, ErPointPos)
    DimSum = CandLength + ErLength - CandFlag - ErFlag
    PointPos = CandPointPos + ErPointPos - CandFlag - ErFlag
    REDIM Result&(1 TO DimSum)
    FOR SF = 1 TO CandLength - CandFlag
        FOR QB = 1 TO ErLength - ErFlag
            CarryFlag = 0
            Cycle = QB - 1 + SF
            Tiller = Cand&(SF) * Er&(QB)
            Result&(Cycle) = Tiller MOD 10 + Result&(Cycle)
            IF Result&(Cycle) >= 10 THEN
                Result&(Cycle) = Result&(Cycle) - 10
                CarryFlag = 1
            END IF
            NextNumPos = Cycle + 1
            Result&(NextNumPos) = Result&(NextNumPos) + CarryFlag + Tiller \ 10
            DO WHILE Result&(NextNumPos) >= 10
                Result&(NextNumPos) = Result&(NextNumPos) - 10
                NextNumPos = NextNumPos + 1
                Result&(NextNumPos) = Result&(NextNumPos) + 1
            LOOP
        NEXT QB
    NEXT SF
    MUL$ = ResultFilter$(Result&(), "MUL", DimSum, PointPos, Sign)
END FUNCTION

FUNCTION ResultFilter$ (Result&(), Code$, DimLength, PointPos, Sign)
    SELECT CASE Code$
        CASE "ADD"
            FOR I = 1 TO DimLength - 1
                IF I = PointPos THEN Tiller$ = "." + Tiller$
                Tiller$ = LTRIM$(STR$(Result&(I))) + Tiller$
            NEXT I
            IF Result&(DimLength) <> 0 THEN
                Tiller$ = LTRIM$(STR$(Result&(DimLength))) + Tiller$
            END IF
            IF PointPos <> 0 THEN
                StrLength = LEN(Tiller$)
                CALL DelRightNull(Result&(), Tiller$, StrLength, PointPos)
            END IF
            IF Sign = 1 THEN Tiller$ = "-" + Tiller$
        CASE "SUB"
            FOR I = 1 TO DimLength
                IF I = PointPos THEN Tiller$ = "." + Tiller$
                Tiller$ = LTRIM$(STR$(Result&(I))) + Tiller$
            NEXT I
            IF PointPos <> 0 THEN
                StrLength = LEN(Tiller$)
                CALL DelRightNull(Result&(), Tiller$, StrLength, PointPos)
                CALL DelLeftNull(Result&(), Tiller$, StrLength, DimLength, PointPos)
            ELSE
                CALL DelNull(Result&(), Tiller$, DimLength)
            END IF
            IF Sign = -1 THEN Tiller$ = "-" + Tiller$
        CASE "MUL"
            FOR I = 1 TO DimLength
                Tiller$ = LTRIM$(STR$(Result&(I))) + Tiller$
                IF I = PointPos THEN Tiller$ = "." + Tiller$
            NEXT I
            IF Result&(DimLength) = 0 THEN
                IF PointPos = 0 THEN
                    Tiller$ = RIGHT$(Tiller$, DimLength - 1)
                    IF MID$(Tiller$, 1, 1) = "0" THEN Tiller$ = "0"
                ELSE
                    PointPos = PointPos + 1
                    Tiller$ = RIGHT$(Tiller$, DimLength)
                    StrLength = LEN(Tiller$)
                    TrueDimLength = StrLength - 1
                    CALL DelRightNull(Result&(), Tiller$, StrLength, PointPos)
                    CALL DelLeftNull(Result&(), Tiller$, StrLength, TrueDimLength, PointPos)
                END IF
            END IF
            IF Sign = 1 THEN Tiller$ = "-" + Tiller$
    END SELECT
    IF RIGHT$(Tiller$, 2) = ".0" THEN Tiller$ = LEFT$(Tiller$, LEN(Tiller$) - 2)
    IF Tiller$ = "-0" THEN Tiller$ = "0"
    ResultFilter$ = Tiller$
END FUNCTION

FUNCTION SUBqb$ (Minuend$, Subtrahend$)
    MinuSign$ = MID$(Minuend$, 1, 1)
    SubtraSign$ = MID$(Subtrahend$, 1, 1)
    MinuLength = LEN(Minuend$)
    SubtraLength = LEN(Subtrahend$)
    IF MinuSign$ = "-" AND SubtraSign$ <> "-" THEN
        Mediator$ = RIGHT$(Minuend$, MinuLength - 1)
        SUBqb$ = "-" + ADD$(Mediator$, Subtrahend$)
        EXIT FUNCTION
    END IF
    IF MinuSign$ <> "-" AND SubtraSign$ = "-" THEN
        Mediator$ = RIGHT$(Subtrahend$, SubtraLength - 1)
        SUBqb$ = ADD$(Minuend$, Mediator$)
        EXIT FUNCTION
    END IF
    IF MinuSign$ = "-" AND SubtraSign$ = "-" THEN
        SWAP Minuend$, Subtrahend$
        MinuLength = MinuLength - 1
        SubtraLength = SubtraLength - 1
        Minuend$ = RIGHT$(Minuend$, MinuLength)
        Subtrahend$ = RIGHT$(Subtrahend$, SubtraLength)
    END IF
    REDIM Minu&(1 TO MinuLength)
    REDIM Subtra&(1 TO SubtraLength)
    CALL Convert(Minu&(), Minuend$, MinuLength, MinuFlag, MinuPointPos)
    MinuTrueLength = MinuLength - MinuPointPos
    CALL Convert(Subtra&(), Subtrahend$, SubtraLength, SubtraFlag, SubtraPointPos)
    SubtraTrueLength = SubtraLength - SubtraPointPos
    IF SubtraTrueLength > MinuTrueLength THEN
        MainTrueLength = SubtraTrueLength
    ELSE
        MainTrueLength = MinuTrueLength
    END IF
    CompareCode = Compare&(Minuend$, Subtrahend$)
    IF CompareCode = -1 THEN Sign = -1 ELSE Sign = 1
    IF MinuPointPos < SubtraPointPos THEN
        BigPointPos = SubtraPointPos
        TrueBigPointPos = BigPointPos - SubtraFlag
        MinuSub = MinuPointPos - MinuFlag - TrueBigPointPos
    ELSE
        BigPointPos = MinuPointPos
        TrueBigPointPos = BigPointPos - MinuFlag
        SubtraSub = SubtraPointPos - SubtraFlag - TrueBigPointPos
    END IF
    DimSum = MainTrueLength + TrueBigPointPos
    REDIM Result&(1 TO DimSum)
    FOR SF = 1 TO DimSum
        MinuDim = 0
        SubtraDim = 0
        MinuSub = MinuSub + 1
        SubtraSub = SubtraSub + 1
        IF MinuSub > 0 AND MinuSub <= MinuLength - MinuFlag THEN
            MinuDim = Minu&(MinuSub)
        END IF
        IF SubtraSub > 0 AND SubtraSub <= SubtraLength - SubtraFlag THEN
            SubtraDim = Subtra&(SubtraSub)
        END IF
        IF Sign = 1 THEN
            MinuDim = MinuDim + SubFlag
        ELSE
            SubtraDim = SubtraDim + SubFlag
        END IF
        SubSum = Sign * (MinuDim - SubtraDim)
        SubFlag = 0
        IF Sign = 1 THEN
            IF MinuDim >= SubtraDim THEN
                Result&(SF) = SubSum
            ELSE
                IF SubSum < 0 THEN SubFlag = -1
                Result&(SF) = SubSum + 10
            END IF
        ELSE
            IF MinuDim > SubtraDim THEN
                IF SubSum < 0 THEN SubFlag = -1
                Result&(SF) = SubSum + 10
            ELSE
                Result&(SF) = SubSum
            END IF
        END IF
    NEXT SF
    SUBqb$ = ResultFilter$(Result&(), "SUB", DimSum, BigPointPos, Sign)
END FUNCTION