Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
Audio storage, stereo swi...
Forum: Programs
Last Post: VikRam025
23 minutes ago
» Replies: 3
» Views: 267
|
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: a740g
1 hour ago
» Replies: 5
» Views: 95
|
Most efficient way to bui...
Forum: General Discussion
Last Post: ahenry3068
2 hours ago
» Replies: 9
» Views: 94
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: madscijr
2 hours ago
» Replies: 4
» Views: 116
|
_CONSOLEINPUT is blocking
Forum: General Discussion
Last Post: mdijkens
7 hours ago
» Replies: 6
» Views: 80
|
Fun with Ray Casting
Forum: a740g
Last Post: a740g
Yesterday, 05:50 AM
» Replies: 10
» Views: 226
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: a740g
Yesterday, 02:33 AM
» Replies: 1
» Views: 51
|
Methods in types
Forum: General Discussion
Last Post: bobalooie
Yesterday, 01:02 AM
» Replies: 0
» Views: 52
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
01-16-2025, 10:23 AM
» Replies: 3
» Views: 110
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
01-16-2025, 09:51 AM
» Replies: 0
» Views: 53
|
|
|
String math: Whole # powers easy, decimal powers!!! |
Posted by: Pete - 09-12-2022, 08:58 PM - Forum: General Discussion
- No Replies
|
|
I was considering adding powers to my growing string math routines, until I thought about how to handle decimal powers.
For instance:
256^2.25
A pseudo algorithm to handle this crap would go something like...
256^2+25/100 ' Make into a fraction.
256^2+1/4 ' Reduce by GCF.
256^9/4 ' Combine whole number as a fraction with the fraction.
(256^1/4)^9 ' Move the largest whole number outside the equation.
(4 root of 256)^9 ' Apply root calculation.
4^9 = 262,144
Anyway, not to bad, until you get into even something not a whole lot more complicated than log2 of 10 or 2^3.3219280948874
So ...
2^3+3219280948874/10000000000000 ' Make into a fraction.
2^3+1609640474437/5000000000000 ' Reduce by GCF.
2^16609640474437/5000000000000 ' Combine whole number as a fraction with the fraction.
(2^1/5000000000000)^16609640474437 ' Move the largest whole number outside the equation.
(5000000000000 root of 2)^16609640474437 ' Apply root calculation.
Well, if you can f'ing figure out what the 5 f'tillion root of 2 is, you can raise that to the power of 16609640474437 and get 10.
I mean to wipe out some digits and approximate, the 5th root of 2 is approx.1.148 and that to the power of 16.7 gets you pretty close to 10, so this should work, but now I'm wondering after doing square roots, how much more involved it would be to calculate general roots?
Pete
|
|
|
QB64 Phoenix Edition v3.2.0 Released! |
Posted by: DSMan195276 - 09-12-2022, 07:11 PM - Forum: Announcements
- Replies (22)
|
|
QB64 Phoenix Edition v3.2.0!
https://github.com/QB64-Phoenix-Edition/...tag/v3.2.0
Enhancements
- #21, #164 - The $Unstable command was added - @mkilgore
- $Unstable allows usage of language features that are not yet finalized.
- Features hidden behind $Unstable may have breaking change in new releases, unlike regular parts of the language which do not have breaking changes in new releases.
- #155, #164 - Added MIDI support to `_SNDOPEN` - @a740g, @mkilgore
- MIDI support is current unstable, and hidden behind $Unstable:Midi.
- MIDI is enabled by using the $MidiSoundFont metacommand to specify a soundfont for playing MIDI files.
- The selected soundfont is compiled into your program, so the file does not need to be present at runtime.
- #162, #164 - Compiler settings can be supplied on the command line - @mkilgore
- QB64-PE now accepts the `-f` flag for supplying settings accessible in the `Compiler Settings` menu.
- Settings are only applied for that run of QB64-PE (they do not modify the preserved IDE settings)
- Using `-f` with no flag will print all of the available options.
Bug Fixes- #161 - Fixed _MOUSEMOVE when window is resized - @mkilgore
- #165 - Fixed compiling source files that have a `'` in their name - @mkilgore
- #169, #171 - Fixed `_SNDOPEN` to return zero on failures. - @a740g
- #170, #171 - Fixed `PLAY "MB"` so that it also causes `SOUND` commands to play in the background - @a740g
Full Changelog: https://github.com/QB64-Phoenix-Edition/...0...v3.2.0
|
|
|
Use LOOPs to avoid excessive RETURNs |
Posted by: Pete - 09-12-2022, 03:28 PM - Forum: General Discussion
- Replies (8)
|
|
Just another in my huge line of tech tips to share with the growing Phoenix community. If you enjoy this coding tip, please feel free to use the code by donating to my GOFORKME page.
Okay, so have you ever used a GOSUB routine that goes on forever, but under several conditions needs to be exited early? If so, maybe you just added several RETURN statements after said conditions. That can get messy in a hurry, and it might be hard to debug when you are searching RETURN and trying to figure out where those RETURNs return to. So for all you tired of being pasta coders out there, here is my 5-cent solution. (Lucy would be so proud....)
Instead of...
Code: (Select All) GOSUB pete
END
Pete:
bigger_1 = 1 + 1
IF STEVE = funny_looking THEN RETURN
IF ROSES THEN VIOLETS = blue ELSE RETURN
' Blah... Blah... Blah...
PRINT "My GOFORKME page is going viral!"
IF youvehadenough THEN RETURN
LOCATE somewhere, better
RETURN
We could code it this way...
Code: (Select All) GOSUB Pete
END
Pete:
DO
bigger_1 = 1 + 1
IF STEVE = funny_looking THEN EXIT DO
IF ROSES THEN VIOLETS = blue ELSE EXIT DO
' Blah... Blah... Blah...
PRINT "My GOFORKME page is going viral!"
IF youvehadenough THEN EXIT DO
LOCATE somewhere, better
EXIT DO
LOOP
RETURN
Tune in NEXT time for my second tech tip: DO AND WHILE can be my pal, but NEXT will never hurt me.
Pete
|
|
|
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://qb64phoenix.com/forum/showthread...95#pid6495
|
|
|
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
|
|
|
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
|
|
|
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.
|
|
|
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
|
|
|
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.
|
|
|
|