Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

Latest Threads
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155

 
  Very fast NEW division routine with string math...
Posted by: Pete - 09-11-2022, 02:19 PM - Forum: General Discussion - Replies (10)

So I tried this new improved division code I created in the pi routine Jack provided, and wow, a 700% speed improvement! That makes it 500%+ faster than that same pi routine running with Treebeard's string math.

From the pi thread, I commented about the improvements...

"Basically what I did was to shortcut zero and 1 divisors, chop out leading zeros in small decimal numbers making less digits to calculate, estimate the mult loop by using just the first one or two digits of the divisor and the dividend or remainder so it usually only takes two tries to get the right multiplier before subtracting to obtain the remainder and, of course, working with chunks of numbers with multiplication and subtraction in the long division process.

I knew it would be faster, I'm just amazed it's so much faster.

Now I'm wondering how much faster it could be if I switched from string concatenation to fixed string replacement? I did that once with a c keyboard WP routine (about the only complicated C/C++ prog I've ever written) and the speed increase was pretty impressive. Converting for string math might be a bit of a challenge, and if too many conditions need to be added, it might end up being a push."


So this code was added to that pi routine, but you can try the it out here as a divison calculator by inputting a dividend and divisor. It will validate input, but I left out my conversion of scientific notation to numerical expresion for this demo, so don't input SI.

It has a variable named: BETATEST%. Set it to ZERO to avoid all the screen notes, SLEEP between loops, and just get the results. I kept betatest% = -1 for this demo, to show the divison steps in progress.

Increase or decrease the limit&& variable to control the number of digits displayed. Note: for this demo, I did not include my rounding routie to round the last digit displayed.

So while my previous string routine was accurate for large numbers, this routine is looking to be both accurate and fast. I think it's fast enough now to be to calculate numbers with several hundreds of digits to sevreral hundreds of places almost instantaneously!

As for beta testing, that's another workhorse in the making. I will need to try some huge numbers out on n online precison calculator later. Of course if anyone spots any bugs, let me know, and I'll look into it. Maybe soon I can bump this baby up to a work in progress.

Thanks to Jack for getting me motivated to look further into this project.

Code: (Select All)
WIDTH 160, 42
_SCREENMOVE 0, 0
DIM SHARED limit&&, betatest%
limit&& = 32: betatest% = 1
DO
    LINE INPUT "Dividend: "; stringmatha$
    LINE INPUT "Divisor:  "; stringmathb$

    CALL sm(stringmatha$, stringmathb$, runningtotal$)

    IF runningtotal$ <> "invalid" THEN COLOR 14, 1: PRINT "Quotent = "; runningtotal$;: COLOR 7, 0: PRINT: PRINT "---------------------------------": PRINT
LOOP

SUB sm (stringmatha$, stringmathb$, runningtotal$)
    DIM AS _INTEGER64 a, c, aa, cc, s, ss
    validate$ = stringmatha$: GOSUB validate_string_number
    IF validate$ = "invalid number" THEN PRINT "Invalid number entry. Redo...": runningtotal$ = "invalid": EXIT SUB
    validate$ = stringmathb$: GOSUB validate_string_number
    IF validate$ = "invalid number" THEN PRINT "Invalid number entry. Redo...": runningtotal$ = "invalid": EXIT SUB
    GOSUB string_divide_new
    EXIT SUB

    string_divide_new:
    q$ = "": divisor$ = stringmathb$: dividend$ = stringmatha$
    DO ' Falx loop.
        'Strip off neg(s) and determine quotent sign.
        IF LEFT$(divisor$, 1) = "-" THEN divisor$ = MID$(divisor$, 2): q$ = "-"
        IF LEFT$(dividend$, 1) = "-" THEN dividend$ = MID$(dividend$, 2): IF q$ = "-" THEN q$ = "" ELSE q$ = "-"

        ' Quick results for divisor 1 or 0.
        IF divisor$ = "0" THEN q$ = "0": EXIT DO
        IF divisor$ = "1" THEN q$ = dividend$: EXIT DO
        IF dividend$ = "0" THEN q$ = "Division by zero not possible.": EXIT DO

        ' Determine decimal direction. -1 to left, +1 to right.
        gl% = 0: string_compare divisor$, dividend$, gl%
        IF betatest% AND gl% = 1 THEN PRINT divisor$; " > "; dividend$; " Move decimal to the left"
        IF betatest% AND gl% = 0 THEN PRINT divisor$; " = "; dividend$
        IF betatest% AND gl% = -1 THEN PRINT divisor$; " < "; dividend$; " Move deciml to the right."
        IF gl% = 1 THEN ' Divisor is larger than dividend so decimal moves to the left.
            div_decimal% = -1 ' Move decimal point to the left.
        ELSEIF gl% = -1 THEN
            div_decimal% = 1 ' Move decimal point to the right.
        ELSE
            ' Divisor and dividend are the same number.
            q$ = q$ + "1": EXIT DO
        END IF
        divisor_ratio_dividend% = gl%

        ' Strip off decimal point(s) and determine places in these next 2 routines.
        dp&& = 0: dp2&& = 0: j2&& = 0
        temp&& = INSTR(divisor$, ".")
        IF temp&& THEN
            divisor$ = MID$(divisor$, 1, temp&& - 1) + MID$(divisor$, temp&& + 1)
            IF temp&& = 1 THEN
                DO UNTIL LEFT$(divisor$, 1) <> "0" ' Strip off any leading zeros on divisor only.
                    divisor$ = MID$(divisor$, 2)
                    dp&& = dp&& + 1
                LOOP
                dp&& = dp&& + 1
            ELSE
                dp&& = -(temp&& - 2)
            END IF
        ELSE
            dp&& = -(LEN(divisor$) - 1)
        END IF
        temp&& = INSTR(dividend$, ".")
        IF temp&& THEN
            dividend$ = MID$(dividend$, 1, temp&& - 1) + MID$(dividend$, temp&& + 1)
            IF temp&& = 1 THEN
                DO UNTIL LEFT$(dividend$, 1) <> "0" ' Strip off any leading zeros on divisor only.
                    dividend$ = MID$(dividend$, 2)
                    dp2&& = dp2&& + 1
                LOOP
                dp2&& = dp2&& + 1
            ELSE
                dp2&& = -(temp&& - 2)
            END IF
        ELSE
            dp2&& = -(LEN(dividend$) - 1)
        END IF
        IF betatest% THEN COLOR 11: PRINT "Divisor decimal moves "; LTRIM$(STR$(dp&&)); ". Dividend decimal moves"; LTRIM$(STR$(dp2&&)); ". Quotent decimal ABS("; LTRIM$(STR$(dp&&)); " - "; LTRIM$(STR$(dp2&&)); ") =";: COLOR 14: PRINT ABS(dp&& - dp2&&);: COLOR 11: PRINT "+ any adjustment.": COLOR 7
        dp&& = ABS(dp&& - dp2&&)

        IF betatest% THEN PRINT "Divisor 1st# = "; MID$(divisor$, 1, 1); "  Remainder 1st# = "; MID$(dividend$, 1, 1)

        ' Adjust decimal place for instances when divisor is larger than remainder.
        IF MID$(divisor$, 1, 1) > MID$(dividend$, 1, 1) THEN
            dp&& = dp&& - div_decimal%
            IF betatest% THEN PRINT "Larger divisor, so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
        ELSEIF MID$(divisor$, 1, 1) = MID$(dividend$, 1, 1) THEN
            IF divisor_ratio_dividend% = 1 THEN
                dp&& = dp&& - div_decimal%
                IF betatest% THEN PRINT "Larger divisor, so move quotent decimal one place back to: ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
            ELSE
                IF betatest% THEN PRINT "Smaller divisor, so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
            END IF
        ELSE
            IF betatest% THEN PRINT "Smaller divisor, so no quotent decimal place adjustment needed. Quotent decimal place = ";: COLOR 14: PRINT LTRIM$(STR$(dp&&)): COLOR 7
        END IF
        origdividend$ = dividend$
        ' Determine length of divisor and dividend to begin initial long divison step.
        gl% = 2: string_compare divisor$, MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0"), gl%
        divisor_ratio_dividend% = gl%
        IF gl% = 1 AND MID$(dividend$, 1, 1) <> "0" THEN
            dividend$ = MID$(dividend$, 1, LEN(divisor$) + 1) + STRING$(LEN(divisor$) + 1 - LEN(dividend$), "0")
        ELSE
            dividend$ = MID$(dividend$, 1, LEN(divisor$)) + STRING$(LEN(divisor$) - LEN(dividend$), "0")
        END IF

        ' Long divison loop. Mult and subtraction of dividend and remainder.
        k&& = 0
        IF betatest% THEN PRINT "Begin long divison loop..."
        DO
            SELECT CASE MID$(divisor$, 1, 1)
                CASE IS < MID$(dividend$, 1, 1)
                    adj_rem_len% = 0
                CASE IS = MID$(dividend$, 1, 1)
                    gl% = 2: string_compare divisor$, MID$(dividend$, 1, LEN(divisor$)), gl%
                    IF gl% = 1 THEN adj_rem_len% = 1 ELSE adj_rem_len% = 0
                CASE IS > MID$(dividend$, 1, 1)
                    adj_rem_len% = 1
            END SELECT
            IF j2&& = 0 THEN j2&& = LEN(divisor$) + adj_rem_len%
            DO
                IF LEN(divisor$) > LEN(dividend$) THEN
                    w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
                    IF betatest% THEN PRINT: COLOR 3: PRINT "Divisor is larger so "; dividend$; " \ "; divisor$; " =";: COLOR 5: PRINT w3&&: COLOR 7
                    EXIT DO
                END IF
                IF LEN(divisor$) = LEN(dividend$) THEN
                    gl% = 2: string_compare divisor$, dividend$, gl%
                    IF gl% = 1 THEN
                        w3&& = 0: runningtotal$ = dividend$: stringmathb$ = "0"
                        IF betatest% THEN COLOR 9: PRINT "Length of divisor is the same as remainder but remainder is smaller so w3&& = ";: COLOR 5: PRINT "0": COLOR 7
                        EXIT DO
                    END IF
                END IF
                SELECT CASE LEN(dividend$)
                    CASE IS > 2
                        w3&& = VAL(MID$(dividend$, 1, 2 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 2))
                        IF betatest% THEN PRINT MID$(dividend$, 1, 2 + adj_rem_len%); " \ "; MID$(divisor$, 1, 2); " =";
                    CASE ELSE
                        w3&& = VAL(MID$(dividend$, 1, 1 + adj_rem_len%)) \ VAL(MID$(divisor$, 1, 1))
                        IF betatest% THEN PRINT MID$(dividend$, 1, 1 + adj_rem_len%); " \ "; MID$(divisor$, 1, 1); " =";
                END SELECT
                IF betatest% THEN COLOR 5: PRINT " " + LTRIM$(STR$(w3&&));: COLOR 7: PRINT ". Begin mult est. at or one above this number."
                IF w3&& < 9 THEN w3&& = w3&& + 1 ELSE IF w3&& = 10 THEN w3&& = 9
                DO
                    stringmatha$ = divisor$: stringmathb$ = LTRIM$(STR$(w3&&))
                    GOSUB string_multiply_new
                    gl% = 2: string_compare runningtotal$, dividend$, gl%
                    IF gl% <= 0 OR w3&& = 0 THEN EXIT DO
                    IF betatest% THEN COLOR 8: PRINT "Mult loop:"; w3&&; "* "; divisor$; " = "; runningtotal$: COLOR 7
                    w3&& = w3&& - 1
                LOOP
                stringmatha$ = dividend$: stringmathb$ = runningtotal$
                operator$ = "-": GOSUB string_add_subtract_new
                EXIT DO
            LOOP
            IF betatest% THEN PRINT LTRIM$(STR$(w3&&)); " * "; divisor$; " = "; stringmathb$; " | "; stringmatha$; " - "; stringmathb$; " = "; runningtotal$; " Remainder and drop-down = ";
            j2&& = j2&& + 1
            drop$ = "0": MID$(drop$, 1, 1) = MID$(origdividend$, j2&&, 1)
            IF runningtotal$ <> "0" THEN remainder$ = runningtotal$ ELSE remainder$ = ""
            dividend$ = remainder$ + drop$
            w3$ = LTRIM$(STR$(w3&&))
            temp$ = ""
            IF div_decimal% = -1 THEN
                IF dp&& AND k&& = 0 THEN
                    q$ = q$ + "." + STRING$(dp&& - 1, "0")
                    IF w3&& = 0 THEN w3$ = ""
                END IF
            END IF
            IF div_decimal% >= 0 THEN
                IF dp&& = k&& THEN
                    temp$ = "."
                END IF
            END IF
            q$ = q$ + w3$ + temp$
            IF betatest% AND remainder$ = "" THEN betatemp$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp$ = remainder$
            IF betatest% AND MID$(origdividend$, j2&&, 1) = "" THEN betatemp2$ = CHR$(34) + CHR$(34) ELSE IF betatest% THEN betatemp2$ = MID$(origdividend$, j2&&, 1)
            IF betatest% THEN PRINT dividend$; " ("; betatemp$; " +  "; drop$; ") at:"; j2&&; "of "; origdividend$; "  Loop"; k&& + 1; "Quotent = ";: COLOR 14, 4: PRINT q$;: COLOR 7, 0: PRINT: SLEEP
            ' Check to terminate
            IF div_decimal% = -1 THEN
                ' Decimal to left.
                IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" OR j2&& = limit&& THEN EXIT DO
            ELSE
                ' Decimal to right.
                IF remainder$ = "" AND MID$(origdividend$, j2&&, 1) = "" AND k&& >= dp&& OR j2&& = limit&& THEN EXIT DO
            END IF
            IF INKEY$ = " " THEN EXIT DO
            k&& = k&& + 1
        LOOP
        EXIT DO
    LOOP
    IF RIGHT$(q$, 1) = "." THEN runningtotal$ = MID$(q$, 1, LEN(q$) - 1) ELSE runningtotal$ = q$
    RETURN

    string_add_subtract_new:
    a1$ = stringmatha$: b1$ = stringmathb$
    s = 18: i&& = 0: c = 0

    a$ = stringmatha$: b$ = stringmathb$: op$ = operator$

    IF op$ = "-" THEN
        IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2) ELSE b$ = "-" + b$
    END IF

    IF INSTR(a$, ".") <> 0 OR INSTR(b$, ".") <> 0 THEN
        decimal% = -1
        IF INSTR(a$, ".") <> 0 THEN
            dec_a&& = LEN(MID$(a$, INSTR(a$, ".") + 1))
            a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)
        END IF
        IF INSTR(b$, ".") <> 0 THEN
            dec_b&& = LEN(MID$(b$, INSTR(b$, ".") + 1))
            b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1)
        END IF
        ' Line up decimal places by inserting trailing zeros.
        IF dec_b&& > dec_a&& THEN
            j&& = dec_b&&
            a$ = a$ + STRING$(dec_b&& - dec_a&&, "0")
        ELSE
            j&& = dec_a&&
            b$ = b$ + STRING$(dec_a&& - dec_b&&, "0")
        END IF
    END IF

    IF LEFT$(a$, 1) = "-" OR LEFT$(b$, 1) = "-" THEN
        IF LEFT$(a$, 1) = "-" AND LEFT$(b$, 1) = "-" THEN
            sign$ = "": a$ = MID$(a$, 2): b$ = MID$(b$, 2)
        ELSE
            IF LEFT$(a$, 1) = "-" THEN a$ = MID$(a$, 2): sign_a$ = "-"
            IF LEFT$(b$, 1) = "-" THEN b$ = MID$(b$, 2): sign_b$ = "-"

            IF LEFT$(a1$, 1) = "-" THEN a1_x$ = MID$(a1$, 2) ELSE a1_x$ = a1$
            IF LEFT$(b1$, 1) = "-" THEN b1_x$ = MID$(b1$, 2) ELSE b1_x$ = b1$

            string_compare a1_x$, b1_x$, gl%

            IF gl% < 0 THEN
                IF LEN(sign_b$) THEN sign$ = "-": SWAP a$, b$
            ELSE
                IF LEN(sign_a$) THEN sign$ = "-": SWAP sign_a$, sign_b$
            END IF
        END IF
    END IF

    z$ = ""
    ' Addition and subtraction of digits.
    DO
        i&& = i&& + s
        x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
        x2$ = MID$(b$, LEN(b$) - i&& + 1, s)
        IF LEN(x2$) > LEN(x1$) THEN SWAP x1$, x2$
        a = VAL(sign_a$ + x1$) + VAL(sign_b$ + x2$) + c
        IF x1$ + x2$ = "" AND c = 0 THEN EXIT DO
        c = 0
        IF a > VAL(STRING$(s, "9")) THEN a = a - 10 ^ s: c = 1
        IF a < 0 THEN a = a + 10 ^ s: c = -1 ' a will never be less than 0.
        tmp$ = LTRIM$(STR$(a))
        z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
    LOOP

    IF decimal% THEN
        z$ = MID$(z$, 1, LEN(z$) - j&&) + "." + MID$(z$, LEN(z$) - j&& + 1)
    END IF

    ' Remove any leading zeros.
    DO
        IF LEFT$(z$, 1) = "0" THEN z$ = MID$(z$, 2) ELSE EXIT DO
    LOOP

    IF z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = LEFT$(sign$, 1) + z$

    runningtotal$ = z$

    sign$ = "": sign_a$ = "": sign_b$ = "": i&& = 0: j&& = 0: decimal% = 0: c = 0
    RETURN

    string_multiply_new:
    z$ = "": sign$ = "": mult&& = 0: h&& = 0: i&& = 0: j&& = 0: c = 0: decimal% = 0
    zz$ = "": ii&& = 0: jj&& = 0
    s = 8: ss = 18

    a$ = stringmatha$: b$ = stringmathb$

    IF INSTR(a$, "-") <> 0 OR INSTR(b$, "-") <> 0 THEN
        IF INSTR(a$, "-") <> 0 AND INSTR(b$, "-") <> 0 THEN
            a$ = MID$(a$, 2): b$ = MID$(b$, 2)
        ELSE
            IF INSTR(a$, "-") <> 0 THEN a$ = MID$(a$, 2) ELSE b$ = MID$(b$, 2)
            sign$ = "-"
        END IF
    END IF

    IF INSTR(a$, ".") <> 0 OR INSTR(b$, ".") <> 0 THEN
        decimal% = -1
        IF INSTR(a$, ".") <> 0 THEN
            dec_a&& = LEN(MID$(a$, INSTR(a$, ".") + 1))
            a$ = MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)
        END IF
        IF INSTR(b$, ".") <> 0 THEN
            dec_b&& = LEN(MID$(b$, INSTR(b$, ".") + 1))
            b$ = MID$(b$, 1, INSTR(b$, ".") - 1) + MID$(b$, INSTR(b$, ".") + 1)
        END IF
    END IF

    IF LEN(a$) < LEN(b$) THEN SWAP a$, b$ ' Needed so x1$ is always the largest for leading zero replacements.
    ' Multiplication of digits.
    DO
        h&& = h&& + s: i&& = 0
        x2$ = MID$(b$, LEN(b$) - h&& + 1, s)
        DO
            i&& = i&& + s
            x1$ = MID$(a$, LEN(a$) - i&& + 1, s)
            a = VAL(x1$) * VAL(x2$) + c
            c = 0
            tmp$ = LTRIM$(STR$(a))
            IF LEN(tmp$) > s THEN c = VAL(MID$(tmp$, 1, LEN(tmp$) - s)): tmp$ = MID$(tmp$, LEN(tmp$) - s + 1)
            z$ = STRING$(LEN(x1$) - LEN(tmp$), "0") + tmp$ + z$
        LOOP UNTIL i&& >= LEN(a$) AND c = 0

        jj&& = jj&& + 1

        IF jj&& > 1 THEN
            ii&& = 0: cc = 0
            aa$ = holdaa$
            bb$ = z$ + STRING$((jj&& - 1) * s, "0")
            ' Addition only of digits.
            DO
                ii&& = ii&& + ss
                xx1$ = MID$(aa$, LEN(aa$) - ii&& + 1, ss)
                xx2$ = MID$(bb$, LEN(bb$) - ii&& + 1, ss)
                IF LEN(xx1$) < LEN(xx2$) THEN SWAP xx1$, xx2$
                aa = VAL(xx1$) + VAL(xx2$) + cc
                IF xx1$ + xx2$ = "" AND cc = 0 THEN EXIT DO ' Prevents leading zeros.
                cc = 0
                IF aa > VAL(STRING$(ss, "9")) THEN aa = aa - 10 ^ ss: cc = 1
                tmp$ = LTRIM$(STR$(aa))
                zz$ = STRING$(LEN(xx1$) - LEN(tmp$), "0") + tmp$ + zz$
            LOOP

            DO WHILE LEFT$(zz$, 1) = "0"
                IF LEFT$(zz$, 1) = "0" THEN zz$ = MID$(zz$, 2)
            LOOP
            IF zz$ = "" THEN zz$ = "0"

            holdaa$ = zz$
        ELSE
            holdaa$ = z$ + STRING$(jj&& - 1, "0")
        END IF

        z$ = "": zz$ = ""

    LOOP UNTIL h&& >= LEN(b$)

    z$ = holdaa$

    IF decimal% THEN
        DO UNTIL LEN(z$) >= dec_a&& + dec_b&&
            z$ = "0" + z$
        LOOP

        z$ = MID$(z$, 0, LEN(z$) - (dec_a&& + dec_b&& - 1)) + "." + MID$(z$, LEN(z$) - (dec_a&& + dec_b&&) + 1)

        DO UNTIL RIGHT$(z$, 1) <> "0" AND RIGHT$(z$, 1) <> "."
            z$ = MID$(z$, 1, LEN(z$) - 1)
        LOOP
    END IF

    IF STRING$(LEN(z$), "0") = z$ OR z$ = "" OR z$ = "0" THEN z$ = "0" ELSE z$ = sign$ + z$

    decimal% = 0: sign$ = ""

    runningtotal$ = z$
    RETURN

    validate_string_number:
    vsn_negcnt& = 0: vsn_poscnt& = 0: vsn_depresent& = 0: decimalcnt& = 0: vsn_numberpresent& = 0: vsn_zerospresent& = 0
    IF LEFT$(validate$, 1) = "-" THEN validate$ = MID$(validate$, 2): sm_sign$ = "-" ELSE sm_sign$ = ""
    IF LEFT$(validate$, 1) = "+" THEN IF sm_sign$ <> "-" THEN validate$ = MID$(validate$, 2) ELSE validate$ = "invalid number": RETURN
    IF INSTR(UCASE$(validate$), "D") OR INSTR(UCASE$(validate$), "E") THEN ' Evaluate for Scientific Notation.
        FOR sm_i& = 1 TO LEN(validate$)
            validatenum$ = MID$(UCASE$(validate$), sm_i&, 1)
            SELECT CASE validatenum$
                CASE "+"
                    IF vsn_depresent& THEN vsn_poscnt& = vsn_poscnt& + 1 ELSE validate$ = "invalid number": RETURN
                CASE "-"
                    IF vsn_depresent& THEN vsn_negcnt& = vsn_negcnt& + 1 ELSE validate$ = "invalid number": RETURN
                CASE "0" TO "9"
                    vsn_numberpresent& = -1
                CASE "D", "E"
                    vsn_depresent& = vsn_depresent& + 1
                    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
                    vsn_numberpresent& = 0
                    MID$(validate$, sm_i&, 1) = "e" ' Standardize
                CASE "."
                    decimalcnt& = decimalcnt& + 1
                    IF sm_i& <> 2 THEN vsn_numberpresent& = 0: EXIT FOR
                CASE ELSE
                    vsn_numberpresent& = 0: EXIT FOR
            END SELECT
        NEXT
        IF decimalcnt& = 0 THEN validate$ = MID$(validate$, 1, 1) + "." + MID$(validate$, 2) ' Standardize "."
        IF vsn_numberpresent& = 0 OR vsn_negcnt& = 1 AND vsn_poscnt& = 1 OR decimalcnt& > 1 OR INSTR(validate$, ".") <> 2 THEN validate$ = "invalid number": RETURN
        vsn_depresent& = INSTR(validate$, "e")
        sm_x$ = MID$(validate$, vsn_depresent& + 1, 1) ' Standardize exponent "+" these two lines.
        IF sm_x$ <> "+" AND sm_x$ <> "-" THEN validate$ = MID$(validate$, 1, vsn_depresent&) + "+" + MID$(validate$, vsn_depresent& + 1)
        IF MID$(validate$, vsn_depresent& + 2, 1) = "0" THEN
            IF MID$(validate$, vsn_depresent& + 3, 1) <> "" THEN validate$ = "invalid number": RETURN ' No leading zeros allowed in exponent notation.
        END IF
        jjed& = INSTR(validate$, "e") ' Get position of notation.
        valexpside$ = MID$(validate$, jjed&) ' These two lines break up into number and notation
        validate$ = MID$(validate$, 1, jjed& - 1) ' validate$ is +- single digit whole number, decimal point and decimal number. valexpside$ is notation, sign and exponent.
        DO UNTIL RIGHT$(validate$, 1) <> "0" ' Remove any trailing zeros for number. Example 1.0d3 or 1.0000d3, etc.
            validate$ = MID$(validate$, 1, LEN(validate$) - 1)
        LOOP
        IF VAL(MID$(validate$, 1, INSTR(validate$, ".") - 1)) = 0 THEN
            IF RIGHT$(validate$, 1) = "." THEN
                validate$ = "0.e+0" ' Handles all types of zero entries.
            ELSE
                validate$ = "invalid number": RETURN
            END IF
            RETURN
        END IF
        validate$ = sm_sign$ + validate$ + valexpside$
        RETURN
    ELSE
        FOR sm_i& = 1 TO LEN(validate$)
            validatenum$ = MID$(validate$, sm_i&, 1)
            SELECT CASE validatenum$
                CASE "."
                    decimalcnt& = decimalcnt& + 1
                CASE "0"
                    vsn_zerospresent& = -1
                CASE "1" TO "9"
                    vsn_numberpresent& = -1
                CASE "$"
                CASE ELSE
                    validate$ = "invalid number": RETURN
            END SELECT
        NEXT
        IF decimalcnt& > 1 OR vsn_negcnt& > 1 OR vsn_poscnt& > 1 OR vsn_negcnt& >= 1 AND vsn_poscnt& >= 1 THEN
            validate$ = "invalid number": RETURN
        END IF
        REM IF INSTR(validate$, "$") THEN GOSUB currency_validate
        IF INSTR(validate$, ",") THEN
            REM GOSUB comma_validation
            IF validate$ = "invalid number" THEN RETURN
            REM GOSUB comma_removal
        END IF
        IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
        DO UNTIL LEFT$(validate$, 1) <> "0" ' Strip off any leading zeros.
            validate$ = MID$(validate$, 2)
        LOOP
        validate$ = sm_sign$ + validate$
        IF INSTR(validate$, ".") THEN
            DO UNTIL RIGHT$(validate$, 1) <> "0" ' Strip off any trailing zeros in a decimal.
                validate$ = MID$(validate$, 1, LEN(validate$) - 1)
            LOOP
        END IF
        IF RIGHT$(validate$, 1) = "." THEN validate$ = MID$(validate$, 1, LEN(validate$) - 1)
        IF vsn_numberpresent& = 0 THEN
            IF vsn_zerospresent& THEN
                validate$ = "0"
            ELSE
                validate$ = "invalid number"
            END IF
        END IF
    END IF
    RETURN

END SUB

SUB string_compare (stringmatha$, stringmathb$, gl%)
    compa$ = stringmatha$: compb$ = stringmathb$ ' So original variables do not get changed.
    DO
        WHILE -1 ' Falx loop.
            IF gl% = 2 THEN EXIT WHILE ' For bypassing sign and decimal adjustments when only positive non-decimal numbers are being evaluated.
            ' Remove trailing zeros after a decimal point.
            IF INSTR(compa$, ".") THEN
                DO UNTIL RIGHT$(compa$, 1) <> "0" AND RIGHT$(compa$, 1) <> "." AND RIGHT$(compa$, 1) <> "-"
                    compa$ = MID$(compa$, 1, LEN(compa$) - 1)
                LOOP
            END IF
            IF INSTR(compb$, ".") THEN
                DO UNTIL RIGHT$(compb$, 1) <> "0" AND RIGHT$(compb$, 1) <> "." AND RIGHT$(compb$, 1) <> "-"
                    compb$ = MID$(compb$, 1, LEN(compb$) - 1)
                LOOP
            END IF

            IF MID$(compa$, 1, 2) = "-0" OR compa$ = "" OR compa$ = "-" THEN compa$ = "0"
            IF MID$(compb$, 1, 2) = "-0" OR compb$ = "" OR compb$ = "-" THEN compb$ = "0"

            ' A - and +
            IF LEFT$(compa$, 1) = "-" THEN j% = -1
            IF LEFT$(compb$, 1) = "-" THEN k% = -1
            IF k% = 0 AND j% THEN gl% = -1: EXIT DO
            IF j% = 0 AND k% THEN gl% = 1: EXIT DO

            ' A decimal and non-decimal.
            j% = INSTR(compa$, ".")
            k% = INSTR(compb$, ".")

            IF j% = 0 AND k% THEN
                IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
                EXIT DO
            END IF
            IF k% = 0 AND j% THEN
                IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
                EXIT DO
            END IF

            ' Both decimals.
            IF j% THEN
                SELECT CASE INSTR(compa$, ".")
                    CASE IS > INSTR(compb$, ".")
                        gl% = 1
                    CASE IS = INSTR(compb$, ".")
                        IF compa$ = compb$ THEN
                            gl% = 0
                        ELSEIF compa$ < compb$ THEN gl% = -1
                        ELSE
                            gl% = 1
                        END IF
                    CASE IS < INSTR(compb$, ".")
                        gl% = -1
                END SELECT
                EXIT DO
            END IF
            EXIT WHILE
        WEND

        ' Remove leading zeros if any.
        DO UNTIL LEFT$(compa$, 1) <> "0"
            compa$ = MID$(compa$, 2)
        LOOP
        IF compa$ = "" THEN compa$ = "0"
        DO UNTIL LEFT$(compb$, 1) <> "0"
            compb$ = MID$(compb$, 2)
        LOOP
        IF compb$ = "" THEN compb$ = "0"

        ' Both positive or both negative whole numbers.

        SELECT CASE LEN(compa$)
            CASE IS < LEN(compb$)
                gl% = -1
            CASE IS = LEN(compb$)
                IF compa$ = compb$ THEN
                    gl% = 0
                ELSEIF compa$ > compb$ THEN gl% = 1
                ELSEIF compa$ < compb$ THEN gl% = -1
                END IF
            CASE IS > LEN(compb$)
                gl% = 1
        END SELECT
        EXIT DO
    LOOP
END SUB

Pete

PS Here is the routine used in the pi calculations: https://staging.qb64phoenix.com/showthre...95#pid6495

Print this item

  Xor 2 Fans
Posted by: bplus - 09-11-2022, 01:50 AM - Forum: Programs - Replies (2)

Don't look at this too long.

Code: (Select All)
_Title "Xor 2 fans" 'b+ 2022-09-10 just saw at JB
' hmm... how to do this in QB64?
Screen _NewImage(800, 600, 32)
f1& = _NewImage(800, 600, 32)
f2& = _NewImage(800, 600, 32)
Color , &HFF990000
Do
    Cls
    ao1 = ao1 + .012: ao2 = ao2 - .012
    _Dest f1&
    Line (0, 0)-(799, 599), _RGB32(0, 0, 0), BF
    drawFan 300, 300, 295, 32, &HFFFFFFFF, ao1

    _Dest f2&
    Line (0, 0)-(799, 599), _RGB32(0, 0, 0), BF
    drawFan 500, 300, 295, 32, &HFFFFFFFF, ao2

    _Dest 0
    For y = 0 To 599
        For x = 0 To 799
            _Source f1&
            If Point(x, y) = _RGB32(0, 0, 0) Then p1 = 0 Else p1 = -1
            _Source f2&
            If Point(x, y) = _RGB32(0, 0, 0) Then p2 = 0 Else p2 = -1
            If p1 Xor p2 Then PSet (x, y), &HFFAAAAAA ' tone it down a bit
        Next
    Next
    _Display
    _Limit 60 'Draw as fast as you can!
Loop

Sub drawFan (x, y, r, nBlades, colr As _Unsigned Long, ao)
    angle = _Pi(1 / nBlades)
    For i = 0 To 2 * nBlades - 1 Step 2
        x1 = x + r * Cos(i * angle + ao)
        y1 = y + r * Sin(i * angle + ao)
        x2 = x + r * Cos((i + 1) * angle + ao)
        y2 = y + r * Sin((i + 1) * angle + ao)
        ftri x, y, x1, y1, x2, y2, colr
    Next
End Sub

Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim D As Long
    Static a&
    D = _Dest
    If a& = 0 Then a& = _NewImage(1, 1, 32)
    _Dest a&
    _DontBlend a& '  '<<<< new 2019-12-16 fix
    PSet (0, 0), K
    _Blend a& '<<<< new 2019-12-16 fix
    _Dest D
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub

Print this item

  Simple Random Hills Maker
Posted by: SierraKen - 09-09-2022, 08:18 PM - Forum: Programs - Replies (5)

This code can be used in adventure games or any other type of game or app. It makes random looking hills on the screen and when you press the Space Bar it makes different looking ones. I was experimenting with graphics. You can also change the PSET _RGB32 color to blue if you wish to make water waves instead. Just replace the last 0 with the c and the c with a 0.  

Code: (Select All)
'Random Hills Maker by SierraKen 9-9-2022
_Title "Random Hills Maker - Press Space Bar For Another One - Esc to quit"
Screen _NewImage(800, 600, 32)
start:
_Limit 20
Cls
Paint (10, 10), _RGB32(127, 255, 255)
c = 255
size = (Rnd * 500) + 55
For s = 50 To size Step (size / 10)
    For yy = 100 To 650
        For i = 0 To 1200
            x = Sin((i / s) * 3.1415)
            PSet (((i / 360) * 320) - 100, (x * 50) + 50 + yy), _RGB32(0, c, 0)
        Next i
        c = c - 1
        If c < 100 Then c = 255
    Next yy
Next s
Do
    a$ = InKey$
    If a$ = " " Then GoTo start:
    If a$ = Chr$(27) Then End
Loop

Print this item

  GetPhysicallyInstalledSystemMemory
Posted by: SpriggsySpriggs - 09-09-2022, 07:55 PM - Forum: Spriggsy - Replies (2)

The below snippet will show the amount of RAM your computer currently has installed.

Code: (Select All)
Option Explicit
$NoPrefix
$Console:Only

Const KILOBYTE = 1024
Const MEGABYTE = 1024 ^ 2
Const GIGABYTE = 1024 ^ 3
Const TERABYTE = 1024 ^ 4

Declare Dynamic Library "Kernel32"
    Sub GetPhysicallyInstalledSystemMemory (ByVal TotalMemoryInKilobytes As Offset)
End Declare

Dim As Unsigned Integer64 memory
GetPhysicallyInstalledSystemMemory Offset(memory)

memory = memory * KILOBYTE

Select Case memory
    Case Is < KILOBYTE
        Print Using "   ####  B"; memory
    Case Is < (MEGABYTE) And memory >= KILOBYTE
        Print Using "####.## KB"; (memory / KILOBYTE)
    Case Is < (GIGABYTE) And memory >= (MEGABYTE)
        Print Using "####.## MB"; (memory / (MEGABYTE))
    Case Is < (TERABYTE) And memory >= (GIGABYTE)
        Print Using "####.## GB"; (memory / (GIGABYTE))
End Select

Print this item

  Inform the user(s) of new releases
Posted by: doppler - 09-09-2022, 05:17 PM - Forum: Help Me! - Replies (4)

If only because I have a habit of checking for a newer version I came across 3.0, which became 3.1  I was on 0.8.2  Only today I got 3.1 almost a week after first release.

A nice feature/option to check once a week or month for a newer version and inform the user on startup.  There isn't even a check for update in the IDE.

Print this item

  size of _Float
Posted by: Jack - 09-09-2022, 02:04 PM - Forum: General Discussion - Replies (13)

the wiki says that the size of _Float is 32 bytes, is that correct? https://qb64phoenix.com/qb64wiki/index.p...able_Types
(I know that padding is needed for alignment but the size should be at most 16 bytes)

Print this item

Question How to use sprite sheets?
Posted by: 40wattstudio - 09-09-2022, 12:39 AM - Forum: Help Me! - Replies (12)

First off, greetings! Nice to see some familiar names on here after the whole QB64 nuking fiasco.

Still working on my game (Scrapship) and just recently started learning about sprite sheets.

I have a program that can create sprite sheets (Texturepacker), but now that I have a sprite sheet, I'm not sure how I would implement it in QB64/PE.
Below is little pic of the sprite sheet I currently have.


[Image: SSpic.jpg]

Has anyone done any work with sprite sheets in QB64 before or am I walking into uncharted territory?

Side note: I am not using any libraries or game engines, strictly QB64 code.

exclude duplicates

Print this item

  What am I missing here?
Posted by: TerryRitchie - 09-08-2022, 05:08 AM - Forum: Help Me! - Replies (5)

Over the past week I've been on a trigonometry quest to better understand the math needed for degree, radian, and vector math for my tutorial. The previous tutorial was lacking in this area and I'm changing that.

I've been using a routine written by Galleon back in 2009 to rotate a sprite using trig and _MAPTRIANGLE. I thought I would see if I could rewrite it using new commands that have come out since then like _HYPOT, _ATAN2, _D2R, etc..

The code below is my attempt at this, and it works. But still not nearly as efficient as Galleon's. I have marked Galleon's lines of code and my lines of code with REM statements, ' ******* RITCHIE and ' ******* GALLEON.

I've stared and stared at his lines 59, 60, 70, and 71 (Galleon's calculations) and I'll be damned if I can make sense of them. Could someone please explain to me how his lines of code achieve the same thing I'm doing? What am I missing here?

Code: (Select All)
'** SPRITE ROTATION

DIM Img AS LONG
DIM RotImg AS LONG

Img = _NEWIMAGE(50, 100, 32)
_DEST Img
CLS
LINE (0, 0)-(49, 99), , BF
_DEST 0

SCREEN _NEWIMAGE(640, 480, 32)
CLS

_PUTIMAGE (100, 100), Img ' original image

RotateImage 30, Img, RotImg

_PUTIMAGE (200, 100), RotImg ' rotated image




SUB RotateImage (Degree AS SINGLE, InImg AS LONG, OutImg AS LONG)

    DIM px(3) AS INTEGER
    DIM py(3) AS INTEGER
    DIM Left AS INTEGER
    DIM Right AS INTEGER
    DIM Top AS INTEGER
    DIM Bottom AS INTEGER
    DIM v AS INTEGER
    DIM RotWidth AS INTEGER
    DIM RotHeight AS INTEGER
    DIM Xoffset AS INTEGER
    DIM Yoffset AS INTEGER

    DIM Rotate AS SINGLE '     ******* RITCHIE
    DIM NewRadian AS SINGLE '  ******* RITCHIE
    DIM Distance AS SINGLE '   ******* RITCHIE

    DIM COSr AS SINGLE '       ******* GALLEON
    DIM SINr AS SINGLE '       ******* GALLEON
    DIM x AS SINGLE '          ******* GALLEON
    DIM y AS SINGLE '          ******* GALLEON

    IF OutImg THEN _FREEIMAGE OutImg
    px(0) = -_WIDTH(InImg) / 2 '                                                 -x,-y ------------------- x,-y
    py(0) = -_HEIGHT(InImg) / 2 '                   Create points around (0,0)    p(0) |                 | p(3)
    px(1) = px(0) '                                 that macth the size of the         |                 |
    py(1) = _HEIGHT(InImg) / 2 '                    original image. This creates       |        .        |
    px(2) = _WIDTH(InImg) / 2 '                     four vector quantities to          |       0,0       |
    py(2) = py(1) '                                 work with.                         |                 |
    px(3) = px(2) '                                                               p(1) |                 | p(2)
    py(3) = py(0) '                                                               -x,y ------------------- x,y

    'Rotate = _D2R(Degree) ' ******* RITCHIE                        convert to radian rotation

    SINr = SIN(-Degree / 57.2957795131) ' ******* GALLEON
    COSr = COS(-Degree / 57.2957795131) ' ******* GALLEON

    DO '                                            cycle through vectors

        'Distance = _HYPOT(px(v), py(v)) '           ******* RITCHIE  get distance to vector
        'NewRadian = _ATAN2(py(v), px(v)) + Rotate ' ******* RITCHIE convert vector to radian then add rotation
        'px(v) = COS(NewRadian) * Distance '         ******* RITCHIE convert radian to vector with correct distance
        'py(v) = SIN(NewRadian) * Distance '         ******* RITCHIE


        x = px(v) * COSr + SINr * py(v) ' ******* GALLEON
        y = py(v) * COSr - px(v) * SINr ' ******* GALLEON
        px(v) = x '                       ******* GALLEON
        py(v) = y '                       ******* GALLEON


        IF px(v) < Left THEN Left = px(v) '         keep track of new image size
        IF px(v) > Right THEN Right = px(v)
        IF py(v) < Top THEN Top = py(v)
        IF py(v) > Bottom THEN Bottom = py(v)
        v = v + 1 '                                 increment vector counter
    LOOP UNTIL v = 4 '                              leave when all vectors processed
    RotWidth = Right - Left + 1 '                   calculate width of rotated image
    RotHeight = Bottom - Top + 1 '                  calculate height of rotated image
    Xoffset = RotWidth / 2 '                        place (0,0) in upper left corner of rotated image
    Yoffset = RotHeight / 2
    v = 0 '                                         reset corner counter
    DO '                                            cycle through rotated image coordinates
        px(v) = px(v) + Xoffset '                   move image coordinates so (0,0) in upper left corner
        py(v) = py(v) + Yoffset
        v = v + 1 '                                 increment corner counter
    LOOP UNTIL v = 4 '                              leave when all four corners of image moved
    OutImg = _NEWIMAGE(RotWidth, RotHeight, 32) '   create rotated image canvas
    _MAPTRIANGLE (0, 0)-(0, _HEIGHT(InImg) - 1)-(_WIDTH(InImg) - 1, _HEIGHT(InImg) - 1), InImg TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2)), OutImg
    _MAPTRIANGLE (0, 0)-(_WIDTH(InImg) - 1, 0)-(_WIDTH(InImg) - 1, _HEIGHT(InImg) - 1), InImg TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2)), OutImg

END SUB

Print this item

  Commas in string variable?
Posted by: bert22306 - 09-07-2022, 11:59 PM - Forum: General Discussion - Replies (4)

This might be one of those things that "everyone knows," but I missed the memo. Is there any way to input a string variable which includes commas?

For example, in NMEA 0183 "sentences," all field delimiters are commas. Of course, one option is to change all commas to something else, like semicolons or just spaces. Which I have done, and then afterwards replaced that delimiter with a proper comma.

Is there any way I could input the actual NMEA string as one variable, then in the next step split out each character? I didn't see anything about this limitation in the wiki.

Here is an example of a NMEA 0183 GLL sentence, from a GPS receiver (identified by GP), which provides geo position, UTC time, and "mode," always in ASCII:

$GPGLL,3953.88008971,N,10506.75318910,W,034138.00,A,D*7A

The last two characters, after the * character, are the XOR-based checksum, as two hex characters.

Print this item

  calling an external C program from QB64 & getting back results?
Posted by: madscijr - 09-07-2022, 05:56 PM - Forum: Help Me! - Replies (6)

Some background: 
I'm working on some C code to read separate input from 2 or more USB mice plugged into the PC. That will be its own EXE file (unless it should be a DLL or something?), and when called, it looks for command line parameters. If no command line param is sent, it just returns the count of how many mice are connected to the system Else the command line parameter contains the index of the mouse to return input from, and it returns 2 numbers dx and dy, maybe just the two numbers separated by a comma, e.g. "{dx},{dy}".

I know the SHELL command can be used to call an external EXE from QB64, and theoretically you should be able to pipe the output of the EXE to a file, and read that from QB64. This is a very rudimentary method to get the two programs talking, and it seems like a very inefficient way to do it. Moreover, it doesn't seem to be working - the SHELL command in the test program doesn't seem to be redirecting the output correctly to a file, I am seeing a file not found error.

Would anyone have any ideas about a better way to do this, or even why the SHELL command isn't piping the output to a file?

Below is my QB64 program, followed by the external C program it is calling, which can be compiled to EXE using QB64 using included the batch file. (The attached ZIP has the precompiled EXEs and the source.)

Any help appreciated!


The main program "my_qb64_program.bas":

Code: (Select All)
' CALL AN EXTERNAL PROGRAM AND GET BACK SOME RESULTS
' IS SHELL AND REDIRECTING OUTPUT TO A FILE THE BEST WAY
' OR IS THERE A MORE DIRECT METHOD?

_Title "Talk to EXE from QB64"
Const FALSE = 0
Const TRUE = Not FALSE
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim sExePath As String
Dim sOutPath As String
Dim sParams As String
Dim sCommand As String
Dim sResult As String

' BUILD COMMAND LINE FOR SHELL, DIRECT OUTPUT TO FILE sOutPath
sExePath = m_ProgramPath$ + "my_c_program.exe"
sOutPath = m_ProgramPath$ + "my_c_program_output.txt"
sParams = "1 2 3"
'sCommand = Chr$(34) + sExePath + Chr$(34) + " " + sParams + " > " + Chr$(34) + sOutPath + Chr$(34)
sCommand = Chr$(34) + sExePath + " " + sParams + Chr$(34) + " > " + Chr$(34) + sOutPath + Chr$(34)

' CALL THE EXE WITH SOME COMMAND LINE PARAMETERS
Cls
Print "Shell _Hide " + sCommand: Print
Shell _Hide sCommand

' RETRIEVE THE OUTPUT <- IS THERE A MORE EFFICIENT WAY THAN USING A FILE?
Print "Output should be in file:"
Print Chr$(34) + sOutPath + Chr$(34): Print
sResult = ReadFile$(sOutPath, "(file not found)")

' SHOW RESULTS
Print "Contents of output file:"
Print Chr$(34) + sResult + Chr$(34): Print

' DONE
End

' /////////////////////////////////////////////////////////////////////////////
' Fastest way is always to just read the whole life at once and then parse it.

Function ReadFile$ (sFileName As String, sDefault As String)
    Dim x$
    If _FileExists(sFileName) Then
        Open sFileName For Binary As #1
        x$ = Space$(LOF(1))
        Get #1, 1, x$
        Close #1
        ReadFile$ = x$
    Else
        ReadFile$ = sDefault
    End If
End Function ' ReadFile$

The second program, "my_c_program.c":
Code: (Select All)
/******************************************************************************
Test to see how QB64 can call a C program with some command line arguments,
and get back some results.
******************************************************************************/
#include <stdio.h>
#include <string.h>

int main (int argc, char* argv[])
{
    printf("%s", "result:");
    for (int x=1; x < argc; ++x)
    {
        if (x > 1)
        {
            printf("%s", ",");
        }
        printf("%s", argv[x]);
    }
    return 0;
} // main

The batch file "COMPILE_C_PROG.BAT" that will compile the above C code for you using QB64's built in C compiler 
(edit line 13 to point to the QB64 directory on your PC):
Code: (Select All)
@echo off

:: %QB64DIR%      = C:\Users\maduser\Documents\Code\qb64
:: %MGWDIR%       = C:\Users\maduser\Documents\Code\qb64\internal\c\c_compiler
:: %PATH%         = C:\Users\maduser\Documents\Code\qb64\internal\c\c_compiler\bin
:: %LIBRARY_PATH% = C:\Users\maduser\Documents\Code\qb64\internal\c\c_compiler\x86_64-w64-mingw32\lib
:: %CPATH%        = C:\Users\maduser\Documents\Code\qb64\internal\c\c_compiler\x86_64-w64-mingw32\include

:: PUT THE NAME OF YOUR PROGRAM TO COMPILE HERE
SET PROGNAME=my_c_program

:: QB64DIR MUST POINT TO YOUR QB64 DIRECTORY, LIKE THIS: SET QB64DIR=C:\PROG\QB64
SET QB64DIR=C:\Users\maduser\Documents\Code\qb64

if not "%QB64DIR%"=="" goto doit
ECHO.
ECHO.
ECHO Edit line 4 of this batch file and set QB64DIR to point to your QB64 directory!
ECHO.
ECHO.
GOTO lunch


:doit
:: set up environment vars for direct invocation of QB64's included MinGW C/C++ compiler....

:: WE'LL SKIP THE SETUP IF WE'VE BEEN THROUGH THIS BEFORE....
:: WE'LL USE THE PRESENCE OR ABSENCE OF MGWDIR TO TELL US IF WE'VE PREVIOUSLY SET THE ENVARS.
:: IF MGWDIR ALREADY EXISTS, THEN SKIP THE SETUP SO WE DON'T KEEP ADDING THE SAME
:: STUFF TO THE PATH ENVAR OVER AND OVER EVERY TIME WE RUN THIS BATCH FILE....
if not "%MGWDIR%"=="" goto work


:: SET MGWDIR TO POINT TO MINGW IN OUR QB64 INSTALLATION DIRECTORY.
:: (THIS BATCH FILE SHOULD BE IN THE MAIN QB64 DIRECTORY)....
set MGWDIR=%QB64DIR%\internal\c\c_compiler


set PATH=%MGWDIR%\bin;%PATH%
set LIBRARY_PATH=%MGWDIR%\x86_64-w64-mingw32\lib
set CPATH=%MGWDIR%\x86_64-w64-mingw32\include


:work
:: NOTE: THE LINE BELOW IS SET TO PRODUCE A 32-BIT EXECUTABLE.
:: REPLACE -m32 WITH -m64 TO GENERATE 64-BIT EXEs
:: (OR REMOVE THE -m OPTION ENTIRELY TO GENERATE THE COMPILER DEFAULT)....
gcc -Wall -Os -s -m32 --static -o "%~dp1%PROGNAME%.exe" "%~dp1%PROGNAME%.c"

:lunch
pause



Attached Files
.zip   qb64_talk_to_another_exe.zip (Size: 657.73 KB / Downloads: 29)
Print this item