universal base conversion program possibly for a base conversion library later on

[Dragoncat]

This is a work in progress this is my master character set for a number base conversion program that I hope will have a command line mode and a batch / file mode as well say you have a large number of numbers you want to convert or a list or maybe just one in a file somewhere you want to convert into any other base
in my format I plan to have a period decimal point indication the separation of the whole and fractional part  it can handle up to base 169 using a diacritical mark as aa separator, it will have space and return will have no meaning allowing you to wrap numbers across multiple lines etc... and unused characters can be used as separators notably the comma colon and semi colon. here it is so far:

Code: (Select All)

rem separators space = add 0 '  86 "172 ;258 :344 to reach a highest value of base 429 using 2 chars per digit
 Dim mcset(169) As String * 2
For ndx% = 0 To 9
    mcset(ndx%) = Chr$(32) + Chr$(48 + ndx%)
Next ndx%
For ndx% = 10 To 35
    mcset(ndx%) = Chr$(32) + Chr$(ndx% + 87)
Next ndx%
For ndx% = 36 To 61
    mcset(ndx%) = Chr$(32) + Chr$(ndx% + 29)
Next ndx%
For ndx% = 62 To 85
    mcset(ndx%) = Chr$(32) + dtrd$
Next ndx%
For ndx% = 86 To 109
    mcset(ndx%) = Chr$(39) + Right$(mcset(ndx% - 24), 1)
Next ndx%
For ndx% = 110 To 169
    mcset(ndx%) = Chr$(39) + Right$(mcset(ndx% - 110), 1)
Next ndx%




Data "!","#","$","%","&","(",")","*"
Data "+","_","/","<","=",">","?","@"
Data "[","\","]","^","{","|","}","~"

mcset() is the master base character file that will be used by all "numbers" the actual numbers will have the base that the number is in prefixed to the number and be as a string with spaces and only the unneeded marks removed  it will basically be a formated number ascii code 39's will not be removed as they coupled with one of the other symbols I used will constitute a digit , larger bases will be done by using 0 - 99 and then multiple bases actually I will try to provide for maximum flexibility and allow using any base as a base for expansion into multi "digit" bases so lets say your desired base is a square of some base say 36^2 then you can use base 36 characters 2 per a value or such... or say to have a base 600 you can use base 100 and then only go from 0 to 5 on the higher order of the number.... if you have any ideas or help or can help me correctly spell words here it'd be appreciated!

[Dragoncat]

need to change from using the - symbol to using _ underscore that way - can indicate negation ie negative numbers

[Dragoncat]

Code: (Select All)

Option _Explicit
_Title "String Math Powers 2022-09-22" ' b+ try to do powers with string math
' directly from "String Math 2021-06-14" ' b+ from SM2 (2021 June) a bunch of experiments to fix and improve speeds.
' June 2021 fix some old String Math procedures, better nInverse with new LT function, remove experimental procedures.
' Now with decent sqrRoot it works independent of Mr$() = Math Regulator that handles signs and decimals and calls to
' add$(), subtr$, mult$, divide$ (100 significant digits),  add$(), subtr$, mult$ are exact!
' If you need higher precsion divide, I recommend use nInverse on denominator (integer)
' then add sign and decimal and mult$() that number with numerator to get divsion answer in higher precision than 100.
' (See how Mr$() handles division and just call nInverse$ with what precision you need.)
' The final function showDP$() is for displaying these number to a set amount of Decimal Places.

' The main code is sampler of tests performed with these functions.
' 2022-09-22 a little fix to MR$ for Function change versions QB64 v2.0+
' Attempt to do Powers with SQRs of 2 Multipliers
' needs to be able to convert a number into a binary String
' might also need a Table setup for nested SQR's of 2
' needs a decent BigSQR$ string function for SQR
' 2022-09-25 this is one frustration after another LT does not work for strings??? but < does?
' try some more with BigSQR concentrate on Integer part first, just get that right
' 2022-09-26 Bin2Dec$ Function seems OK

$Console:Only
Dim dinpt, oput As String * 40
Dim dbase As String * 800
Dim dinput As String * 80
Dim dnum As String * 80
Dim whprt As String * 800
Dim fprt As String * 800
Dim gttl As String * 800
Dim qmlt As String * 80
Dim mlt As String * 80
Dim zee As String * 800
Dim sen As Long
Dim sign As Long
Dim ctr As Long
Dim flg As Long
Dim flg2 As Long
Dim lsplt As Long
Dim rsplt As Long
Dim pres As Long
Randomize Timer
Rem  $Dynamic
dinput = "000000000000"
Print "enter number to convert from incl.base use 4 digits for each digit include 0 in each of the 4 places thaat contains no value so 0 is 0000 and 1 is 0001 "
Print "first enter a base of at least 2 (0002) enter - for a negative number . for decimal point"
Input ": "; dinput
Print " in a similiar manner enter the base to convert too "
Input ": "; oput
sen = Len(dinput)
dbase = Left$(dinput, 4)
sen = sen - 4
dnum = Right$(dinput, sen)
sign = 1
sen = Len(dnum)
If Left$(dnum, 1) = "-" Then
    sign = -1
    sen = sen - 1
    dnum = Right$(dnum, sen)
End If
ctr = 1
flg = 0
flg2 = 0
While flg = 0 And ctr <= sen
    If Mid$(dnum, ctr, 1) = "." Then
        lsplt = ctr - 1
        rsplt = sen - ctr
        flg = 1
        If ctr = 1 Then flg2 = 1
    End If
    ctr = ctr + 1
Wend
If flg = 1 And flg2 = 0 Then
    whprt = Left$(dnum, lsplt)
    fprt = Right$(dnum, rsplt)
End If
If flg = 1 And flg2 = 1 Then
    whprt = "0000"
    fprt = Right$(dnum, rsplt)
    lsplt = 4
End If
gttl = "0"
qmlt = "1"
mlt = dbase
If flg = 0 Then whprt = dnum
While lsplt > 0
    zee = Right$(whprt, 4)
    gttl = mr(gttl, "+", mr(zee, "*", qmlt))
    qmlt = mr(qmlt, "*", mlt)
    lsplt = lsplt - 4
    whprt = Left$(whprt, lsplt)
Wend
pres = Int((Log(Val(dbase)) * Int(rsplt / 4)) / Log(Val(oput)))
qmlt = "1"
Rem  wqs&& = 1 to pres&&
qmlt = mr(qmlt, "/", dbase)
While rsplt >= 4
    zee = Left$(fprt, 4)
    gttl = mr(gttl, "+", mr(zee, "*", qmlt))
    qmlt = mr(qmlt, "/", dbase)
    rsplt = rsplt - 4
    fprt = Right$(fprt, rsplt)
Wend
Print "base ten value: "; gttl

' 2022-09-25 Use BigSQR$ it's way faster, no estimating!
' ==  String Math 2021-06-14 Procedure start here (aprox 412 LOC for copy/paste into your app) ==
Function sqrRoot$ (nmbr$)
    Dim n$, guess$, lastGuess$, other$, sum$, imaginary$, loopcnt
    If Left$(nmbr$, 1) = "-" Then 'handle neg numbers
        imaginary$ = "*i": n$ = Mid$(nmbr$, 2)
    Else
        imaginary$ = "": n$ = nmbr$
    End If
    guess$ = mr$(n$, "/", "2")
    other$ = n$
    Do
        loopcnt = loopcnt + 1
        If (Mid$(guess$, 1, 105) = Mid$(lastGuess$, 1, 105)) Then
            ' go past 100 matching digits for 100 digit precision
            sqrRoot$ = Mid$(other$, 1, 101) + imaginary$
            ' try other factor for guess$  sometimes it nails answer without all digits
            Exit Function
        Else
            lastGuess$ = guess$
            sum$ = mr$(guess$, "+", other$)
            guess$ = mr$(sum$, "/", "2")
            other$ = mr$(n$, "/", guess$)
        End If
    Loop
End Function

Function add$ (a$, b$) 'add 2 positive integers assume a and b are just numbers no - signs
    'set a and b numbers to same length and multiple of 18 so can take 18 digits at a time
    Dim As Long la, lb, m, g
    Dim sa As _Unsigned _Integer64, sb As _Unsigned _Integer64, co As _Unsigned _Integer64
    Dim fa$, fb$, t$, new$, result$
    la = Len(a$): lb = Len(b$)
    If la > lb Then m = Int(la / 18) + 1 Else m = Int(lb / 18) + 1
    fa$ = Right$(String$(m * 18, "0") + a$, m * 18)
    fb$ = Right$(String$(m * 18, "0") + b$, m * 18)

    'now taking 18 digits at a time Thanks Steve McNeill
    For g = 1 To m
        sa = Val(Mid$(fa$, (m - g) * 18 + 1, 18))
        sb = Val(Mid$(fb$, (m - g) * 18 + 1, 18))
        t$ = Right$(String$(36, "0") + _Trim$(Str$(sa + sb + co)), 36)
        co = Val(Mid$(t$, 1, 18))
        new$ = Mid$(t$, 19)
        result$ = new$ + result$
    Next
    If co Then result$ = Str$(co) + result$
    add$ = result$
End Function

' This is used in nInverse$ not by Mr$ because there it saves time!
Function subtr1$ (a$, b$)
    Dim As Long la, lb, lResult, i, ca, cb, w
    Dim result$, fa$, fb$

    la = Len(a$): lb = Len(b$)
    If la > lb Then lResult = la Else lResult = lb
    result$ = Space$(lResult)
    fa$ = result$: fb$ = result$
    Mid$(fa$, lResult - la + 1) = a$
    Mid$(fb$, lResult - lb + 1) = b$
    For i = lResult To 1 Step -1
        ca = Val(Mid$(fa$, i, 1))
        cb = Val(Mid$(fb$, i, 1))
        If cb > ca Then ' borrow 10
            Mid$(result$, i, 1) = Right$(Str$(10 + ca - cb), 1)
            w = i - 1
            While w > 0 And Mid$(fa$, w, 1) = "0"
                Mid$(fa$, w, 1) = "9"
                w = w - 1
            Wend
            Mid$(fa$, w, 1) = Right$(Str$(Val(Mid$(fa$, w, 1)) - 1), 1)
        Else
            Mid$(result$, i, 1) = Right$(Str$(ca - cb), 1)
        End If
    Next
    subtr1$ = result$
End Function

' 2021-06-08 fix up with new mr call that decides the sign and puts the greater number first
Function subtr$ (sum$, minus$) ' assume both numbers are positive all digits
    Dim As Long m, g, p
    Dim VB As _Unsigned _Integer64, vs As _Unsigned _Integer64, tenE18 As _Unsigned _Integer64
    Dim ts$, tm$, sign$, LG$, sm$, t$, result$

    ts$ = _Trim$(sum$): tm$ = _Trim$(minus$) ' fixed subtr$ 2021-06-05
    If trim0(ts$) = trim0$(tm$) Then subtr$ = "0": Exit Function 'proceed knowing not equal
    tenE18 = 1000000000000000000 'yes!!! no dang E's
    sign$ = ""
    m = Int(Len(ts$) / 18) + 1
    LG$ = Right$(String$(m * 18, "0") + ts$, m * 18)
    sm$ = Right$(String$(m * 18, "0") + tm$, m * 18)

    'now taking 18 digits at a time From Steve I learned we can do more than 1 digit at a time
    For g = 1 To m
        VB = Val(Mid$(LG$, m * 18 - g * 18 + 1, 18))
        vs = Val(Mid$(sm$, m * 18 - g * 18 + 1, 18))
        If vs > VB Then
            t$ = Right$(String$(18, "0") + _Trim$(Str$(tenE18 - vs + VB)), 18)
            p = (m - g) * 18
            While p > 0 And Mid$(LG$, p, 1) = "0"
                Mid$(LG$, p, 1) = "9"
                p = p - 1
            Wend
            If p > 0 Then Mid$(LG$, p, 1) = _Trim$(Str$(Val(Mid$(LG$, p, 1)) - 1))
        Else
            t$ = Right$(String$(18, "0") + _Trim$(Str$(VB - vs)), 18)
        End If
        result$ = t$ + result$
    Next
    subtr$ = result$
End Function

Function TrimLead0$ (s$) 'for treating strings as number (pos integers)
    Dim copys$
    Dim As Long i, find
    copys$ = _Trim$(s$) 'might as well remove spaces too
    i = 1: find = 0
    While i < Len(copys$) And Mid$(copys$, i, 1) = "0"
        i = i + 1: find = 1
    Wend
    If find = 1 Then copys$ = Mid$(copys$, i)
    If copys$ = "" Then TrimLead0$ = "0" Else TrimLead0$ = copys$
End Function

' catchy? mr$ for math regulator  cop$ = " + - * / " 1 of 4 basic arithmetics
' Fixed so that add and subtract have signs calc'd in Mr and correct call to add or subtract made
' with bigger minus smaller in subtr$() call
Function mr$ (a$, cop$, b$)
    Dim op$, ca$, cb$, aSgn$, bSgn$, postOp$, sgn$, rtn$
    Rem  Dim aLTb As String * 800
    Dim As Long adp, bdp, dp, lpop, aLTb
    op$ = _Trim$(cop$) 'save fixing each time
    ca$ = _Trim$(a$): cb$ = _Trim$(b$) 'make copies in case we change
    'strip signs and decimals
    If Left$(ca$, 1) = "-" Then
        aSgn$ = "-": ca$ = Mid$(ca$, 2)
    Else
        aSgn$ = ""
    End If
    dp = InStr(ca$, ".")
    If dp > 0 Then
        adp = Len(ca$) - dp
        ca$ = Mid$(ca$, 1, dp - 1) + Mid$(ca$, dp + 1)
    Else
        adp = 0
    End If
    If Left$(cb$, 1) = "-" Then
        bSgn$ = "-": cb$ = Mid$(cb$, 2)
    Else
        bSgn$ = ""
    End If
    dp = InStr(cb$, ".")
    If dp > 0 Then
        bdp = Len(cb$) - dp
        cb$ = Mid$(cb$, 1, dp - 1) + Mid$(cb$, dp + 1)
    Else
        bdp = 0
    End If
    If op$ = "+" Or op$ = "-" Or op$ = "/" Then 'add or subtr  even up strings on right of decimal
        'even up the right sides of decimals if any
        If adp > bdp Then dp = adp Else dp = bdp
        If adp < dp Then ca$ = ca$ + String$(dp - adp, "0")
        If bdp < dp Then cb$ = cb$ + String$(dp - bdp, "0")
    ElseIf op$ = "*" Then
        dp = adp + bdp
    End If
    If op$ = "*" Or op$ = "/" Then
        If aSgn$ = bSgn$ Then sgn$ = "" Else sgn$ = "-"
    End If

    'now according to signs and op$ call add$ or subtr$
    If op$ = "-" Then ' make it adding according to signs because that is done for + next!
        If bSgn$ = "-" Then bSgn$ = "" Else bSgn$ = "-" ' flip bSgn$ with op$
        op$ = "+" ' turn this over to + op already done! below
    End If
    If op$ = "+" Then
        If aSgn$ = bSgn$ Then 'really add
            postOp$ = add$(ca$, cb$)
            sgn$ = aSgn$
        ElseIf aSgn$ <> bSgn$ Then 'have a case of subtraction
            'but which is first and which is 2nd and should final sign be pos or neg
            If TrimLead0$(ca$) = TrimLead0(cb$) Then 'remove case a = b
                mr$ = "0": Exit Function
            Else
                aLTb = LTE(ca$, cb$)
                If aSgn$ = "-" Then
                    If aLTb Then ' b - a = pos
                        postOp$ = subtr$(cb$, ca$)
                        sgn$ = ""
                    Else '  a > b so a - sgn wins  - (a - b)
                        postOp$ = subtr$(ca$, cb$)
                        sgn$ = "-"
                    End If
                Else ' b has the - sgn
                    If aLTb Then ' result is -
                        postOp$ = subtr$(cb$, ca$)
                        sgn$ = "-"
                    Else ' result is pos
                        postOp$ = subtr$(ca$, cb$)
                        sgn$ = ""
                    End If
                End If
            End If
        End If
    ElseIf op$ = "*" Then
        postOp$ = mult$(ca$, cb$)
    ElseIf op$ = "/" Then
        postOp$ = divide$(ca$, cb$)
    End If ' which op
    If op$ <> "/" Then 'put dp back
        lpop = Len(postOp$) ' put decimal back if there is non zero stuff following it
        If Len(Mid$(postOp$, lpop - dp + 1)) Then ' fix 1 extra dot appearing in 10000! ?!
            If TrimLead0$(Mid$(postOp$, lpop - dp + 1)) <> "0" Then '  .0  or .00 or .000  ??
                postOp$ = Mid$(postOp$, 1, lpop - dp) + "." + Mid$(postOp$, lpop - dp + 1)
            End If
        End If
    End If
    rtn$ = trim0$(postOp$) 'trim lead 0's then tack on sign
    If rtn$ <> "0" Then mr$ = sgn$ + rtn$ Else mr$ = rtn$
End Function

Function divide$ (n$, d$) ' goal here is 100 digits precision not 100 digits past decimal
    Dim di$, ndi$
    Dim As Long nD
    If n$ = "0" Then divide$ = "0": Exit Function
    If d$ = "0" Then divide$ = "div 0": Exit Function
    If d$ = "1" Then divide$ = n$: Exit Function

    ' aha! found a bug when d$ gets really huge 100 is no where near enough!!!!
    ' 2021-06-03 fix by adding 100 to len(d$), plus have to go a little past 100 like 200
    di$ = Mid$(nInverse$(d$, Len(d$) + 200), 2) 'chop off decimal point after
    nD = Len(di$)
    ndi$ = mult$(n$, di$)
    ndi$ = Mid$(ndi$, 1, Len(ndi$) - nD) + "." + Right$(String$(nD, "0") + Right$(ndi$, nD), nD)
    divide$ = ndi$
End Function

' This uses Subtr1$ is Positive Integer only!
' DP = Decimal places = says when to quit if don't find perfect divisor before
Function nInverse$ (n$, DP As Long) 'assume decimal at very start of the string of digits returned
    Dim m$(1 To 9), si$, r$, outstr$, d$
    Dim i As Long
    For i = 1 To 9
        si$ = _Trim$(Str$(i))
        m$(i) = mult$(si$, n$)
    Next
    outstr$ = ""
    If n$ = "0" Then nInverse$ = "Div 0": Exit Function
    If n$ = "1" Then nInverse$ = "1": Exit Function
    outstr$ = "." 'everything else n > 1 is decimal 8/17
    r$ = "10"
    Do
        While LT(r$, n$) ' 2021-06-08 this should be strictly Less Than
            outstr$ = outstr$ + "0" '            add 0 to the  output string
            If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function 'DP length?
            r$ = r$ + "0"
        Wend
        For i = 9 To 1 Step -1
            If LTE(m$(i), r$) Then d$ = _Trim$(Str$(i)): Exit For
        Next
        outstr$ = outstr$ + d$
        If Len(outstr$) = DP + 1 Then nInverse$ = outstr$: Exit Function
        r$ = subtr1$(r$, mult$(d$, n$)) 'r = r -d*n    ' 2021-06-08 subtr1 works faster
        If TrimLead0$(r$) = "0" Then nInverse$ = outstr$: Exit Function ' add trimlead0$ 6/08
        r$ = r$ + "0" 'add another place
    Loop
End Function

Function mult$ (a$, b$) 'assume both positive integers prechecked as all digits strings
    Dim As Long la, lb, m, g, dp
    Dim As _Unsigned _Integer64 v18, sd, co
    Dim f18$, f1$, t$, build$, accum$

    If a$ = "0" Then mult$ = "0": Exit Function
    If b$ = "0" Then mult$ = "0": Exit Function
    If a$ = "1" Then mult$ = b$: Exit Function
    If b$ = "1" Then mult$ = a$: Exit Function
    'find the longer number and make it a mult of 18 to take 18 digits at a time from it
    la = Len(a$): lb = Len(b$)
    If la > lb Then
        m = Int(la / 18) + 1
        f18$ = Right$(String$(m * 18, "0") + a$, m * 18)
        f1$ = b$
    Else
        m = Int(lb / 18) + 1
        f18$ = Right$(String$(m * 18, "0") + b$, m * 18)
        f1$ = a$
    End If
    For dp = Len(f1$) To 1 Step -1 'dp = digit position of the f1$
        build$ = "" 'line builder
        co = 0
        'now taking 18 digits at a time Thanks Steve McNeill
        For g = 1 To m
            v18 = Val(Mid$(f18$, (m - g) * 18 + 1, 18))
            sd = Val(Mid$(f1$, dp, 1))
            t$ = Right$(String$(19, "0") + _Trim$(Str$(v18 * sd + co)), 19)
            co = Val(Mid$(t$, 1, 1))
            build$ = Mid$(t$, 2) + build$
        Next g
        If co Then build$ = _Trim$(Str$(co)) + build$
        If dp = Len(f1$) Then
            accum$ = build$
        Else
            accum$ = add$(accum$, build$ + String$(Len(f1$) - dp, "0"))
        End If
    Next dp
    mult$ = accum$
End Function
Function TrimTail0$ (s$)
    Dim copys$
    Dim As Long dp, i, find
    copys$ = _Trim$(s$) 'might as well remove spaces too
    TrimTail0$ = copys$
    dp = InStr(copys$, ".")
    If dp > 0 Then
        i = Len(copys$): find = 0
        While i > dp And Mid$(copys$, i, 1) = "0"
            i = i - 1: find = 1
        Wend
        If find = 1 Then
            If i = dp Then
                TrimTail0$ = Mid$(copys$, 1, dp - 1)
            Else
                TrimTail0$ = Mid$(copys$, 1, i)
            End If
        End If
    End If
End Function

Function trim0$ (s$)
    Dim cs$, si$
    cs$ = s$
    si$ = Left$(cs$, 1)
    If si$ = "-" Then cs$ = Mid$(cs$, 2)
    cs$ = TrimLead0$(cs$)
    cs$ = TrimTail0$(cs$)
    If Right$(cs$, 1) = "." Then cs$ = Mid$(cs$, 1, Len(cs$) - 1)
    If si$ = "-" Then trim0$ = si$ + cs$ Else trim0$ = cs$
End Function

' for displaying truncated numbers say to 60 digits
Function showDP$ (dnum, nDP As Long)
    Dim Cnum$
    Dim As Long dp, d, i
    cNum$ = num$ 'since num$ could get changed
    showDP$ = num$
    dp = InStr(num$, ".")
    If dp > 0 Then
        If Len(Mid$(cNum$, dp + 1)) > nDP Then
            d = Val(Mid$(cNum$, dp + nDP + 1, 1))
            If d > 4 Then
                cNum$ = "0" + cNum$ ' tack on another 0 just in case 9's all the way to left
                dp = dp + 1
                i = dp + nDP
                While Mid$(cNum$, i, 1) = "9" Or Mid$(cNum$, i, 1) = "."
                    If Mid$(cNum$, i, 1) = "9" Then
                        Mid$(cNum$, i, 1) = "0"
                    End If
                    i = i - 1
                Wend
                Mid$(cNum$, i, 1) = _Trim$(Str$(Val(Mid$(cNum$, i, 1)) + 1)) 'last non 9 digit
                cNum$ = Mid$(cNum$, 1, dp + nDP) 'chop it
                showDP$ = trim0$(cNum$)
            Else
                showDP$ = Mid$(cNum$, 1, dp + nDP)
            End If
        End If
    End If
End Function

there it is the LT function seems to be gone / missing!!!

[bplus]

there it is the LT function seems to be gone / missing!!!

If you are talking about my String Math code there are both LT and LTE "helper" routines for handling string math. This is in nice convenient .BM file here: 
https://qb64phoenix.com/forum/showthread...9#pid33179
4th to last and 3rd to last listed are the helper LT and LTE routines for String Math.

It would help if you, @Dragoncat, put your code under code tags so other people can quickly copy and check it out wwhat you have.

[Dragoncat]

oh ok how do I do that???

---

Code: (Select All)

Dim dinpt, oput As String * 40

Dim dbase As String * 800

Dim dinput As String * 80

Dim dnum As String * 80

Dim whprt As String * 800

Dim fprt As String * 800

Dim gttl As String * 800

Dim qmlt As String * 80

Dim mlt As String * 80

Dim zee As String * 800

Dim sen As Long

Dim sign As Long

Dim ctr As Long

Dim flg As Long

Dim flg2 As Long

Dim lsplt As Long

Dim rsplt As Long

Dim pres As Long

Randomize Timer

Rem  $Dynamic

dinput = "000000000000"

Print "enter number to convert from incl.base use 4 digits for each digit include 0 in each of the 4 places thaat contains no value so 0 is 0000 and 1 is 0001 "

Print "first enter a base of at least 2 (0002) enter - for a negative number . for decimal point"

Input ": "; dinput

Print " in a similiar manner enter the base to convert too "

Input ": "; oput

sen = Len(dinput)

dbase = Left$(dinput, 4)

sen = sen - 4

dnum = Right$(dinput, sen)

sign = 1

sen = Len(dnum)

If Left$(dnum, 1) = "-" Then

    sign = -1

    sen = sen - 1

    dnum = Right$(dnum, sen)

End If

ctr = 1

flg = 0

flg2 = 0

While flg = 0 And ctr <= sen

    If Mid$(dnum, ctr, 1) = "." Then

        lsplt = ctr - 1

        rsplt = sen - ctr

        flg = 1

        If ctr = 1 Then flg2 = 1

    End If

    ctr = ctr + 1

Wend

If flg = 1 And flg2 = 0 Then

    whprt = Left$(dnum, lsplt)

    fprt = Right$(dnum, rsplt)

End If

If flg = 1 And flg2 = 1 Then

    whprt = "0000"

    fprt = Right$(dnum, rsplt)

    lsplt = 4

End If

gttl = "0"

qmlt = "1"

mlt = dbase

If flg = 0 Then whprt = dnum

While lsplt > 0

    zee = Right$(whprt, 4)

    gttl = mr(gttl, "+", mr(zee, "*", qmlt))

    qmlt = mr(qmlt, "*", mlt)

    lsplt = lsplt - 4

    whprt = Left$(whprt, lsplt)

Wend

pres = Int((Log(Val(dbase)) * Int(rsplt / 4)) / Log(Val(oput)))

qmlt = "1"

Rem  wqs&& = 1 to pres&&

qmlt = mr(qmlt, "/", dbase)

While rsplt >= 4

    zee = Left$(fprt, 4)

    gttl = mr(gttl, "+", mr(zee, "*", qmlt))

    qmlt = mr(qmlt, "/", dbase)

    rsplt = rsplt - 4

    fprt = Right$(fprt, rsplt)

Wend

Print "base ten value: "; gttl

like this?

---

that last post of mine is my latest it seems to be running some kind of error it prints out what looks like a fractional part but the whole number part is nowhere to be seen

[bplus]

+1 Yes! thanks

Immediately I can see a problem red-lined in line 65, maybe missing routines?

[Dragoncat]

+1 Yes! thanks

Immediately I can see a problem red-lined in line 65, maybe missing routines?

I think maybe I am tired I'll get on it real soon, after I rest / sleep

---

+1 Yes! thanks

Immediately I can see a problem red-lined in line 65, maybe missing routines?

oh yes I only put my program I needs those Bplus routines to get it to work!!!

[Dragoncat]

ok looks Like I wont be able to finish this behemouth of a program and I am tired I give up!!!

[PhilOfPerth]

That's great stuff @Dragoncat; Far above my feeble abilities. 
We all have progs that we start and "shelve" for a while, either because someone else beat us to it, or it seems to be an unending battle. 
If you need to, put it aside for a while; I'm sure inspiration will return, or you will divert to another project.
Good luck!

[Jack]

@Dragoncat 
looks like a good time to start over from scratch, this time write your own MP routines