' RTHMTC.TMR - simulating the four arithmetic operations via strings, written back in 90's by Kaze, (sanmayce[member=743]Sanmayce[/member].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 MUL$
("-0.4", "222222222222222222222222222222222222") PRINT DIV$
("22.7", "-3", 10) ' Examples ]
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$)
IF FirstSign$
= "-" AND SecondSign$
<> "-" THEN Mediator$
= RIGHT$(FirstAddend$
, FiradLength
- 1) ADD$ = SUBqb$(SecondAddend$, Mediator$)
IF FirstSign$
= "-" AND SecondSign$
= "-" THEN Sign = 1
FiradLength = FiradLength - 1
SecadLength = SecadLength - 1
FirstAddend$
= RIGHT$(FirstAddend$
, FiradLength
) SecondAddend$
= RIGHT$(SecondAddend$
, 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
BigLength = FiradTrueLength
IF FiradPointPos
> SecadPointPos
THEN BigPointPos = FiradPointPos
TrueBigPointPos = BigPointPos - FiradFlag
SubSecad = SecadPointPos - SecadFlag - TrueBigPointPos
BigPointPos = SecadPointPos
TrueBigPointPos = BigPointPos - SecadFlag
SubFirad = FiradPointPos - FiradFlag - TrueBigPointPos
DimSum = BigLength + TrueBigPointPos + 1
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)
Result%(SF + 1) = 1
Result%(SF) = Result(SF) - 10
ADD$ = ResultFilter$(Result%(), "ADD", DimSum, BigPointPos, Sign)
FirLeftPart
= INSTR(Firum$
, ".") SecLeftPart
= INSTR(Secum$
, ".") FirLeftPart
= LEN(Firum$
) FirLeftPart = FirLeftPart - 1
FirRightPart
= LEN(Firum$
) - FirLeftPart
SecLeftPart
= LEN(Secum$
) SecLeftPart = SecLeftPart - 1
SecRightPart
= LEN(Secum$
) - SecLeftPart
IF SecRightPart
> FirRightPart
THEN MainRightPart = FirRightPart
MainRightPart = SecRightPart
IF SecLeftPart
> FirLeftPart
THEN CompareCode = -1
MainLeftPart = SecLeftPart
CompareCode = 1
MainLeftPart = FirLeftPart
IF SecLeftPart
= FirLeftPart
THEN CompareCode = 0
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 MainLength = MainLeftPart + MainRightPart
Counter = Counter + 1
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 IF Counter
= MainLength
AND CycleFlag
= 0 THEN IF FirRightPart
< SecRightPart
THEN CompareCode
= -1 IF FirRightPart
> SecRightPart
THEN CompareCode
= 1 Compare% = CompareCode
SUB Convert
(Array%
(), Number$
, Length
, Flag
, PointPos
) FOR Counter
= 1 TO Length
Shoot$
= MID$(Number$
, Length
- Counter
+ 1, 1) Flag = 1
PointPos = Counter
Counter = Counter + 1
Shoot$
= MID$(Number$
, Length
- Counter
+ 1, 1) Array%
(Counter
- Flag
) = VAL(Shoot$
)
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
SUB DelNull
(Result%
(), Tiller$
, DimLength
) Counter = DimLength
Tiller$
= RIGHT$(Tiller$
, Counter
- 1) Counter = Counter - 1
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
PointPos = NewPointPos
FUNCTION DIV$
(Dividend$
, Divisor$
, Exactness
) DendSign$
= MID$(Dividend$
, 1, 1) SorSign$
= MID$(Divisor$
, 1, 1) Sign = 1
Dividend$
= RIGHT$(Dividend$
, LEN(Dividend$
) - 1) Sign = 1
Divisor$
= RIGHT$(Divisor$
, LEN(Divisor$
) - 1) Divisor$
= RIGHT$(Divisor$
, LEN(Divisor$
) - 1) Dividend$
= RIGHT$(Dividend$
, LEN(Dividend$
) - 1) DendPointPos
= INSTR(Dividend$
, ".") SorPointPos
= INSTR(Divisor$
, ".") DendRightPart
= LEN(Dividend$
) - DendPointPos
DendRightPart$
= RIGHT$(Dividend$
, DendRightPart
) Dividend$
= LEFT$(Dividend$
, DendPointPos
- 1) + DendRightPart$
SorRightPart
= LEN(Divisor$
) - SorPointPos
SorRightPart$
= RIGHT$(Divisor$
, SorRightPart
) Divisor$
= LEFT$(Divisor$
, SorPointPos
- 1) + SorRightPart$
Dividend$
= RIGHT$(Dividend$
, LEN(Dividend$
) - 1) Divisor$
= RIGHT$(Divisor$
, LEN(Divisor$
) - 1) DendLength
= LEN(Dividend$
) SorLength
= LEN(Divisor$
) IF DendLength
<= SorLength
THEN Tiller$ = Dividend$
Mediator$ = FindIntegerPart$(Dividend$, Divisor$)
IntegerPart$ = Mediator$
Pointer = SorLength
Tiller$
= MID$(Dividend$
, 1, Pointer
) IF FindIntegerPart$
(Tiller$
, Divisor$
) = "0" THEN Pointer = SorLength + 1
Tiller$
= MID$(Dividend$
, 1, Pointer
) Mediator$ = FindIntegerPart$(Tiller$, Divisor$)
IntegerPart$ = IntegerPart$ + Mediator$
Pointer = Pointer + 1
Shoot$ = MUL$(Mediator$, Divisor$)
Deviation$ = SUBqb$(Tiller$, Shoot$)
Tiller$
= MID$(Dividend$
, Pointer
, 1) Tiller$
= Deviation$
+ MID$(Dividend$
, Pointer
, 1) Mediator$ = FindIntegerPart$(Tiller$, Divisor$)
IntegerPart$ = IntegerPart$ + Mediator$
Result$ = IntegerPart$
RelativePosition = DendRightPart - SorRightPart
MiddlePosition
= LEN(IntegerPart$
) - RelativePosition
CycleLength = Exactness - RelativePosition
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$
Result$ = Result$ + FractionalPart$
LeftPart$
= LEFT$(Result$
, MiddlePosition
) Result$ = LeftPart$
RightPart$
= RIGHT$(Result$
, LEN(Result$
) - MiddlePosition
) Result$ = LeftPart$ + "." + RightPart$
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)
Result$ = "0." + Result$
Result$
= "0." + STRING$(ABS(MiddlePosition
), "0") + Result$
Result$ = "0"
Result$
= LEFT$(Result$
, 2 + Exactness
) IF Sign
= 1 THEN DIV$
= "-" + Result$
ELSE DIV$
= Result$
FUNCTION FindIntegerPart$
(Dividend$
, Divisor$
) Counter = Counter + 1
Tiller$ = MUL$(Digit$, Divisor$)
CompareCode = Compare%(Tiller$, Dividend$)
FindIntegerPart$
= LTRIM$(STR$(Counter
- CompareCode
))
FUNCTION MUL$
(Multiplicand$
, Multiplier$
) CandSign$
= MID$(Multiplicand$
, 1, 1) ErSign$
= MID$(Multiplier$
, 1, 1) CandLength
= LEN(Multiplicand$
) ErLength
= LEN(Multiplier$
) Sign = 1
CandLength = CandLength - 1
Multiplicand$
= RIGHT$(Multiplicand$
, CandLength
) Sign = 1
ErLength = ErLength - 1
Multiplier$
= RIGHT$(Multiplier$
, ErLength
) ErLength = ErLength - 1
CandLength = CandLength - 1
Multiplier$
= RIGHT$(Multiplier$
, ErLength
) Multiplicand$
= RIGHT$(Multiplicand$
, CandLength
) CALL Convert
(Cand%
(), Multiplicand$
, CandLength
, CandFlag
, CandPointPos
) CALL Convert
(Er%
(), Multiplier$
, ErLength
, ErFlag
, ErPointPos
) DimSum = CandLength + ErLength - CandFlag - ErFlag
PointPos = CandPointPos + ErPointPos - CandFlag - ErFlag
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
) Result%(Cycle) = Result%(Cycle) - 10
CarryFlag = 1
NextNumPos = Cycle + 1
Result%(NextNumPos) = Result%(NextNumPos) + CarryFlag + Tiller \ 10
Result%(NextNumPos) = Result%(NextNumPos) - 10
NextNumPos = NextNumPos + 1
Result%(NextNumPos) = Result%(NextNumPos) + 1
MUL$ = ResultFilter$(Result%(), "MUL", DimSum, PointPos, Sign)
FUNCTION ResultFilter$
(Result%
(), Code$
, DimLength
, PointPos
, Sign
) FOR I
= 1 TO DimLength
- 1 IF I
= PointPos
THEN Tiller$
= "." + Tiller$
IF Result%
(DimLength
) <> 0 THEN Tiller$
= LTRIM$(STR$(Result%
(DimLength
))) + Tiller$
CALL DelRightNull
(Result%
(), Tiller$
, StrLength
, PointPos
) IF Sign
= 1 THEN Tiller$
= "-" + Tiller$
IF I
= PointPos
THEN Tiller$
= "." + Tiller$
CALL DelRightNull
(Result%
(), Tiller$
, StrLength
, PointPos
) CALL DelLeftNull
(Result%
(), Tiller$
, StrLength
, DimLength
, PointPos
) CALL DelNull
(Result%
(), Tiller$
, DimLength
) IF Sign
= -1 THEN Tiller$
= "-" + Tiller$
IF I
= PointPos
THEN Tiller$
= "." + Tiller$
IF Result%
(DimLength
) = 0 THEN Tiller$
= RIGHT$(Tiller$
, DimLength
- 1) PointPos = PointPos + 1
Tiller$
= RIGHT$(Tiller$
, DimLength
) TrueDimLength = StrLength - 1
CALL DelRightNull
(Result%
(), Tiller$
, StrLength
, PointPos
) CALL DelLeftNull
(Result%
(), Tiller$
, StrLength
, TrueDimLength
, PointPos
) IF Sign
= 1 THEN Tiller$
= "-" + Tiller$
IF Tiller$
= "-0" THEN Tiller$
= "0" ResultFilter$ = Tiller$
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$)
IF MinuSign$
<> "-" AND SubtraSign$
= "-" THEN Mediator$
= RIGHT$(Subtrahend$
, SubtraLength
- 1) SUBqb$ = ADD$(Minuend$, Mediator$)
IF MinuSign$
= "-" AND SubtraSign$
= "-" THEN SWAP Minuend$
, Subtrahend$
MinuLength = MinuLength - 1
SubtraLength = SubtraLength - 1
Minuend$
= RIGHT$(Minuend$
, MinuLength
) Subtrahend$
= RIGHT$(Subtrahend$
, 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
MainTrueLength = MinuTrueLength
CompareCode = Compare%(Minuend$, Subtrahend$)
IF MinuPointPos
< SubtraPointPos
THEN BigPointPos = SubtraPointPos
TrueBigPointPos = BigPointPos - SubtraFlag
MinuSub = MinuPointPos - MinuFlag - TrueBigPointPos
BigPointPos = MinuPointPos
TrueBigPointPos = BigPointPos - MinuFlag
SubtraSub = SubtraPointPos - SubtraFlag - TrueBigPointPos
DimSum = MainTrueLength + TrueBigPointPos
MinuDim = 0
SubtraDim = 0
MinuSub = MinuSub + 1
SubtraSub = SubtraSub + 1
IF MinuSub
> 0 AND MinuSub
<= MinuLength
- MinuFlag
THEN MinuDim = Minu%(MinuSub)
IF SubtraSub
> 0 AND SubtraSub
<= SubtraLength
- SubtraFlag
THEN SubtraDim = Subtra%(SubtraSub)
MinuDim = MinuDim + SubFlag
SubtraDim = SubtraDim + SubFlag
SubSum = Sign * (MinuDim - SubtraDim)
SubFlag = 0
Result%(SF) = SubSum
IF SubSum
< 0 THEN SubFlag
= -1 Result%(SF) = SubSum + 10
IF SubSum
< 0 THEN SubFlag
= -1 Result%(SF) = SubSum + 10
Result%(SF) = SubSum
SUBqb$ = ResultFilter$(Result%(), "SUB", DimSum, BigPointPos, Sign)