« previous next »
Pages: [1]   Go Down

Author Topic: print _Float  (Read 3935 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
print _Float
« on: September 22, 2021, 01:34:40 pm »
QB64 print statement converts _Float to double so the range and precision of the output is that of double
libqb.cpp
Code: C: [Select]
  1. qbs *qbs_str(long double value){
  2.     //not fully implemented
  3.     return qbs_str((double)value);
  4. }
  5.  
here's QB64 code to help with that
Code: QB64: [Select]
  3.     Sub snprintf (Dest As String, Byval l As Long, frmt As String, Byval x As Double)
  5.  
  7.  
  8. x = 3.1415926535897932384626433832795F314
  9. Print strf(x)
  10. x = -x
  11. Print strf(x)
  12.  
  13. Function strf$ (x As _Float)
  14.     Dim As String s
  15.     Dim As String frmt
  16.     Dim As Long ex
  17.     s = Spc(64)
  18.     frmt = "%.19Lg" + Chr$(0)
  19.     Call snprintf(s, Len(s), frmt, x)
  20.     s = _Trim$(s)
  21.     ex = InStr(s, "e")
  22.     If ex > 0 Then Mid$(s, ex, 1) = "F"
  23.     If Left$(s, 1) <> "-" Then s = " " + s
  24.     strf = s
  26.  
I thought about editing qbs_str but the cpp code looks too complicated
Logged

FellippeHeitor

  • Guest
Re: print _Float
« Reply #1 on: September 22, 2021, 01:49:23 pm »
It's already a known/open issue in the repository: https://github.com/QB64Team/qb64/issues/169

Thanks for reporting.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: print _Float
« Reply #2 on: September 22, 2021, 06:00:49 pm »
You guys better grab my string math routine before I slap a million dollar price tag on it.

Pete

And I'm better looking than Bill Gates, too. But then again, so is everyone.
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: print _Float
« Reply #3 on: September 22, 2021, 07:47:42 pm »
@Pete where's the link to your string math routines ?
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: print _Float
« Reply #4 on: September 22, 2021, 09:15:13 pm »
https://www.tapatalk.com/groups/qbasic/viewtopic.php?p=212679#p212679

I think I also posted a testing version in this thread: https://www.qb64.org/forum/index.php?topic=1093.msg104230#msg104230

It was fun, but I doubt I will do much work on it in the future, to expand it to other math functions, square roots, logs etc. I should probably paste the version I have on my Win 10 into a Programs thread here.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: print _Float
« Reply #5 on: September 23, 2021, 12:44:28 am »
thanks Pete, yes post the code you have now it's possible that it's tweaked for better performance
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: print _Float
« Reply #6 on: September 23, 2021, 02:19:36 pm »
I think this was what I finished on...

Code: QB64: [Select]
  2. INPUT "Limit Display: "; limit&&
  3. LINE INPUT "Use Rounding? Y/N: "; ans$
  4. IF UCASE$(ans$) = "Y" THEN
  5.     round_total% = -1
  6.     LINE INPUT "Show if Rounded? Y/N: "; ans$
  7.     IF UCASE$(ans$) = "Y" THEN show_rounding% = -1 ELSE show_rounding% = 0
  9.     round_total% = 0
  11. LINE INPUT "Display in Scientific Notation? Y/N: "; ans$
  12. IF UCASE$(ans$) = "Y" THEN
  13.     snconvert% = -1
  15.     snconvert% = 0
  16.     LINE INPUT "Display in Dollars and Cents? Y/N: "; ans$
  17.     IF UCASE$(ans$) = "Y" THEN currency_display% = -1 ELSE currency_display% = 0
  18.     LINE INPUT "Display Results with Commas? Y/N: "; ans$
  20. IF UCASE$(ans$) = "Y" THEN comma_display% = -1 ELSE comma_display% = 0
  22.     DO
  23.         LINE INPUT "Number: "; stringmathb$
  24.         IF UCASE$(stringmathb$) = "C" THEN RUN
  25.         origb$ = stringmathb$
  26.         CALL stringmath(stringmatha$, operator$, stringmathb$, runningtotal$, snconvert%, round_total%, show_rounding%, comma_display%, currency_display%, limit&&)
  27.         IF stringmathb$ <> "invalid number" AND stringmathb$ <> "overflow" THEN
  28.             EXIT DO
  29.         ELSE
  30.             PRINT stringmathb$
  31.         END IF
  32.     LOOP
  33.     IF operator$ <> "" THEN
  34.         DO UNTIL INSTR(origa$, ",") = 0
  35.             origa$ = MID$(origa$, 1, INSTR(origa$, ",") - 1) + MID$(origa$, INSTR(origa$, ",") + 1)
  36.         LOOP
  37.         DO UNTIL INSTR(origb$, ",") = 0
  38.             origb$ = MID$(origb$, 1, INSTR(origb$, ",") - 1) + MID$(origb$, INSTR(origb$, ",") + 1)
  39.         LOOP
  40.         IF INSTR(origb$, "$") THEN origb$ = MID$(origb$, 1, INSTR(origb$, "$") - 1) + MID$(origb$, INSTR(origb$, "$") + 1)
  41.         SELECT CASE orig_operator$
  42.             CASE "+"
  43.                 runningtotal# = VAL(origa$) + VAL(origb$)
  44.             CASE "-"
  45.                 runningtotal# = VAL(origa$) - VAL(origb$)
  46.             CASE "*"
  47.                 runningtotal# = VAL(origa$) * VAL(origb$)
  48.             CASE "/"
  49.                 runningtotal# = VAL(origa$) / VAL(origb$)
  50.             CASE "C", "c"
  51.                 RUN
  52.         END SELECT
  53.         origa$ = LTRIM$(STR$(runningtotal#))
  54.         COLOR 8, 0: PRINT "Numeric Total: "; origa$: COLOR 7, 0
  55.         PRINT "String Total:  "; runningtotal$
  56.     ELSE
  57.         origa$ = runningtotal$: IF INSTR(origa$, "$") THEN origa$ = MID$(origa$, 1, INSTR(origa$, "$") - 1) + MID$(origa$, INSTR(origa$, "$") + 1)
  58.     END IF
  59.     COLOR 2, 0: PRINT "Operator: +-/*: ";: COLOR 7, 0
  60.     DO
  61.         operator$ = INKEY$
  62.         IF LEN(operator$) THEN
  63.             IF operator$ = CHR$(27) THEN SYSTEM
  64.             IF INSTR("-+/*=8cC", operator$) THEN EXIT DO
  65.         END IF
  66.     LOOP
  67.     IF UCASE$(operator$) = "C" THEN RUN
  68.     IF operator$ = "=" THEN operator$ = "+"
  69.     IF operator$ = "8" THEN operator$ = "*"
  70.     orig_operator$ = operator$
  71.     PRINT operator$
  73.  
  74. SUB stringmath (stringmatha$, operator$, stringmathb$, runningtotal$, snconvert%, round_total%, show_rounding%, comma_display%, currency_display%, limit&&)
  75. stringmathround$ = ""
  76. IF limit&& > 2147483640 THEN limit&& = 2147483640
  77. IF limit&& = 0 THEN limit&& = 70 ' Default.
  78.  
  79. IF RIGHT$(UCASE$(runningtotal$), 1) = "R" THEN runningtotal$ = MID$(runningtotal$, 1, LEN(runningtotal$) - 1) 'Strip off rounding designation.
  80. ' Check running total. If S.N. convert to numeric for operations.
  81. IF INSTR(runningtotal$, ",") <> 0 OR INSTR(runningtotal$, "e") <> 0 THEN
  82.     holdstringmathb$ = stringmathb$
  83.     stringmathb$ = runningtotal$
  84.     IF INSTR(runningtotal$, ",") <> 0 THEN GOSUB comma_removal ELSE GOSUB scientific_to_numeric
  85.     runningtotal$ = stringmathb$: stringmathb$ = holdstringmathb$: holdstringmathb$ = ""
  87. ' Check input number. If S.N. convert to numeric for operations.
  88. IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN
  89.     GOSUB validate_string_number
  90.     IF stringmathb$ = "invalid number" THEN EXIT SUB
  91.     GOSUB scientific_to_numeric
  93.  
  94. IF runningtotal$ = "" THEN
  95.     GOSUB validate_string_number
  96.     IF stringmathb$ = "invalid number" THEN EXIT SUB
  97.  
  98.     IF LEFT$(stringmathb$, 1) = "-" THEN
  99.         stringmathb$ = MID$(stringmathb$, 2)
  100.         n2sign$ = "-"
  101.     ELSE
  102.         n2sign$ = ""
  103.     END IF
  104.     GOSUB limit_round_convert
  105.     IF stringmathb$ = "overflow" THEN
  106.         n2sign$ = "": PRINT "Validated: "; stringmathb$: EXIT SUB
  107.     END IF
  108.     runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
  109.     IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
  110.     PRINT "Validated: "; runningtotal$
  111.     IF INSTR(LCASE$(stringmathb$), "e") <> 0 THEN BEEP: GOSUB scientific_to_numeric
  113.     GOSUB validate_string_number
  114.     PRINT "Validated: "; stringmathb$
  115.     IF stringmathb$ = "invalid number" THEN EXIT SUB
  116.     IF INSTR(UCASE$(stringmathb$), "e") <> 0 THEN GOSUB scientific_to_numeric
  118. IF runningtotal$ <> "" THEN stringmatha$ = runningtotal$
  119.  
  120. SELECT CASE operator$
  121.     CASE "+", "-"
  122.         string_add_subtract:
  123.         IF INSTR(stringmatha$, ".") <> 0 THEN ' Evaluate sum for decimal fraction.
  124.             sumplace& = LEN(stringmatha$) - INSTR(stringmatha$, ".")
  125.             stringmatha$ = MID$(stringmatha$, 1, INSTR(stringmatha$, ".") - 1) + MID$(stringmatha$, INSTR(stringmatha$, ".") + 1) ' Strip out decimal
  126.         END IF
  127.         IF INSTR(stringmathb$, ".") <> 0 THEN ' Evaluate number for decimal fraction.
  128.             numplace& = LEN(stringmathb$) - INSTR(stringmathb$, ".")
  129.             stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Strip out decimal
  130.         END IF
  131.         IF sumplace& > numplace& THEN addsubplace& = sumplace& ELSE addsubplace& = numplace&
  132.         IF sumplace& > addsubplace& THEN
  133.             stringmatha$ = stringmatha$ + STRING$(sumplace& - addsubplace&, "0")
  134.         ELSEIF addsubplace& > sumplace& THEN
  135.             stringmatha$ = stringmatha$ + STRING$(addsubplace& - sumplace&, "0")
  136.         END IF
  137.         IF numplace& > addsubplace& THEN
  138.             stringmathb$ = stringmathb$ + STRING$(numplace& - addsubplace&, "0")
  139.         ELSEIF addsubplace& > numplace& THEN
  140.             stringmathb$ = stringmathb$ + STRING$(addsubplace& - numplace&, "0")
  141.         END IF ' END Decimal evaluations.
  142.  
  143.         IF LEFT$(stringmatha$, 1) = "-" THEN sign_input$ = "-" ELSE sign_input$ = "+"
  144.         IF LEFT$(stringmathb$, 1) = "-" THEN sign_total$ = "-" ELSE sign_total$ = "+"
  145.  
  146.         addsubsign% = 0
  147.         SELECT CASE sign_input$ + operator$ + sign_total$
  148.             CASE "+++", "+--"
  149.                 operator$ = "+"
  150.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  151.             CASE "++-", "+-+"
  152.                 operator$ = "-"
  153.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  154.                 IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$: addsubsign% = -1
  155.             CASE "---", "-++"
  156.                 operator$ = "-"
  157.                 IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
  158.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  159.                 IF VAL(stringmathb$) > VAL(stringmatha$) THEN SWAP stringmatha$, stringmathb$ ELSE addsubsign% = -1
  160.             CASE "--+", "-+-"
  161.                 operator$ = "+"
  162.                 IF LEFT$(stringmatha$, 1) = "-" THEN stringmatha$ = MID$(stringmatha$, 2)
  163.                 IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  164.                 addsubsign% = -1
  165.         END SELECT
  166.  
  167.         IF LEN(stringmatha$) > LEN(stringmathb$) THEN
  168.             stringmathb$ = STRING$(LEN(stringmatha$) - LEN(stringmathb$), "0") + stringmathb$
  169.         ELSEIF LEN(stringmatha$) < LEN(stringmathb$) THEN
  170.             stringmatha$ = STRING$(LEN(stringmathb$) - LEN(stringmatha$), "0") + stringmatha$
  171.         END IF
  172.         addsubx1$ = ""
  173.  
  174.         SELECT CASE operator$
  175.             CASE "+", "="
  176.                 FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
  177.                     addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) + VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
  178.                     IF addsubx1% > 9 THEN addsubx1% = addsubx1% - 10: addsubcarry% = 1 ELSE addsubcarry% = 0
  179.                     addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
  180.                 NEXT
  181.                 IF addsubcarry% THEN addsubx1$ = "1" + addsubx1$: addsubcarry% = 0
  182.                 GOSUB replace_decimal
  183.             CASE "-"
  184.                 FOR addsubii& = LEN(stringmatha$) TO 1 STEP -1
  185.                     addsubx1% = VAL(MID$(stringmatha$, addsubii&, 1)) - VAL(MID$(stringmathb$, addsubii&, 1)) + addsubcarry%
  186.                     IF addsubx1% < 0 THEN addsubx1% = addsubx1% + 10: addsubcarry% = -1 ELSE addsubcarry% = 0
  187.                     addsubx1$ = LTRIM$(STR$(addsubx1%)) + addsubx1$
  188.                 NEXT
  189.                 IF addsubx1$ <> "" AND addsubx1$ <> STRING$(LEN(addsubx1$), "0") THEN GOSUB replace_decimal
  190.                 DO UNTIL LEFT$(addsubx1$, 1) <> "0" ' Remove leading zeros.
  191.                     addsubx1$ = MID$(addsubx1$, 2)
  192.                 LOOP
  193.                 IF addsubx1$ = "" THEN
  194.                     addsubx1$ = "0": addsubsign% = 0
  195.                 ELSE
  196.                     IF addsubcarry% THEN addsubx1$ = "-" + addsubx1$: addsubcarry% = 0
  197.                 END IF
  198.         END SELECT
  199.  
  200.         IF addsubsign% THEN
  201.             IF LEFT$(addsubx1$, 1) = "-" THEN addsubx1$ = MID$(addsubx1$, 2) ELSE addsubx1$ = "-" + addsubx1$
  202.         END IF
  203.         stringmatha$ = addsubx1$: addsubx1$ = ""
  204.         IF operationdivision% THEN RETURN
  205.         stringmathb$ = stringmatha$: stringmatha$ = ""
  206.         IF LEFT$(stringmathb$, 1) = "-" THEN
  207.             stringmathb$ = MID$(stringmathb$, 2)
  208.             n2sign$ = "-"
  209.         ELSE
  210.             n2sign$ = ""
  211.         END IF
  212.         GOSUB limit_round_convert
  213.         IF stringmathb$ = "overflow" THEN n2sign$ = "": EXIT SUB
  214.         GOSUB sm_converter
  215.         runningtotal$ = n2sign$ + stringmathb$: n2sign$ = ""
  216.  
  217.     CASE "*"
  218.         string_multiply:
  219.         fac1$ = stringmatha$: fac2$ = stringmathb$ ' Make numbers whole numbers and remove any - sign.
  220.         IF LEFT$(fac1$, 1) = "-" THEN fac1$ = MID$(fac1$, 2): m_sign% = -1
  221.         IF LEFT$(fac2$, 1) = "-" THEN fac2$ = MID$(fac2$, 2): IF m_sign% THEN m_sign% = 0 ELSE m_sign% = -1
  222.         IF INSTR(fac1$, ".") <> 0 THEN m_decimal_places& = LEN(fac1$) - INSTR(fac1$, "."): fac1$ = MID$(fac1$, 1, INSTR(fac1$, ".") - 1) + MID$(fac1$, INSTR(fac1$, ".") + 1)
  223.         IF INSTR(fac2$, ".") <> 0 THEN m_decimal_places& = m_decimal_places& + LEN(fac2$) - INSTR(fac2$, "."): fac2$ = MID$(fac2$, 1, INSTR(fac2$, ".") - 1) + MID$(fac2$, INSTR(fac2$, ".") + 1)
  224.         FOR m_i& = LEN(fac2$) TO 1 STEP -1 ' Multiply each charter top and bottom.
  225.             m_k& = m_l&
  226.             m_x2$ = MID$(fac2$, m_i&, 1)
  227.             FOR m_j& = LEN(fac1$) TO 1 STEP -1
  228.                 m_x1$ = MID$(fac1$, m_j&, 1)
  229.                 IF m_product$ <> "" THEN
  230.                     m_add$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0")
  231.                     m_t& = 0: m_xproduct$ = "": m_carry% = 0
  232.                     DO ' Add multiplied characters together.
  233.                         m_x3$ = MID$(m_add$, LEN(m_add$) - m_t&, 1)
  234.                         m_x4$ = MID$(m_product$, LEN(m_product$) - m_t&, 1)
  235.                         IF m_x3$ = "" AND m_x4$ = "" THEN
  236.                             IF m_carry% THEN m_xproduct$ = "1" + m_xproduct$
  237.                             EXIT DO
  238.                         END IF
  239.                         m_g% = VAL(m_x3$) + VAL(m_x4$) + m_carry%
  240.                         IF m_g% >= 10 THEN m_g% = m_g% - 10: m_carry% = 1 ELSE m_carry% = 0
  241.                         m_xproduct$ = LTRIM$(STR$(m_g%)) + m_xproduct$
  242.                         m_t& = m_t& + 1
  243.                     LOOP
  244.                     m_product$ = m_xproduct$: m_xproduct$ = ""
  245.                 ELSE
  246.                     m_product$ = LTRIM$(STR$(VAL(m_x1$) * VAL(m_x2$))) + STRING$(m_k&, "0") ' First loop makes variable here.
  247.                 END IF
  248.                 m_k& = m_k& + 1 ' Adds trailing zeros multiplication
  249.             NEXT
  250.             m_l& = m_l& + 1 ' Used to reset value for m_k& adding one trailing zer for each loop.
  251.         NEXT
  252.         fac1$ = "": fac2$ = "": m_l& = 0: m_k& = 0: m_t& = 0
  253.         IF m_decimal_places& > LEN(m_product$) THEN m_product$ = STRING$(m_decimal_places& - LEN(m_product$), "0") + m_product$ ' Add any leading zeros to a decimal. Ex: .02 * .01 is factored as 002. It needs one leading zero before adding the decimal point, .0002.
  254.         IF m_decimal_places& AND m_product$ <> "0" THEN ' Replace any decimal point.
  255.             m_product$ = MID$(m_product$, 1, LEN(m_product$) - m_decimal_places&) + "." + MID$(m_product$, LEN(m_product$) - m_decimal_places& + 1)
  256.         END IF
  257.         DO UNTIL LEFT$(m_product$, 1) <> "0" ' Remove leading zeros.
  258.             m_product$ = MID$(m_product$, 2)
  259.         LOOP
  260.         IF m_decimal_places& THEN
  261.             DO UNTIL RIGHT$(m_product$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
  262.                 m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1)
  263.             LOOP
  264.         END IF
  265.         IF m_product$ = "" THEN m_product$ = "0": m_sign% = 0
  266.         IF RIGHT$(m_product$, 1) = "." THEN m_product$ = MID$(m_product$, 1, LEN(m_product$) - 1) ' Remove decimal from the end of an integer total.
  267.         IF operationdivision% THEN m_sign% = 0: RETURN
  268.         stringmathb$ = m_product$: m_product$ = "": GOSUB limit_round_convert
  269.         IF stringmathb$ = "overflow" THEN EXIT SUB
  270.         GOSUB sm_converter
  271.         runningtotal$ = stringmathb$: stringmathb$ = ""
  272.         IF m_sign% THEN runningtotal$ = "-" + runningtotal$: m_sign% = 0
  273.  
  274.     CASE "/"
  275.         operationdivision% = -1
  276.         divbuffer& = LEN(stringmathb$) - LEN(stringmatha$)
  277.         IF divbuffer& < 0 THEN divbuffer& = 0
  278.         d2dividend$ = stringmatha$
  279.         d1divisor$ = stringmathb$
  280.         IF LEFT$(d1divisor$, 1) = "0" AND LEN(d1divisor$) = 1 THEN PRINT "Division by zero not allowed.": END
  281.         IF LEFT$(d1divisor$, 1) = "-" THEN divsign% = -1: d1divisor$ = MID$(d1divisor$, 2)
  282.         IF LEFT$(d2dividend$, 1) = "-" THEN
  283.             IF divsign% THEN
  284.                 divsign% = 0
  285.             ELSE
  286.                 divsign% = -1
  287.             END IF
  288.             d2dividend$ = MID$(d2dividend$, 2)
  289.         END IF
  290.         IF INSTR(d1divisor$, ".") <> 0 THEN
  291.             DO UNTIL RIGHT$(d1divisor$, 1) <> "0"
  292.                 d1divisor$ = MID$(d1divisor$, 1, LEN(d1divisor$) - 1) ' Strip off trailing zeros
  293.             LOOP
  294.             divplace& = LEN(d1divisor$) - INSTR(d1divisor$, ".")
  295.             d1divisor$ = MID$(d1divisor$, 1, INSTR(d1divisor$, ".") - 1) + MID$(d1divisor$, INSTR(d1divisor$, ".") + 1) ' Strip off decimal point.
  296.             DO UNTIL LEFT$(d1divisor$, 1) <> "0"
  297.                 d1divisor$ = MID$(d1divisor$, 2) ' Strip off leading zeros for divisors smaller than .1
  298.             LOOP
  299.         END IF
  300.  
  301.         IF INSTR(d2dividend$, ".") <> 0 THEN
  302.             d2dividend$ = d2dividend$ + STRING$(divplace& - LEN(d2dividend$) - INSTR(d2dividend$, "."), "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
  303.             divplace2& = INSTR(d2dividend$, ".")
  304.             DO UNTIL RIGHT$(d2dividend$, 1) <> "0"
  305.                 d2dividend$ = MID$(d2dividend$, 1, LEN(d2dividend$) - 1) ' Strip off trailing zeros
  306.             LOOP
  307.             d2dividend$ = MID$(d2dividend$, 1, INSTR(d2dividend$, ".") - 1) + MID$(d2dividend$, INSTR(d2dividend$, ".") + 1) ' Strip off decimal point.
  308.         ELSE
  309.             d2dividend$ = d2dividend$ + STRING$(divplace&, "0") ' Add any zeros based on the length of dividend at decimal - length of divisor at decimal. If less than zero, nothing added.
  310.             divplace& = 0
  311.         END IF
  312.         DO
  313.             DO
  314.                 divremainder& = divremainder& + 1: divremainder$ = divremainder$ + MID$(d2dividend$, divremainder&, 1)
  315.                 IF MID$(d2dividend$, divremainder&, 1) = "" THEN
  316.                     IF divremainder$ = STRING$(LEN(divremainder$), "0") AND LEN(quotient$) > LEN(d2dividend$) THEN divflag% = -1: EXIT DO
  317.                     divcarry& = divcarry& + 1
  318.                     IF divcarry& = 1 THEN divplace3& = divremainder& - 1
  319.                     IF divcarry& > limit&& + 1 + divbuffer& THEN
  320.                         divflag% = -2: EXIT DO
  321.                     END IF
  322.                     divremainder$ = divremainder$ + "0" ' No more digits to bring down.
  323.                 END IF
  324.                 IF LEN(divremainder$) > LEN(d1divisor$) OR LEN(divremainder$) = LEN(d1divisor$) AND divremainder$ >= d1divisor$ THEN EXIT DO
  325.                 quotient$ = quotient$ + "0"
  326.             LOOP
  327.             IF divflag% THEN divflag% = 0: EXIT DO
  328.             FOR div_i% = 9 TO 1 STEP -1
  329.                 stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
  330.                 m_product$ = "": GOSUB string_multiply
  331.                 tempcutd$ = divremainder$ ' divremainder$ can be 00 or other leading zero values.
  332.                 DO
  333.                     IF LEN(tempcutd$) = 1 THEN EXIT DO
  334.                     IF LEFT$(tempcutd$, 1) = "0" THEN
  335.                         tempcutd$ = MID$(tempcutd$, 2)
  336.                     ELSE
  337.                         EXIT DO
  338.                     END IF
  339.                 LOOP
  340.                 IF LEN(tempcutd$) > LEN(m_product$) OR LEN(tempcutd$) = LEN(m_product$) AND m_product$ <= tempcutd$ THEN EXIT FOR
  341.             NEXT
  342.             quotient$ = quotient$ + LTRIM$(STR$(div_i%))
  343.             stringmatha$ = LTRIM$(STR$(div_i%)): stringmathb$ = d1divisor$
  344.             m_product$ = "": GOSUB string_multiply
  345.             operator$ = "-"
  346.             stringmatha$ = divremainder$
  347.             stringmathb$ = m_product$
  348.             GOSUB string_add_subtract
  349.             divremainder$ = stringmatha$
  350.             operator$ = "/"
  351.         LOOP
  352.         IF divplace& = 0 AND divplace2& = 0 THEN divplace& = divplace3&
  353.         IF divplace2& THEN divplace& = divplace& + divplace2& - 1
  354.         IF quotient$ = "" THEN divplace& = 0 ' dividend is zero.
  355.         IF divplace& OR divplace2& THEN
  356.             quotient$ = MID$(quotient$, 1, divplace&) + "." + MID$(quotient$, divplace& + 1)
  357.             DO UNTIL RIGHT$(quotient$, 1) <> "0"
  358.                 quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off trailing zeros
  359.             LOOP
  360.             IF RIGHT$(quotient$, 1) = "." THEN quotient$ = MID$(quotient$, 1, LEN(quotient$) - 1) ' Strip off abandoned decimal.
  361.         END IF
  362.         DO UNTIL LEFT$(quotient$, 1) <> "0"
  363.             quotient$ = MID$(quotient$, 2) ' Strip off leading zeros
  364.         LOOP
  365.         IF quotient$ = "" THEN quotient$ = "0": divsign% = 0
  366.         operationdivision% = 0
  367.         stringmathb$ = quotient$: quotient$ = "": GOSUB limit_round_convert
  368.         IF stringmathb$ = "overflow" THEN divsign% = 0: EXIT SUB
  369.         GOSUB sm_converter
  370.         runningtotal$ = stringmathb$: stringmathb$ = ""
  371.         IF divsign% THEN runningtotal$ = "-" + runningtotal$
  373. IF stringmathround$ <> "" THEN runningtotal$ = runningtotal$ + stringmathround$
  375.  
  376. validate_string_number:
  377. vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
  378. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
  379. IF LEFT$(stringmathb$, 1) = "+" THEN IF sm_sign$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 2) ELSE stringmathb$ = "invalid number": RETURN
  380. IF INSTR(UCASE$(stringmathb$), "D") OR INSTR(UCASE$(stringmathb$), "E") THEN ' Evaluate for Scientific Notation.
  381.     FOR sm_i& = 1 TO LEN(stringmathb$)
  382.         validatenum$ = MID$(UCASE$(stringmathb$), sm_i&, 1)
  383.         SELECT CASE validatenum$
  384.             CASE "+"
  385.                 IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  386.             CASE "-"
  387.                 IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE stringmathb$ = "invalid number": RETURN
  388.             CASE "0" TO "9"
  389.                 vsn_numberpresent& = -1
  390.             CASE "D", "E"
  391.                 vsn_depresent& = vsn_depresent& + 1
  392.                 IF decimalcnt& = 0 AND sm_i& <> 2 OR vsn_depresent& > 1 OR vsn_numberpresent& = 0 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& = 1 AND vsn_poscnt& >= 1 THEN vsn_numberpresent& = 0: EXIT FOR
  393.                 vsn_numberpresent& = 0
  394.                 MID$(stringmathb$, sm_i&, 1) = "e" ' Standardize
  395.             CASE "."
  396.                 decimalcnt& = decimalcnt& + 1
  397.                 IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
  398.             CASE ELSE
  399.                 vsn_numberpresent& = 0: EXIT FOR
  400.         END SELECT
  401.     NEXT
  402.     IF decimalcnt& = 0 THEN stringmathb$ = MID$(stringmathb$, 1, 1) + "." + MID$(stringmathb$, 2) ' Standardize "."
  403.     IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(stringmathb$, ".") <> 2 THEN stringmathb$ = "invalid number": RETURN
  404.     vsn_depresent& = INSTR(stringmathb$, "e")
  405.     sm_x$ = MID$(stringmathb$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
  406.     IF sm_x$ <> "+" AND sm_x$ <> "-" THEN stringmathb$ = MID$(stringmathb$, 1, vsn_depresent&) + "+" + MID$(stringmathb$, vsn_depresent& + 1)
  407.     IF MID$(stringmathb$, vsn_depresent& + 2, 1) = "0" THEN
  408.         IF MID$(stringmathb$, vsn_depresent& + 3, 1) <> "" THEN stringmathb$ = "invalid number": RETURN ' No leading zeros allowed in exponent notation.
  409.     END IF
  410.     jjed& = INSTR(stringmathb$, "e") ' Get position of notation.
  411.     valexpside$ = MID$(stringmathb$, jjed&) ' These two lines break up into number and notation
  412.     stringmathb$ = MID$(stringmathb$, 1, jjed& - 1) ' stringmathb$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
  413.     DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
  414.         stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  415.     LOOP
  416.     IF VAL(MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1)) = 0 THEN
  417.         IF RIGHT$(stringmathb$, 1) = "." THEN
  418.             stringmathb$ = "0.e+0" ' Handles all types of zero entries.
  419.         ELSE
  420.             stringmathb$ = "invalid number": RETURN
  421.         END IF
  422.         RETURN
  423.     END IF
  424.     stringmathb$ = sm_sign$ + stringmathb$ + valexpside$
  425.     RETURN
  427.     FOR sm_i& = 1 TO LEN(stringmathb$)
  428.         validatenum$ = MID$(stringmathb$, sm_i&, 1)
  429.         SELECT CASE validatenum$
  430.             CASE "."
  431.                 decimalcnt& = decimalcnt& + 1
  432.             CASE "0"
  433.                 vsn_zerospresent& = -1
  434.             CASE "1" TO "9"
  435.                 vsn_numberpresent& = -1
  436.             CASE "$"
  437.             CASE ELSE
  438.                 stringmathb$ = "invalid number": RETURN
  439.         END SELECT
  440.     NEXT
  441.     IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
  442.         stringmathb$ = "invalid number": RETURN
  443.     END IF
  444.     IF INSTR(stringmathb$, "$") THEN GOSUB currency_validate
  445.     IF INSTR(stringmathb$, ",") THEN
  446.         GOSUB comma_validation
  447.         IF stringmathb$ = "invalid number" THEN RETURN
  448.         GOSUB comma_removal
  449.     END IF
  450.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  451.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Strip off any leading zeros.
  452.         stringmathb$ = MID$(stringmathb$, 2)
  453.     LOOP
  454.     stringmathb$ = sm_sign$ + stringmathb$
  455.     IF INSTR(stringmathb$, ".") THEN
  456.         DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
  457.             stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  458.         LOOP
  459.     END IF
  460.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  461.     IF vsn_numberpresent& = 0 THEN
  462.         IF vsn_zerospresent& THEN
  463.             stringmathb$ = "0"
  464.         ELSE
  465.             stringmathb$ = "invalid number"
  466.         END IF
  467.     END IF
  470.  
  471. ' Convert to commas, currency, S.N., etc.
  472. sm_converter:
  473. IF comma_display% THEN GOSUB comma_placement
  474. IF currency_display% THEN GOSUB currency_convert
  475. IF snconvert% THEN GOSUB numeric_to_scientific
  477.  
  478. ' Add in commas.
  479. comma_placement:
  480. GOSUB comma_prep
  481. sm_i& = 0: sm_j& = 0: sm_seed& = 0
  482. sm_seed& = LEN(temp_stringmathb1$) MOD 3: IF sm_seed& = 0 THEN sm_seed& = 3
  483. sm_m1& = LEN(temp_stringmathb1$)
  484. sm_m2& = (LEN(temp_stringmathb1$) - 1) \ 3
  485. sm_replace$ = SPACE$(sm_m1& + sm_m2&)
  486. DO WHILE sm_i& < sm_m1&
  487.     MID$(sm_replace$, sm_j& + 1, sm_seed& + 1) = MID$(temp_stringmathb1$, sm_i& + 1, sm_seed&) + ","
  488.     sm_i& = sm_i& + sm_seed&: sm_j& = sm_j& + sm_seed& + 1: sm_seed& = 3
  490. sm_replace$ = RTRIM$(sm_replace$)
  491. IF RIGHT$(sm_replace$, 1) = "," THEN
  492.     stringmathb$ = MID$(sm_replace$, 1, LEN(sm_replace$) - 1)
  494.     stringmathb$ = sm_replace$
  496. sm_replace$ = "": temp_stringmathb1$ = ""
  498.  
  499. ' Validate comma entry.
  500. comma_validation:
  501. GOSUB comma_prep
  502. IF INSTR(temp_stringmathb2$, ",") <> 0 OR temp_stringmathb1$ = STRING$(LEN(temp_stringmathb1$), ",") THEN
  503.     stringmathb$ = "invalid number" ' Decimal part has comma or entry is all commas.
  505.     FOR sm_i& = LEN(temp_stringmathb1$) TO 1 STEP -1
  506.         sm_j% = sm_j% + 1
  507.         IF sm_j% = 4 THEN
  508.             IF MID$(temp_stringmathb1$, sm_i&, 1) <> "," THEN stringmathb$ = "invalid number": EXIT FOR
  509.             sm_j% = 0
  510.         END IF
  511.     NEXT
  512.     IF stringmathb$ <> "invalid number" THEN
  513.         stringmathb$ = sm_sign$ + temp_stringmathb1$ + temp_stringmathb2$
  514.     END IF
  516. temp_stringmathb1$ = "": temp_stringmathb2$ = "": sm_i& = 0: sm_j% = 0: sm_sign$ = "": sm_dollar$ = ""
  518.  
  519. comma_removal:
  520. sm_i& = 0: sm_j& = 0: sm_seed& = 0
  521. sm_replace$ = SPACE$(LEN(stringmathb$))
  523.     sm_i& = INSTR(sm_seed& + 1, stringmathb$, ",")
  524.     IF sm_i& = 0 THEN EXIT DO
  525.     MID$(sm_replace$, sm_j& + 1, sm_i& - sm_seed& + 1) = MID$(stringmathb$, sm_seed& + 1, sm_i& - sm_seed& - 1)
  526.     sm_j& = sm_j& + sm_i& - sm_seed& - 1
  527.     sm_seed& = sm_i&
  529. stringmathb$ = RTRIM$(sm_replace$) + MID$(stringmathb$, sm_seed& + 1): sm_replace$ = ""
  531.  
  532. comma_prep:
  533. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): sm_sign$ = "-"
  534. temp_stringmathb1$ = stringmathb$: stringmathb$ = ""
  535. IF INSTR(temp_stringmathb1$, ".") THEN
  536.     temp_stringmathb2$ = MID$(temp_stringmathb1$, INSTR(temp_stringmathb1$, ".")) ' Decimal part
  537.     temp_stringmathb1$ = MID$(temp_stringmathb1$, 1, INSTR(temp_stringmathb1$, ".") - 1) ' Non-decimal part
  539. IF LEFT$(temp_stringmathb1$, 1) = "$" THEN temp_stringmathb1$ = MID$(temp_stringmathb1$, 2): sm_dollar$ = "$"
  541.  
  542. currency_validate:
  543. IF LEFT$(stringmathb$, 2) = "$-" OR LEFT$(stringmathb$, 2) = "$+" THEN stringmathb$ = "invalid number": RETURN
  544. IF LEFT$(stringmathb$, 1) = "$" THEN stringmathb$ = MID$(stringmathb$, 2)
  545. IF INSTR(stringmathb$, "$") THEN stringmathb$ = "invalid number": RETURN
  546. sm_dollar$ = "$"
  548.  
  549. currency_convert:
  550. IF INSTR(UCASE$(stringmathb$), "D") <> 0 OR INSTR(UCASE$(stringmathb$), "E") <> 0 THEN GOSUB scientific_to_numeric
  551. IF INSTR(stringmathb$, ",") = 0 THEN GOSUB comma_placement
  552. IF INSTR(stringmathb$, ".") = 0 THEN stringmathb$ = stringmathb$ + ".00"
  553. IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = stringmathb$ + "00"
  554. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = stringmathb$ + "0"
  555. IF MID$(stringmathb$, LEN(stringmathb$) - 2, 1) <> "." THEN stringmathb$ = "invalid number": RETURN
  556. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2)
  557. stringmathb$ = sm_sign$ + "$" + stringmathb$
  559.  
  560. numeric_to_scientific:
  561. IF LEFT$(stringmathb$, 1) = "-" THEN stringmathb$ = MID$(stringmathb$, 2): n2sign$ = "-"
  562. IF INSTR(stringmathb$, ".") = 0 THEN exponentvalue&& = LEN(stringmathb$) - 1 ELSE exponentvalue&& = INSTR(stringmathb$, ".") - 2 ' Exponent is one less than number of digits for whole number an two less than the placement of the decimal point for a fraction.
  563. stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1)
  564. IF LEFT$(stringmathb$, 1) = "0" AND LEN(stringmathb$) > 1 OR exponentvalue&& = -1 THEN
  565.     DO UNTIL LEFT$(stringmathb$, 1) <> "0" ' Remove leading zeros to consider rounding.
  566.         stringmathb$ = MID$(stringmathb$, 2)
  567.         exponentvalue&& = exponentvalue&& - 1
  568.     LOOP
  569.     esign$ = "-"
  571.     esign$ = "+"
  573. DO UNTIL RIGHT$(stringmathb$, 1) <> "0" ' Remove trailing zeros.
  574.     stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  576. IF stringmathb$ = "" THEN stringmathb$ = "0": esign$ = "+": exponentvalue&& = 0
  577. stringmathb$ = LEFT$(stringmathb$, 1) + "." + MID$(stringmathb$, 2)
  578. IF stringmathb$ = "0." THEN n2sign$ = "": esign$ = "+"
  579. stringmathb$ = stringmathb$ + "e" + esign$ + LTRIM$(STR$(ABS(exponentvalue&&))) ' S.N formed here.
  580. IF stringmathb$ <> "overflow" THEN
  581.     stringmathb$ = n2sign$ + stringmathb$
  583. n2sign$ = "": esign$ = "": exponentvalue&& = 0
  585.  
  586. scientific_to_numeric:
  587. IF INSTR(UCASE$(stringmathb$), "D") THEN MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "D"), 1) = "e"
  588. IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 2) = "0" THEN ' The numeric value is the number without the zero exponent.
  589.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, "e") - 1)
  590.     IF RIGHT$(stringmathb$, 1) = "." THEN stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  591.     RETURN
  593.     IF LEFT$(stringmathb$, 1) = "-" THEN stn_sign$ = "-": stringmathb$ = MID$(stringmathb$, 2)
  594.     stringmathb$ = MID$(stringmathb$, 1, INSTR(stringmathb$, ".") - 1) + MID$(stringmathb$, INSTR(stringmathb$, ".") + 1) ' Remove decimal point.
  595.     stn_i& = INSTR(stringmathb$, "e") - 1 ' Length of the numric part.
  596.     IF MID$(stringmathb$, INSTR(stringmathb$, "e") + 1, 1) = "-" THEN
  597.         stringmathb$ = "." + STRING$(VAL(MID$(stringmathb$, stn_i& + 3)) - 1, "0") + MID$(stringmathb$, 1, stn_i&) ' Decimal point followed by exponent value in zeros added in front of numeric part.
  598.     ELSE
  599.         IF stn_i& - 1 > VAL(MID$(stringmathb$, stn_i& + 3)) THEN stn_point$ = "." ' - 1 for decimal place. Ex 2.034d+2 is 2034 here where 3 places to the right . could be moved before . disappears. > so no trailing decimal results.
  600.         stringmathb$ = MID$(MID$(stringmathb$, 1, stn_i&), 1, VAL(MID$(stringmathb$, stn_i& + 3)) + 1) + stn_point$ + MID$(MID$(stringmathb$, 1, stn_i&), VAL(MID$(stringmathb$, stn_i& + 3)) + 2, stn_i& - VAL(MID$(stringmathb$, stn_i& + 3)) - 1) + STRING$(VAL(MID$(stringmathb$, stn_i& + 2)) - (stn_i& - 1), "0")
  601.     END IF
  603. IF stringmathb$ = "0" THEN stn_sign$ = ""
  604. stringmathb$ = stn_sign$ + stringmathb$
  605. stn_sign$ = "": stn_point$ = ""
  607.  
  608. limit_round_convert:
  609. ' Try SN if whole number is too large (as it may be trailing zeros) or decimal is beyond limit.
  610. IF LEFT$(stringmathb$, 2) = ".0" AND LEN(stringmathb$) > limit&& + 1 OR INSTR(stringmathb$, ".") > limit&& + 1 OR INSTR(stringmathb$, ".") = 0 AND LEN(stringmathb$) > limit&& THEN
  611.     IF limit&& > 1 THEN
  612.         GOSUB numeric_to_scientific ' Retry as S.N.
  613.         IF LEN(stringmathb$) > limit&& + 3 THEN ' Needs rounding.
  614.             snotation$ = MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "E"))
  615.             exponentvalue&& = VAL(MID$(snotation$, 2)) ' Get positive or negative sign.
  616.             snexponent$ = MID$(stringmathb$, INSTR(UCASE$(stringmathb$), "E") + 2)
  617.             stringmathb$ = MID$(stringmathb$, 1, INSTR(UCASE$(stringmathb$), "E") - 1)
  618.             '''IF LEN(stringmathb$) + LEN(snexponent$) > limit&& + 1 AND exponentvalue&& >= limit&& THEN BEEP
  619.             IF exponentvalue&& >= limit&& THEN
  620.                 stringmathb$ = MID$(stringmathb$, 1, exponentvalue&& + 3)
  621.             ELSE
  622.                 stringmathb$ = MID$(stringmathb$, 1, limit&& - LEN(snexponent$) + 2)
  623.             END IF
  624.             GOSUB string_rounding_method
  625.             IF LEFT$(stringmathb$, 3) = "10." THEN
  626.                 stringmathb$ = "1." + MID$(stringmathb$, 4)
  627.                 ' Add one to the exponent.
  628.                 FOR round_i& = LEN(snexponent$) TO 1 STEP -1
  629.                     round_x$ = CHR$(ASC(MID$(snexponent$, round_i&, 1)) + 1)
  630.                     IF round_x$ <> CHR$(47) THEN ' Decimal point + 1. Ignore.
  631.                         IF round_x$ = CHR$(58) THEN
  632.                             MID$(snexponent$, round_i&, 1) = "0": carry$ = "1"
  633.                         ELSE
  634.                             MID$(snexponent$, round_i&, 1) = round_x$: carry$ = "": EXIT FOR
  635.                         END IF
  636.                     END IF
  637.                 NEXT
  638.                 snexponent$ = carry$ + snexponent$: carry$ = ""
  639.             END IF
  640.             stringmathb$ = stringmathb$ + MID$(snotation$, 1, 2) + snexponent$
  641.             IF LEN(snexponent$) + LEN(MID$(stringmathb$, 1, INSTR(UCASE$(stringmathb$), "E") - 1)) > limit&& + 1 THEN
  642.                 stringmathb$ = "overflow"
  643.             END IF
  644.             exponentvalue&& = 0
  645.         END IF
  646.     ELSE
  647.         IF INSTR(stringmathb$, ".") > 0 AND INSTR(stringmathb$, ".") <= limit&& THEN
  648.             stringmathb$ = MID$(stringmathb$, 1, limit&& + 2)
  649.             IF round_total% = -1 AND RIGHT$(stringmathb$, 1) > "4" THEN
  650.                 GOSUB string_rounding_method
  651.             ELSE
  652.                 stringmathb$ = MID$(stringmathb$, 1, limit&& + 1)
  653.                 IF show_rounding% THEN stringmathround$ = "r"
  654.             END IF
  655.         ELSE
  656.             stringmathb$ = "overflow"
  657.         END IF
  658.     END IF
  659.     RETURN
  661. IF LEN(stringmathb$) > limit&& AND INSTR(stringmathb$, ".") = 0 OR LEN(stringmathb$) > limit&& + 1 AND INSTR(stringmathb$, ".") <> 0 THEN
  662.     IF INSTR(stringmathb$, ".") = 0 THEN
  663.         stringmathb$ = MID$(stringmathb$, 1, limit&& + 1)
  664.     ELSE
  665.         stringmathb$ = MID$(stringmathb$, 1, limit&& + 2)
  666.     END IF
  667.     GOSUB string_rounding_method
  668.     IF LEN(stringmathb$) > limit&& + lrc_decimalpoint& THEN ' Ex: limit&& = 4 9999.9 1.e+4
  669.         GOSUB numeric_to_scientific
  670.     ELSE
  671.         IF LEN(stringmathb$) > limit&& + lrc_decimalpoint& THEN stringmathb$ = "overflow"
  672.     END IF
  675.  
  676. replace_decimal:
  677. IF addsubplace& THEN
  678.     addsubx1$ = STRING$(addsubplace& - LEN(addsubx1$), "0") + addsubx1$
  679.     addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - addsubplace&) + "." + MID$(addsubx1$, LEN(addsubx1$) - addsubplace& + 1)
  680.     DO UNTIL RIGHT$(addsubx1$, 1) <> "0" ' Remove trailing zeros in a decimal sum.
  681.         addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1)
  682.         addsubplace& = addsubplace& - 1
  683.     LOOP
  684.     IF RIGHT$(addsubx1$, 1) = "." THEN addsubx1$ = MID$(addsubx1$, 1, LEN(addsubx1$) - 1) ' Number is now an integer.
  687.  
  688. string_rounding_method:
  689. IF INSTR(stringmathb$, ".") THEN lrc_decimalpoint& = 1 ELSE lrc_decimalpoint& = 0
  690. IF MID$(stringmathb$, LEN(stringmathb$), 1) > "4" THEN
  691.     FOR round_i& = LEN(stringmathb$) - 1 TO 1 STEP -1
  692.         round_x$ = CHR$(ASC(MID$(stringmathb$, round_i&, 1)) + 1)
  693.         IF round_x$ <> CHR$(47) THEN ' Decimal point + 1. Ignore.
  694.             IF round_x$ = CHR$(58) THEN
  695.                 MID$(stringmathb$, round_i&, 1) = "0": carry$ = "1"
  696.             ELSE
  697.                 MID$(stringmathb$, round_i&, 1) = round_x$: carry$ = "": EXIT FOR
  698.             END IF
  699.         END IF
  700.     NEXT
  701.     stringmathb$ = carry$ + MID$(stringmathb$, 1, LEN(stringmathb$) - 1): carry$ = ""
  702.     IF show_rounding% THEN stringmathround$ = "R"
  704.     stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  705.     IF show_rounding% THEN stringmathround$ = "r"
  707.  
  708. IF lrc_decimalpoint& THEN
  709.     DO UNTIL RIGHT$(stringmathb$, 1) <> "0"
  710.         stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1)
  711.     LOOP
  712.     IF stringmathb$ = "" OR stringmathb$ = "." THEN stringmathb$ = "0": lrc_decimalpoint& = 0
  713.     IF RIGHT$(stringmathb$, 1) = "." AND exponentvalue&& = 0 THEN
  714.         stringmathb$ = MID$(stringmathb$, 1, LEN(stringmathb$) - 1): lrc_decimalpoint& = 0
  715.     END IF
  719.  

What I did notice is that the using comma option cuts of decimal places, unless the dollars and cents option is used, which then limits to two decimal places. Using it without showing commas in the display shows the decimal places. Looking back, I'd rather have included the decimal places with comma display. I may fiddle with that this weekend, before posting it to the programs forum.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: print _Float
« Reply #7 on: September 24, 2021, 11:54:35 am »
What's the limit&& (in the main sub call for stringmath) ? The whole display in chars or number of decimals or ???
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: print _Float
« Reply #8 on: September 24, 2021, 02:20:14 pm »
If I recall correctly, the number of characters. If zero is entered, the default is 70.

IF limit&& = 0 THEN limit&& = 70 ' Default.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

FellippeHeitor

  • Guest
Re: print _Float
« Reply #9 on: September 27, 2021, 09:30:24 am »
@Richard this is where the issue with PRINT and large numbers is being discussed.
Logged

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: print _Float
« Reply #10 on: September 27, 2021, 10:24:59 am »
for completeness as it seems there's a problem assigning a large literal to a _Float
Code: QB64: [Select]
  2.     Function snprintf& (Dest As String, Byval l As Long, frmt As String, Byval x As _Float)
  4.  
  6.     Sub atoldbl Alias _atoldbl (x As _Float, str As String)
  8.  
  9. Function valf## (s As String)
  10.     Dim As _Float x
  11.     Call atoldbl(x, s + Chr$(0))
  12.     valf## = x
  14.  
  15. Function strf$ (x As _Float)
  16.     Dim As String s
  17.     Dim As String frmt
  18.     Dim As Long l, ex, sign
  19.     sign = Sgn(x)
  20.     If sign < 0 Then x = -x
  21.     s = Spc(64)
  22.     frmt = "%.19Lg" + Chr$(0)
  23.     l = snprintf(s, Len(s), frmt, x)
  24.     s = _Trim$(s)
  25.     If InStr(s, ".") > 0 And Left$(s, 1) = "0" Then s = Mid$(s, 2)
  26.     If sign < 0 Then s = "-" + s Else s = " " + s
  27.     ex = InStr(s, "e")
  28.     If ex > 0 Then Mid$(s, ex, 1) = "F"
  29.     strf = s
  31.  
Logged
Marked as best answer by jack on September 27, 2021, 06:41:34 am

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: print _Float
« Reply #11 on: September 27, 2021, 10:41:20 am »
correction, there's no problem assigning a large literal to a _Float, Richard forgot to append ## to the literal
Code: QB64: [Select]
  2.     Function snprintf& (Dest As String, Byval l As Long, frmt As String, Byval x As _Float)
  4.  
  5. Screen _NewImage(768, 768, 32)
  7.  
  9. Locate 3, 1:
  10.  
  11. Color &HFF00FFFF~&&
  12. Locate , 1: Print "c##";
  13. Locate , 25: Print "c## + 1";
  16.  
  17. Color &HFFFF8000~&&
  18. Print "c## = ... :": Color &HFFFFFFFF~&&
  19. c## = 10##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  20. c## = 100##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  21. c## = 1000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  22. c## = 10000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  23. c## = 100000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  24. c## = 1000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  25. c## = 10000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  26. c## = 100000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  27. c## = 1000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  28. c## = 10000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  29. c## = 100000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  30. c## = 1000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  31. c## = 10000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  32. c## = 100000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  33. c## = 1000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  34. c## = 10000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  35. c## = 100000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  36. c## = 1000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  37. c## = 10000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  38. c## = 100000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  39. c## = 1000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  40. c## = 10000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  41. c## = 100000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  42. c## = 1000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  43. c## = 10000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  44. c## = 100000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  45. c## = 1000000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  46. c## = 10000000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  47. c## = 100000000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  48. c## = 1000000000000000000000000000000##: Locate , 1: Print strf(c##);: Locate , 25: Print strf(c## + 1)
  51.  
  52. Function strf$ (x As _Float)
  53.     Dim As String s
  54.     Dim As String frmt
  55.     Dim As Long l, ex, sign
  56.     sign = Sgn(x)
  57.     If sign < 0 Then x = -x
  58.     s = Spc(64)
  59.     frmt = "%.19Lg" + Chr$(0)
  60.     l = snprintf(s, Len(s), frmt, x)
  61.     s = _Trim$(s)
  62.     If InStr(s, ".") > 0 And Left$(s, 1) = "0" Then s = Mid$(s, 2)
  63.     If sign < 0 Then s = "-" + s Else s = " " + s
  64.     ex = InStr(s, "e")
  65.     If ex > 0 Then Mid$(s, ex, 1) = "F"
  66.     strf = s
  68.  
I am out of here
Logged

Offline Richard

  • Seasoned Forum Regular
  • Posts: 364
    • View Profile
Re: print _Float
« Reply #12 on: September 27, 2021, 12:02:45 pm »
@jack   Many thanks for the fix (it looks so clear now) - maybe I am pushing the _FLOAT stuff too hard and too quickly (and making silly mistakes along the way) - to me _DOUBLE stuff is way too limited (in my opinion).

-
Logged
Pages: [1]   Go Up
« previous next »